Arsip: List SQL Server in network

// Put this constant in the start of your unit!
Const
Socket_WM_Hook = WM_User + 100;
// These procedures must be put inside your TForm class
Procedure TCPSocket_WM_Hook(Var Msg: TMessage); Message Socket_WM_Hook;
Procedure GetIPAddresses(List: TStrings);
// 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';
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;