Hello

Please I need count fdb's users with session in any fdb. I use call to
isc_database_info with ibase.pas (from interbase ibase.h file header),
TIBdatabaseinfo component, FreeIB components and one unit for this. All
with Delphi6 (W2kP with all patches bug,insecurity and more bill's
errors) with client Firebird 1.0/Interbase 5.6 and server Firebird 1.5
(GNU_Linux RedHat and Debian) But don't work:( Always receive one user
on-line ( But I don't sniff connection for search if server respond one.
Only rest probe this

Help me please !

thx



The unit is:

unit IBUsersCount;

{ Author: SoMa
email : arsomogyi@...
Date : 27-SEPT-2002 }

interface

uses Windows, SysUtils, Bde, Dbtables, Classes, IBDataBase;

const
isc_dpb_version1 = 1;
isc_dpb_user_name = 28;
isc_dpb_password = 29;

isc_info_end = 1;
isc_info_truncated = 2;
isc_info_error = 3;
isc_info_user_names = 53;

IBASE_DLL = 'GDS32.DLL';
KILOBYTE = 1024;

type
ISC_LONG = Longint;
ISC_STATUS = ISC_LONG;
ISC_STATUS_VECTOR = array[0..19] of ISC_STATUS;
PSTATUS_VECTOR = ^ISC_STATUS_VECTOR;
PPSTATUS_VECTOR = ^PSTATUS_VECTOR;

Tisc_db_handle = Pointer;
pisc_db_handle = ^Tisc_db_handle;

TParamBlock = array [0..KILOBYTE-1] of Char;
TLargePB = array [0..(4*KILOBYTE)-1] of Char;
TSmallPB = array [0..(KILOBYTE div 4)-1] of Char;

function GetActivUsersCount(DBAliasName: TIBDatabase): Integer;

function isc_interprete(buffer: PChar; status_vector_ptr: PPSTATUS_VECTOR):
ISC_STATUS;
stdcall; external IBASE_DLL name 'isc_interprete';

function isc_attach_database(status_vector: PSTATUS_VECTOR; db_name_length:
Short;
db_name: PChar; db_handle: pisc_db_handle; parm_buffer_length: Short;
parm_buffer: PChar): ISC_STATUS; stdcall; external IBASE_DLL name
'isc_attach_database';

function isc_database_info(status_vector: PSTATUS_VECTOR; db_handle:
pisc_db_handle;
item_list_buffer_length: Smallint; item_list_buffer: Pointer;
result_buffer_length: Smallint; result_buffer: Pointer): ISC_STATUS;
stdcall; external IBASE_DLL name 'isc_database_info';

function isc_vax_integer(result_buffer : PChar; result_length : SmallInt):
ISC_LONG;
stdcall; external IBASE_DLL name 'isc_vax_integer';

function isc_detach_database(status_vector: PSTATUS_VECTOR; db_handle:
pisc_db_handle): ISC_STATUS; stdcall; external IBASE_DLL name
'isc_detach_database';

implementation

procedure BuildPBString( var PB: array of char; var PBLen: Integer; item:
byte; contents: string);
var
len: Integer;

begin
PB[PBLen] := char(item);
inc(PBLen);
len:=Length(Contents);
PB[PBLen] := char(len);
inc(PBLen);
StrPCopy(@PB[PBLen],Contents);
inc(PBLen,len);
end;

// Use: dBase/Paradox
{function GetAliasPath(const sAlias: String): String;
var
dbDes: DBDesc;

begin
result:= '';
Check(dbiInit(nil));
Check(DbiGetDatabaseDesc(PChar(sAlias), @dbDes));
result:= dbDes.szPhyName;
end;}

// Use: dBase/Paradox, native MSACESS, InterBase
function GetAliasPath(const sAlias: string): string;
var
DriverName: Shortstring;
ParamList: TStringList;
s: Shortstring;

begin
Result := '';
ParamList := TStringList.Create;
try
Session.GetAliasParams(sAlias, ParamList);
DriverName := Session.GetAliasDriverName(sAlias);
s := 'PATH';
if (DriverName = 'MSACCESS') then
s := 'DATABASE NAME'
else if (DriverName = 'INTRBASE') then
s := 'SERVER NAME';
Result := ExtractFilePath(ParamList.Values[s]);
finally
ParamList.Free;
end;
end;

function GetActivUsersCount(DBAliasName: TIBDatabase): Integer;
var
ErrorCode: ISC_STATUS;
StatusVector: ISC_STATUS_VECTOR;
DBHandle: Tisc_db_handle;
DPB: TParamBlock;
DPBLen: Integer;
ItemList: TSmallPB;
UserNames: TLargePB;
UserCount: Integer;
i: Integer;
Item, Pos, Len, namelength: SmallInt;
UserStr: array[0..255] of char;
DBName, UserName, Password: String;

StartPos: Integer;

begin
Result:= 0;
DBName:= DBAliasName.DatabaseName;

UserName:= DBAliasName.Params[0];
Len:= Length(UserName);
StartPos:= 1;
while UserName[StartPos] <> '=' do
Inc(StartPos);
UserName:= Copy(UserName, (StartPos + 1), Len);

Password:= DBAliasName.Params[1];
Len:= Length(Password);
StartPos:= 1;
while Password[StartPos] <> '=' do
Inc(StartPos);
Password:= Copy(Password, (StartPos + 1), Len);

if (DBName = '') or (UserName = '') then Result:= -1;

if Result = 0 then
begin
for i:=low(StatusVector) to high(StatusVector) do StatusVector[i] := 0;
DBHandle := nil;
fillchar(DPB,sizeof(DPB),#0);
DPB[0] := char(isc_dpb_version1);
DPBLen := 1;
BuildPBString(DPB,DPBLen,isc_dpb_user_name,Username);
BuildPBString(DPB,DPBLen,isc_dpb_password,Password);
ErrorCode := isc_attach_database(@StatusVector, Length(DBName),
PChar(DBName), @DBHandle, DPBLen, @DPB);

if ErrorCode = 0 then
begin
fillchar(itemlist, sizeof(itemlist),#0);
ItemList[0] := char(isc_info_user_names);
fillchar(UserNames, sizeof(UserNames),#0);
ErrorCode := isc_database_info(@StatusVector, @DBHandle, 1, @itemlist,
1024, @UserNames);

if ErrorCode = 0 then
begin
item:=0;
UserCount:=0;

while not ((((UserNames[item])=char(isc_info_end)) or
((UserNames[item])=char(isc_info_error))) or
((UserNames[item])=char(isc_info_truncated))) do
begin
pos:=item;
inc(pos);
len := isc_vax_integer(@UserNames[pos],2);
inc(pos,2);
UserStr:='';
NameLength:=byte(UserNames[pos])+1;
fillChar(UserStr,256,#0);
for i:=1 to namelength-1 do UserStr[i-1] := UserNames[pos+i];
inc(UserCount);
inc(item,len+3);
end;

Result:= UserCount - 1;
end;

end;

end;

if assigned(DBHandle) then isc_detach_database(@StatusVector, @DBHandle);
end;


end.