lisatado de los servidores disponibles en mi red [Archivo]

Neftali [Germán.Estévez]

25-01-2005, 10:59:04

Bueno es un código antiguo, pero puedes probarlo. Coloca un Form, con un TButton y un Memo. El código de la Unit es el siguiente; Luego sólo te queda asignar el evento OnClick del TButton.

unit Unit1_SQLServers;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,
Winsock, StdCtrls;

// Put this constant in the start of your unit!
Const
Socket_WM_Hook = WM_User + 100;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Procedure TCPSocket_WM_Hook(Var Msg: TMessage); Message Socket_WM_Hook;
Procedure GetIPAddresses(List: TStrings);
Procedure ListSQLServers(SQLList: TStrings);
public
{ Public declarations }
end;

var
Form1: TForm1;

// This variable should be put inside your TForm class, but is not necessary!
ConnectionStatus : Integer;

Function WSAIoctl(s: TSocket; cmd: DWORD; lpInBuffer: PCHAR; dwInBufferLen:
DWORD;
lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;
lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer; stdcall; external 'WS2_32.DLL';

implementation

{$R *.dfm}

Procedure TForm1.TCPSocket_WM_Hook(Var Msg: TMessage);
Var
InputSocket : TSocket;
Selectevent : Word;

Begin
InputSocket := Msg.wParam;
IF InputSocket <> Invalid_Socket Then
Begin
Selectevent := WSAGetSelectEvent(Msg.lParam);

Case Selectevent of
FD_READ : ;
FD_CONNECT : ConnectionStatus := 1;
FD_CLOSE : ConnectionStatus := 2;
End;
End;
End;

Procedure TForm1.GetIPAddresses(List: TStrings);
Type
sockaddr_gen = packed Record
AddressIn : sockaddr_in;
filler : packed Array[0..7] of char;
End;

INTERFACE_INFO = packed Record
iiFlags : u_long; // Interface flags
iiAddress : sockaddr_gen; // Interface address
iiBroadcastAddress : sockaddr_gen; // Broadcast address
iiNetmask : sockaddr_gen; // Network mask
End;

Const
SIO_GET_INTERFACE_LIST = $4004747F;

Var
ErrorCode : Integer;
WSAData : TWSAData;
Sock : TSocket;
PtrA : Pointer;
Buffer : Array[0..20] of INTERFACE_INFO;
BytesReturned : U_Long;
I : Integer;
NumInterfaces : Integer;
pAddrInet : SOCKADDR_IN;
pAddrString : pChar;
S : String;

Begin
List.Clear;

ErrorCode := WSAStartup($0101, WSAData);
IF (ErrorCode = 0) Then
Begin
Sock := Socket(AF_INET, SOCK_STREAM, 0); // Open a socket
IF (Sock <> INVALID_SOCKET) Then
Begin
PtrA := @bytesReturned;
IF (WSAIoCtl(Sock, SIO_GET_INTERFACE_LIST, NIL, 0, @Buffer, 1024, PtrA, NIL, NIL) <> SOCKET_ERROR) Then
Begin
NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);
For I := 0 to NumInterfaces - 1 do // For every interface
Begin
S := '';

pAddrInet := Buffer[I].iiAddress.addressIn; // IP ADDRESS
pAddrString := inet_ntoa(pAddrInet.sin_addr);
IF (StrPas(pAddrString) <> '127.0.0.1') Then
Begin
S := S + pAddrString + ',';

pAddrInet := Buffer[I].iiNetMask.addressIn; // SUBNET MASK
pAddrString := inet_ntoa(pAddrInet.sin_addr);
S := S + pAddrString;

List.Add(S);
End;
End;
End;
CloseSocket(Sock);
End;

WSACleanup;
End;
End;

Procedure TForm1.ListSQLServers(SQLList: TStrings);

Function GetNumber(S: String; Nr: Byte) : Word;
Var
T : Integer;

Begin
While (Nr > 1) do
Begin
T := Pos('.', S);
IF (T = 0) Then T := Length(S)+1;
Delete(S, 1, T);

Dec(Nr);
End;

