Listar máquinas que estão rodando Interbase/Firebird
Como faço para listar as máquinas que estão rodando Interbase/Firebird. Peguei o exemplo que o Guinter Pauli colocou na edição 60 da Clube Delphi. Mas retorna o erro ´Can´t enumerate servers´. Alguém pode me ajudar? Obrigado
Giancorrea
Curtidas 0
Respostas
Pezzin
24/09/2005
Amigo,
Coloque seu código aqui para que eu possa testar se aqui vai dar o mesmo erro.
Coloque seu código aqui para que eu possa testar se aqui vai dar o mesmo erro.
GOSTEI 0
Giancorrea
24/09/2005
Bom, esta é a Unit1 (Form Principal)
/----------------------------------------------------------------------------------/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdTCPClient;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses NetAPI;
{$R *.dfm}
function ServerIsRunning(
AHost: string; APort: integer): boolean;
begin
{ declare IdTCPClient no uses }
with TIdTCPClient.Create(nil) do
begin
Host := AHost;
Port := APort;
Result := True;
try
Connect;
Disconnect;
except
Result := False;
end;
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
GetServerNames(ListBox1.Items,Edit1.Text,SV_TYPE_ALL);
for i := 0 to pred(ListBox1.Items.Count) do
if ServerIsRunning(ListBox1.Items[i],3050) then
ListBox2.Items.Add(ListBox1.Items[i]);
end;
end.
/----------------------------------------------------------------------------------/
Esta é a unit NetAPI, responsável pela verificação das conexões com o Servidor Interbase/Firebird
/----------------------------------------------------------------------------------/
unit NetAPI;
interface
uses
Windows, Classes, SysUtils;
const
NERR_SUCCESS = 0;
MAX_PREFERRED_LENGTH = DWORD(-1);
SV_TYPE_WORKSTATION = $00000001;
SV_TYPE_SERVER = $00000002;
SV_TYPE_SQLSERVER = $00000004;
SV_TYPE_DOMAIN_CTRL = $00000008;
SV_TYPE_DOMAIN_BAKCTRL = $00000010;
SV_TYPE_TIME_SOURCE = $00000020;
SV_TYPE_AFP = $00000040;
SV_TYPE_NOVELL = $00000080;
SV_TYPE_DOMAIN_MEMBER = $00000100;
SV_TYPE_PRINTQ_SERVER = $00000200;
SV_TYPE_DIALIN_SERVER = $00000400;
SV_TYPE_XENIX_SERVER = $00000800;
SV_TYPE_SERVER_UNIX = SV_TYPE_XENIX_SERVER;
SV_TYPE_NT = $00001000;
SV_TYPE_WFW = $00002000;
SV_TYPE_SERVER_MFPN = $00004000;
SV_TYPE_SERVER_NT = $00008000;
SV_TYPE_POTENTIAL_BROWSER = $00010000;
SV_TYPE_BACKUP_BROWSER = $00020000;
SV_TYPE_MASTER_BROWSER = $00040000;
SV_TYPE_DOMAIN_MASTER = $00080000;
SV_TYPE_SERVER_OSF = $00100000;
SV_TYPE_SERVER_VMS = $00200000;
SV_TYPE_WINDOWS = $00400000; // Windows95 and above
SV_TYPE_DFS = $00800000; // Root of a DFS tree
SV_TYPE_CLUSTER_NT = $01000000; // NT Cluster
SV_TYPE_DCE = $10000000; // IBM DSS (Directory and Security Services) or equivalent
SV_TYPE_ALTERNATE_XPORT = $20000000; // return list for alternate transport
SV_TYPE_LOCAL_LIST_ONLY = $40000000; // Return local list only
SV_TYPE_DOMAIN_ENUM = $80000000;
SV_TYPE_ALL = $FFFFFFFF; // handy for NetServerEnum2
type
TServerInfo101 = record
platform_id: DWORD;
name: PWideChar;
version_major: DWORD;
version_minor: DWORD;
server_type: DWORD;
comment: PWideChar;
end;
PServerInfo101 = ^TServerInfo101;
function NetServerEnum(const ServerName: PWideString;
level: DWORD;
var Buffer: pointer;
PrefMaxLen: DWORD;
var EntriesRead: DWORD;
var TotalEntries: DWORD;
ServerType: DWORD;
const Domain: PWideChar;
var ResumeHandle: DWORD): DWORD; stdcall;
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall;
function NetServerEnum(const ServerName: PWideString;
level: DWORD;
var Buffer: pointer;
PrefMaxLen: DWORD;
var EntriesRead: DWORD;
var TotalEntries: DWORD;
ServerType: DWORD;
const Domain: PWideChar;
var ResumeHandle: DWORD): DWORD; stdcall; external ´netapi32.dll´;
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall; external
´netapi32.dll´;
procedure GetServerNames(Names: TStrings; const DomainName: string;
const ServerType: DWORD);
implementation
procedure GetServerNames(Names: TStrings; const DomainName: string;
const ServerType: DWORD);
var
Buffer: pointer;
EntriesRead, i, ErrCode, ResumeHandle, TotalEntries: DWORD;
DomainUnicode: array[0..100] of WideChar;
PDomainUnicode: PWideChar;
ServerInfo: PServerInfo101;
begin
Names.Clear;
ResumeHandle := 0;
if (DomainName = ´´) then
PDomainUnicode := nil
else begin
StringToWideChar(DomainName, DomainUnicode, SizeOf(DomainUnicode));
PDomainUnicode := DomainUnicode;
end;
errCode := NetServerEnum(nil, 101, Buffer, MAX_PREFERRED_LENGTH,
EntriesRead, TotalEntries, ServerType,
PDomainUnicode, ResumeHandle);
if (errCode <> NERR_SUCCESS) then
raise Exception.Create(´Can´´t enumerate servers´);
try
ServerInfo := Buffer;
for i := 1 to EntriesRead do begin
Names.Add(ServerInfo^.name);
Inc(ServerInfo);
end;
finally
NetApiBufferFree(Buffer);
end;
end;
end.
/----------------------------------------------------------------------------------/
Se puderem me ajudar, eu agradeço
/----------------------------------------------------------------------------------/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdTCPClient;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses NetAPI;
{$R *.dfm}
function ServerIsRunning(
AHost: string; APort: integer): boolean;
begin
{ declare IdTCPClient no uses }
with TIdTCPClient.Create(nil) do
begin
Host := AHost;
Port := APort;
Result := True;
try
Connect;
Disconnect;
except
Result := False;
end;
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
GetServerNames(ListBox1.Items,Edit1.Text,SV_TYPE_ALL);
for i := 0 to pred(ListBox1.Items.Count) do
if ServerIsRunning(ListBox1.Items[i],3050) then
ListBox2.Items.Add(ListBox1.Items[i]);
end;
end.
/----------------------------------------------------------------------------------/
Esta é a unit NetAPI, responsável pela verificação das conexões com o Servidor Interbase/Firebird
/----------------------------------------------------------------------------------/
unit NetAPI;
interface
uses
Windows, Classes, SysUtils;
const
NERR_SUCCESS = 0;
MAX_PREFERRED_LENGTH = DWORD(-1);
SV_TYPE_WORKSTATION = $00000001;
SV_TYPE_SERVER = $00000002;
SV_TYPE_SQLSERVER = $00000004;
SV_TYPE_DOMAIN_CTRL = $00000008;
SV_TYPE_DOMAIN_BAKCTRL = $00000010;
SV_TYPE_TIME_SOURCE = $00000020;
SV_TYPE_AFP = $00000040;
SV_TYPE_NOVELL = $00000080;
SV_TYPE_DOMAIN_MEMBER = $00000100;
SV_TYPE_PRINTQ_SERVER = $00000200;
SV_TYPE_DIALIN_SERVER = $00000400;
SV_TYPE_XENIX_SERVER = $00000800;
SV_TYPE_SERVER_UNIX = SV_TYPE_XENIX_SERVER;
SV_TYPE_NT = $00001000;
SV_TYPE_WFW = $00002000;
SV_TYPE_SERVER_MFPN = $00004000;
SV_TYPE_SERVER_NT = $00008000;
SV_TYPE_POTENTIAL_BROWSER = $00010000;
SV_TYPE_BACKUP_BROWSER = $00020000;
SV_TYPE_MASTER_BROWSER = $00040000;
SV_TYPE_DOMAIN_MASTER = $00080000;
SV_TYPE_SERVER_OSF = $00100000;
SV_TYPE_SERVER_VMS = $00200000;
SV_TYPE_WINDOWS = $00400000; // Windows95 and above
SV_TYPE_DFS = $00800000; // Root of a DFS tree
SV_TYPE_CLUSTER_NT = $01000000; // NT Cluster
SV_TYPE_DCE = $10000000; // IBM DSS (Directory and Security Services) or equivalent
SV_TYPE_ALTERNATE_XPORT = $20000000; // return list for alternate transport
SV_TYPE_LOCAL_LIST_ONLY = $40000000; // Return local list only
SV_TYPE_DOMAIN_ENUM = $80000000;
SV_TYPE_ALL = $FFFFFFFF; // handy for NetServerEnum2
type
TServerInfo101 = record
platform_id: DWORD;
name: PWideChar;
version_major: DWORD;
version_minor: DWORD;
server_type: DWORD;
comment: PWideChar;
end;
PServerInfo101 = ^TServerInfo101;
function NetServerEnum(const ServerName: PWideString;
level: DWORD;
var Buffer: pointer;
PrefMaxLen: DWORD;
var EntriesRead: DWORD;
var TotalEntries: DWORD;
ServerType: DWORD;
const Domain: PWideChar;
var ResumeHandle: DWORD): DWORD; stdcall;
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall;
function NetServerEnum(const ServerName: PWideString;
level: DWORD;
var Buffer: pointer;
PrefMaxLen: DWORD;
var EntriesRead: DWORD;
var TotalEntries: DWORD;
ServerType: DWORD;
const Domain: PWideChar;
var ResumeHandle: DWORD): DWORD; stdcall; external ´netapi32.dll´;
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall; external
´netapi32.dll´;
procedure GetServerNames(Names: TStrings; const DomainName: string;
const ServerType: DWORD);
implementation
procedure GetServerNames(Names: TStrings; const DomainName: string;
const ServerType: DWORD);
var
Buffer: pointer;
EntriesRead, i, ErrCode, ResumeHandle, TotalEntries: DWORD;
DomainUnicode: array[0..100] of WideChar;
PDomainUnicode: PWideChar;
ServerInfo: PServerInfo101;
begin
Names.Clear;
ResumeHandle := 0;
if (DomainName = ´´) then
PDomainUnicode := nil
else begin
StringToWideChar(DomainName, DomainUnicode, SizeOf(DomainUnicode));
PDomainUnicode := DomainUnicode;
end;
errCode := NetServerEnum(nil, 101, Buffer, MAX_PREFERRED_LENGTH,
EntriesRead, TotalEntries, ServerType,
PDomainUnicode, ResumeHandle);
if (errCode <> NERR_SUCCESS) then
raise Exception.Create(´Can´´t enumerate servers´);
try
ServerInfo := Buffer;
for i := 1 to EntriesRead do begin
Names.Add(ServerInfo^.name);
Inc(ServerInfo);
end;
finally
NetApiBufferFree(Buffer);
end;
end;
end.
/----------------------------------------------------------------------------------/
Se puderem me ajudar, eu agradeço
GOSTEI 0