Как можно получить список пользователей подключенных к серверу?

← →
Jedi K (2003-07-01 18:56) [16]

program IB_SHOWUSERS;

{$APPTYPE CONSOLE}

{ Compiled with Delphi4 (UP3) }

uses Windows, SysUtils;

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 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";

var
UserFound: boolean;
Mode: (mdDBName, mdUserName, mdPassword);
s, DBName, UserName, Password: string;

ErrorCode: ISC_STATUS;
StatusVector: ISC_STATUS_VECTOR;
DBHandle: Tisc_db_handle;
DPB: TParamBlock; //parameter block for database connection
DPBLen: Integer; //length of Paramblock
ItemList: TSmallPB;
UserNames: TLargePB;
UserCount: Integer;

i: Integer;
Item, //InfoItem we are testing for
Pos, //marker for position in array
Len, //Length of section
namelength: SmallInt;
UserStr: array[0..255] of char;

procedure Error;
var
buffer: array[0..511] of char;
ErrorMessages, lastMsg: string;
pStatus: PSTATUS_VECTOR;
begin
fillchar(buffer,512,#0);
pStatus:=@StatusVector;
ErrorMessages:="";
repeat
ErrorCode := isc_interprete( @buffer, @pstatus);
if lastMsg <> strPas( buffer) then
begin
lastMsg := strPas( buffer);
if length(ErrorMessages) <> 0 then ErrorMessages := ErrorMessages+#13#10;
ErrorMessages := ErrorMessages+lastMsg;
end;
until ErrorCode = 0;
raise Exception.Create(ErrorMessages);
end;

procedure BuildPBString( var PB: array of char; var PBLen: Integer; item: byte; contents: string);
//Add a string value to a parameter block
var len: Integer;
begin
{PBLen is the current size of the populated array, as well as the indicator}
PB[PBLen] := char(item);
inc(PBLen);
len:=Length(Contents);
PB[PBLen] := char(len);
inc(PBLen);
StrPCopy(@PB[PBLen],Contents);
inc(PBLen,len);
end;

Как можно получить список пользователей подключенных к серверу? Найти похожие ветки