Title: List SQL servers on the network
Question: I've been searching for an article describing how to list the SQL servers on the network but couldn't find anything, so I came up with this solution... I decided to use direct Winsock calls instead of the TClientSocket, because I don't have any good experience with it. I know this isn't the ultimate solution, but it works for me, and I'm kind enough sharing it with you, ain't I? :)
I use a modified routine to retrieve the IP addresses on the network which I found on delphi3000, but I don't remember who the originator was! :( Sorry bout' that. Tell me, and I'll give you credit! :)
Update 12. june 2001
I had forgot to declare the imported function WSAIoctl...
Tommy Andersen
Answer:
// 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)+(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;