Board index » delphi » Number of Users/Machine Name

Number of Users/Machine Name

Hi all,
  Looking for a previous post (over 3 mo old) on how to extract the number
of users currently logged into an Access database.  Also a way to capture
the machine name of the current workstation.
tia
brandon
 

Re:Number of Users/Machine Name


You will need the dll...

unit frmMain;

interface

uses
  Windows, Messages, Forms, ExtCtrls,  Menus, Dialogs,
  StdCtrls, Controls, Classes, Sysutils, Registry, ActiveX, ComCtrls;

type
  TaccessMain = class(TForm)
    btnRefresh: TButton;
    RadioGroupOptions: TRadioGroup;
    edtDatabaseName: TEdit;
    lvMain: TListView;
    diagSaveTextBackup: TSaveDialog;
    Button1: TButton;
    function  GetDatabasePath:string;
    procedure btnRefreshClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroupOptionsClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

procedure LoadAccounts(Handle: THandle);export;

var
  accessMain: TaccessMain;

implementation

{$R *.DFM}

uses
  ADODB_TLB, dllMain;

function LDBUser_GetUsers(var UserBuffer: PSafeArray; DatabaseName: PChar;
Options: Integer): Integer;
  stdcall; external 'MSLDBUSR.DLL';

function LDBUser_GetError(ErrorNo: Integer): PChar;
  stdcall; external 'MSLDBUSR.DLL';

procedure LoadAccounts(Handle: THandle);
begin
if Handle = 0 Then
    Handle := GetActiveWindow;
  Application.Handle := Handle;
 try
    with TaccessMain.Create(Application) Do
    try
    ShowModal;
    finally
    Free;
    end
  except
    On E: Exception Do
      Application.HandleException( E );
  end;
  Application.handle := 0;
end;

function TaccessMain.GetDatabasePath:string;
var
Reg:TRegistry;
ReadPath:string;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('\Software\ODBC\ODBC.INI\AMD',true);
ReadPath:= reg.ReadString('DBQ');
result:= ReadPath;
end;

procedure TaccessMain.btnRefreshClick(Sender: TObject);
var
  UserCount: Integer;
  UserBuffer: Variant;
  Options: Integer;
  i: Integer;
begin
  lvMain.Items.Clear;
  UserBuffer := VarArrayCreate([1, 1], varOleStr);
  case RadioGroupOptions.ItemIndex of
    0: Options := 1;
    1: Options := 2;
    2: Options := 4;
    else Options := 1;
  end;
  UserCount := LDBUser_GetUsers(PSafeArray(TVarData(UserBuffer).VArray),
PChar(edtDatabaseName.Text), Options);
  if UserCount < 0 then
    MessageDlg(LDBUser_GetError(UserCount), mtError, [mbOK], 0)
  else if Options = 8 then
    ShowMessage('Current Users: ' + IntToStr(UserCount))
  else
    for i := 1 to UserCount do
      with lvMain.Items.Add do
      begin
        Caption := IntToStr(i);
        SubItems.Add(PChar(TVarData(UserBuffer[i]).VPointer));
      end;

end;

procedure TaccessMain.FormCreate(Sender: TObject);
begin
edtDatabaseName.Text:= GetDatabasePath;
btnRefresh.Click;
end;

procedure TaccessMain.RadioGroupOptionsClick(Sender: TObject);
begin
btnRefresh.Click;
end;

procedure TaccessMain.Button1Click(Sender: TObject);
begin
close;
end;

end.

--
Brian
Digital Wired Limited
http://www.ninstall.com

Quote
"Brandon Barnhart" <bran...@xpresstech.com> wrote in message

news:3bc3319e$1_1@dnews...
Quote
> Hi all,
>   Looking for a previous post (over 3 mo old) on how to extract the number
> of users currently logged into an Access database.  Also a way to capture
> the machine name of the current workstation.
> tia
> brandon

Re:Number of Users/Machine Name


Thanks, That's what i needed...

Quote
"Brian Slack" <br...@ninstall.com> wrote in message news:3bc34ebd_1@dnews...
> You will need the dll...

> unit frmMain;

> interface

