Ver Mensaje Individual
  #1  
Antiguo 07-06-2011
samuelcuba samuelcuba is offline
Registrado
NULL
 
Registrado: jun 2011
Posts: 1
Reputación: 0
samuelcuba Va por buen camino
Listar servidores sql server

Hola amigos necesito convertir este código a c++ builder.

Muchas Gracias.

Código Delphi [-]
 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.
Responder Con Cita