Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#18

AW: Eigene IP Adresse ermitteln

  Alt 25. Feb 2016, 11:02
Also der Code von
war ja schon echt übel zusammengeklopft

Hier mal eine Variante, die die Indy-Winsock2-Implementierung verwendet und gleichzeigt auch aussagekräftige Fehlermeldungen herauswirft (wenn denn welche auftreten).

Man könnte jetzt noch ein wenig spezieller auf bestimmte Fehler reagieren (z.B. wenn der Buffer zu klein ist) aber das spare ich mir jetzt mal
Delphi-Quellcode:
unit Winapi.NetworkInterfaces;

interface

uses
  IdWinsock2;

type
  tNetworkInterface = record
    AddrIP: string;
    SubnetMask: string;
    AddrNet: string;
    AddrLimitedBroadcast: string;
    AddrDirectedBroadcast: string;
    IsInterfaceUp: Boolean;
    BroadcastSupport: Boolean;
    IsLoopback: Boolean;
    IsPointToPoint: Boolean;
    IsMulticast: Boolean;
  end;

  tNetworkInterfaceList = array of tNetworkInterface;

function GetNetworkInterfaces( ): tNetworkInterfaceList;

implementation

uses
  Winapi.Errors;

procedure RaiseLastWinsocket2Error( const AdditionalInfo: string = '' );
begin
  RaiseLastModuleError( WinsockHandle( ), WSAGetLastError( ), AdditionalInfo );
end;

function GetNetworkInterfaces( ): tNetworkInterfaceList;
var
  aSocket : TSocket;
  NoOfInterfaces : Integer;
  NoOfBytesReturned : u_Long;
  InterfaceFlags : u_Long;
  pAddrIP : sockaddr_in;
  pAddrSubnetMask : sockaddr_in;
  pAddrBroadcast : sockaddr_in;
  pIPString : PAnsiChar;
  pSubnetMaskString : PAnsiChar;
  pLimBroadcastString: PAnsiChar;
  pNetAddrString : PAnsiChar;
  pDirBroadcastString: PAnsiChar;
  DirBroadcastDummy : In_Addr;
  NetAddrDummy : In_Addr;
  Buffer : array [ 0 .. 30 ] of interface_info;
  cbOutBuffer : u_Long;
  i : Integer;
begin
  InitializeWinSock;

  SetLength( Result, 0 );

  aSocket := Socket( AF_INET, SOCK_STREAM, 0 );

  if ( aSocket = INVALID_SOCKET )
  then
    RaiseLastWinsocket2Error( );

  try
    cbOutBuffer := Length( Buffer ) * SizeOf( interface_info );

    if WSAIoctl( aSocket, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer, cbOutBuffer, @NoOfBytesReturned, nil, nil ) <> 0
    then
      RaiseLastWinsocket2Error( );

    NoOfInterfaces := NoOfBytesReturned div SizeOf( interface_info );
    SetLength( Result, NoOfInterfaces );

    // For each of the identified interfaces get:
    for i := 0 to NoOfInterfaces - 1 do
      begin

        with Result[ i ] do
          begin

            // Get the IP address
            pAddrIP := Buffer[ i ].iiAddress.AddressIn;
            pIPString := inet_ntoa( pAddrIP.sin_addr );
            AddrIP := string( pIPString );

            // Get the subnet mask
            pAddrSubnetMask := Buffer[ i ].iiNetmask.AddressIn;
            pSubnetMaskString := inet_ntoa( pAddrSubnetMask.sin_addr );
            SubnetMask := string( pSubnetMaskString );

            // Get the limited broadcast address
            pAddrBroadcast := Buffer[ i ].iiBroadcastAddress.AddressIn;
            pLimBroadcastString := inet_ntoa( pAddrBroadcast.sin_addr );
            AddrLimitedBroadcast := string( pLimBroadcastString );

            // Calculate the net and the directed broadcast address
            NetAddrDummy.S_addr := Buffer[ i ].iiAddress.AddressIn.sin_addr.S_addr;
            NetAddrDummy.S_addr := NetAddrDummy.S_addr and Buffer[ i ].iiNetmask.AddressIn.sin_addr.S_addr;
            DirBroadcastDummy.S_addr := NetAddrDummy.S_addr or not Buffer[ i ].iiNetmask.AddressIn.sin_addr.S_addr;

            pNetAddrString := inet_ntoa( ( NetAddrDummy ) );
            AddrNet := string( pNetAddrString );

            pDirBroadcastString := inet_ntoa( ( DirBroadcastDummy ) );
            AddrDirectedBroadcast := string( pDirBroadcastString );

            // From the evaluation of the Flags we receive more information
            InterfaceFlags := Buffer[ i ].iiFlags;

            IsInterfaceUp := ( InterfaceFlags and IFF_UP ) = IFF_UP;
            BroadcastSupport := ( InterfaceFlags and IFF_BROADCAST ) = IFF_BROADCAST;
            IsLoopback := ( InterfaceFlags and IFF_LOOPBACK ) = IFF_LOOPBACK;
            IsPointToPoint := ( InterfaceFlags and IFF_POINTTOPOINT ) = IFF_POINTTOPOINT;
            IsMulticast := ( InterfaceFlags and IFF_MULTICAST ) = IFF_MULTICAST;
          end;
      end;

  finally
    CheckModuleError( CloseSocket( aSocket ), WinsockHandle( ) );
  end;
end;

initialization

finalization

UninitializeWinSock;

end.
Dazu gehört dann noch
Delphi-Quellcode:
unit Winapi.Errors;

interface

uses
  System.SysUtils,
  Winapi.Windows;

procedure CheckModuleError( LastError: Integer; AModuleName: string; const AdditionalInfo: string = '' ); overload;
procedure CheckModuleError( LastError: Integer; AModuleHandle: HMODULE; const AdditionalInfo: string = '' ); overload;
procedure RaiseLastModuleError( AModuleName: string; LastError: Integer; const AdditionalInfo: string = '' ); overload;
procedure RaiseLastModuleError( AModuleHandle: HMODULE; LastError: Integer; const AdditionalInfo: string = '' ); overload;

implementation

uses
  System.SysConst;

procedure CheckModuleError( LastError: Integer; AModuleName: string; const AdditionalInfo: string = '' );
begin
  if LastError <> ERROR_SUCCESS
  then
    RaiseLastModuleError( AModuleName, LastError, AdditionalInfo );
end;

procedure CheckModuleError( LastError: Integer; AModuleHandle: HMODULE; const AdditionalInfo: string = '' );
begin
  if LastError <> ERROR_SUCCESS
  then
    RaiseLastModuleError( AModuleHandle, LastError, AdditionalInfo );
end;

procedure RaiseLastModuleError( AModuleName: string; LastError: Integer; const AdditionalInfo: string = '' );
begin
  UniqueString( AModuleName );
  RaiseLastModuleError( LoadLibrary( PChar( AModuleName ) ), LastError, AdditionalInfo );
end;

procedure RaiseLastModuleError( AModuleHandle: HMODULE; LastError: Integer; const AdditionalInfo: string = '' );
var
  Error: EOSError;
begin
  if LastError <> 0
  then
    Error := EOSError.CreateResFmt( @SOSError, [ LastError, SysErrorMessage( LastError, AModuleHandle ), AdditionalInfo ] )
  else
    Error := EOSError.CreateRes( @SUnkOSError );
  Error.ErrorCode := LastError;
  raise Error;
end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)

Geändert von Sir Rufo (25. Feb 2016 um 11:04 Uhr)
  Mit Zitat antworten Zitat