> uses
>   Windows, Messages, Forms, ExtCtrls,  Menus, Dialogs,
>   StdCtrls, Controls, Classes, Sysutils, Registry, ActiveX, ComCtrls;

> type
>   TaccessMain = class(TForm)
>     btnRefresh: TButton;
>     RadioGroupOptions: TRadioGroup;
>     edtDatabaseName: TEdit;
>     lvMain: TListView;
>     diagSaveTextBackup: TSaveDialog;
>     Button1: TButton;
>     function  GetDatabasePath:string;
>     procedure btnRefreshClick(Sender: TObject);
>     procedure FormCreate(Sender: TObject);
>     procedure RadioGroupOptionsClick(Sender: TObject);
>     procedure Button1Click(Sender: TObject);
>   private

>   public

>   end;

> procedure LoadAccounts(Handle: THandle);export;

> var
>   accessMain: TaccessMain;

> implementation

> {$R *.DFM}

> uses
>   ADODB_TLB, dllMain;

> function LDBUser_GetUsers(var UserBuffer: PSafeArray; DatabaseName: PChar;
> Options: Integer): Integer;
>   stdcall; external 'MSLDBUSR.DLL';

> function LDBUser_GetError(ErrorNo: Integer): PChar;
>   stdcall; external 'MSLDBUSR.DLL';

> procedure LoadAccounts(Handle: THandle);
> begin
> if Handle = 0 Then
>     Handle := GetActiveWindow;
>   Application.Handle := Handle;
>  try
>     with TaccessMain.Create(Application) Do
>     try
>     ShowModal;
>     finally
>     Free;
>     end
>   except
>     On E: Exception Do
>       Application.HandleException( E );
>   end;
>   Application.handle := 0;
> end;

> function TaccessMain.GetDatabasePath:string;
> var
> Reg:TRegistry;
> ReadPath:string;
> begin
> reg := TRegistry.Create;
> reg.RootKey := HKEY_LOCAL_MACHINE;
> reg.OpenKey('\Software\ODBC\ODBC.INI\AMD',true);
> ReadPath:= reg.ReadString('DBQ');
> result:= ReadPath;
> end;

> procedure TaccessMain.btnRefreshClick(Sender: TObject);
> var
>   UserCount: Integer;
>   UserBuffer: Variant;
>   Options: Integer;
>   i: Integer;
> begin
>   lvMain.Items.Clear;
>   UserBuffer := VarArrayCreate([1, 1], varOleStr);
>   case RadioGroupOptions.ItemIndex of
>     0: Options := 1;
>     1: Options := 2;
>     2: Options := 4;
>     else Options := 1;
>   end;
>   UserCount := LDBUser_GetUsers(PSafeArray(TVarData(UserBuffer).VArray),
> PChar(edtDatabaseName.Text), Options);
>   if UserCount < 0 then
>     MessageDlg(LDBUser_GetError(UserCount), mtError, [mbOK], 0)
>   else if Options = 8 then
>     ShowMessage('Current Users: ' + IntToStr(UserCount))
>   else
>     for i := 1 to UserCount do
>       with lvMain.Items.Add do
>       begin
>         Caption := IntToStr(i);
>         SubItems.Add(PChar(TVarData(UserBuffer[i]).VPointer));
>       end;

> end;

> procedure TaccessMain.FormCreate(Sender: TObject);
> begin
> edtDatabaseName.Text:= GetDatabasePath;
> btnRefresh.Click;
> end;

> procedure TaccessMain.RadioGroupOptionsClick(Sender: TObject);
> begin
> btnRefresh.Click;
> end;

> procedure TaccessMain.Button1Click(Sender: TObject);
> begin
> close;
> end;

> end.

> --
> Brian
> Digital Wired Limited
> http://www.ninstall.com
> "Brandon Barnhart" <bran...@xpresstech.com> wrote in message
> news:3bc3319e$1_1@dnews...
> > Hi all,
> >   Looking for a previous post (over 3 mo old) on how to extract the
number
> > of users currently logged into an Access database.  Also a way to
capture
> > the machine name of the current workstation.
> > tia
> > brandon

Other Threads