T := Pos('.', S);
IF (T = 0) Then T := Length(S)+1;
Result := StrtointDef(Copy(S, 1, T-1), 0);
Delete(S, 1, T);
End;

Function IPOk(CurrentIP, SrvIP, SrvMask: String) : Boolean;
Var
T : Integer;
I, M, Num : Integer;

Begin
Result := True;
For T := 1 to 4 do
Begin
I := GetNumber(SrvIP, T);
M := GetNumber(SrvMask, T);
Num := GetNumber(CurrentIP, T);

IF (Num < (I and M)) or (Num > ((I and M)+(255-M))) Then Result := False;
End;
End;

Function IsSQLServer(IP: String; var SQLName: String) : Boolean;
Var
Sock : TSocket;
SockAddr : SockAddr_In;
IP_Address_Array : Array[0..32] of Char; // Don't need more than 15 though... ;)
Error : Integer;
Timer : TDateTime;
HostEnt : PHostEnt;

Begin
Result := False;

Sock := Socket(PF_INET, SOCK_STREAM, 0); // Open a socket
IF (Sock <> INVALID_SOCKET) Then
Begin
Strpcopy(IP_Address_Array, IP);

// ms-sql-s
// 1433
SockAddr.Sin_Addr.S_addr := Inet_Addr(IP_Address_Array);
SockAddr.Sin_Port := HtoNS(1433); // Service: 'ms-sql-s' ???
SockAddr.Sin_Zero[0] := Char(0);
SockAddr.Sin_Family := AF_INET;
End;

// Set the socket into asynchronous mode, so it will trigger the wMsg
// event in the hWnd window when the connection has been made
WSAAsyncSelect(Sock, self.Handle, Socket_WM_Hook, FD_READ or FD_CONNECT or FD_CLOSE);

Error := Connect(Sock, TSockaddr(SockAddr), Sizeof(SockAddr));
IF (Error = SOCKET_ERROR) Then
Begin
IF (WSAGetLastError = WSAEWOULDBLOCK) Then Error := 0;
End
Else Error := 0;

IF (Error = 0) Then
Begin
ConnectionStatus := 0;

// Set your own timeout value. I've had success with as low as 0.01 (10ms) ...
// 0.1 = 100ms 0.2 = 200ms ...
Timer := Now;
While (ConnectionStatus = 0) and (Timer+(0.01/86400) > Now) do Application.ProcessMessages;
Result := (ConnectionStatus = 1);

IF (Result) Then
Begin
HostEnt := GetHostByAddr(@SockAddr.sin_addr.S_addr, 4, PF_INET);
IF (Assigned(HostEnt)) Then
Begin
SQLName := HostEnt.h_name;
End
Else SQLName := IP;
End;
End;
CloseSocket(Sock);
End;

Var
I, T : Integer;
BaseIP : String;
CurIP : String;
S : String;
IP : String;
Mask : String;
Error : Integer;
WSAData : TWSAData;
SQLName : String;
IPAddresses : TStringList;

Begin
IPAddresses := TStringList.Create;
// IPAddresses.Add('139.117.69.80,255.255.255.0');
GetIPAddresses(IPAddresses);

Error := WSAStartup($0101, WSAData);
IF (Error = 0) Then
Begin
For I := 0 to IPAddresses.Count-1 do
Begin
S := IPAddresses.Strings[I];
IP := Copy(S, 1, Pos(',', S)-1);
Mask := Copy(S, Pos(',', S)+1, Length(S));

// Create base IP address (first 3 numbers)...
BaseIP := '';
For T := 1 to 3 do BaseIP := BaseIP + IntToStr(GetNumber(IP, T))+'.';

For T := 1 to 254 do // 0 & 255 is not valid IP addresses...
Begin
CurIP := BaseIP+IntToStr(T);

IF (IPOk(CurIP, IP, Mask)) Then
Begin
IF (IsSQLServer(CurIP, SQLName)) Then
Begin
SQLList.Add(SQLName);
End;
End;
Application.ProcessMessages;
End;
End;
WSACleanup;
End;

IPAddresses.Free;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetIPAddresses(Memo1.Lines);
ListSQLServers(Memo1.Lines);
MessageDlg('Done', mtInformation, [mbOK], 0);
end;

end.