Fórum Listar máquinas que estão rodando Interbase/Firebird #296864

Amigo,

Coloque seu código aqui para que eu possa testar se aqui vai dar o mesmo erro.

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