Kemarin pernah aku tanyakan cara mencari semua sql server yang ada di suatu jaringan, setelah cari cari di mana mana akhirnya aku temukan, untuk semua yang membutuhkan aku copy kan code nya di sini.
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)) 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; |
Silahkan dicoba.
Random Articles
- Selamat Idul Fitri 1428H
- Membuat Help File untuk Aplikasi Delphi
- Menggambar Kurva (Bezier)
- Proposal Proyek: qxpascal
- Membuat kontrol db aware
- Tips: Macro OfAll and auto generate variable in Lazarus
- Lomba Hack-Shareware Aplikasi Delphi (spontanitas)
- Kopi Darat v2 Delphi Indonesia (delphi-id.org)
- Tip compile di Lazarus ke target CPU 64 Bit (Mac Only)
- Rebuild lazarus 2.0.8 dengan fpc 3.2.0 (Win32) - Experimental
Last Articles
- Project Group dalam Lazarus
- FastPlaz Database Explorer
- Release: FastPlaz Super Mom v0.12.22
- PascalClass #3: Web Development with Free Pascal
- Makna Pascal di Pascal Indonesia
- Kulgram : Instalasi Lazarus di Perangkat Berbasis ARM
- PascalClass #1: Analisa Database dan Machine Learning
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
- Mengenal OXYGENE – Pascal For .NET
- PascalTalk #5: UX: Research, Design and Engineer
Recent Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 3 months ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 months ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 4 months ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 1 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 8 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 8 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 8 years ago