getip.pas

Yahoo Messenger for Mobile

unit GetIp;


interface

Uses
  WinSock,Windows, Dialogs, SysUtils ;

Type

 PMIB_IPADDRROW = ^TMIB_IPADDRROW;
 TMIB_IPADDRROW = record
    dwAddr: dword;
    dwIndex: dword;
    dwMask: dword;
    dwBCastAddr: dword;
    dwReasmSize: dword;
    unused1: word;
    unused2: word;
   end;  { TMIB_IPADDRROW }

  PMIB_IPADDRTABLE = ^TMIB_IPADDRTABLE;
 TMIB_IPADDRTABLE = record
     dwNumEntries: dword;
    Table: array[0 .. 0] of TMIB_IPADDRROW;
 end; { TMIB_IPADDRTABLE }

Type
 TName = array[0..100] of Char;
  PName = ^TName;



  function GetIpAddrTable(pIpAddrTable: PMIB_IPADDRTABLE;
        var pdwSize:  dword;
    bOrder: BOOL): dword; stdcall; external 'IPHLPAPI.DLL';
   function GetHostIP(var sHostName, sIPAddr, sWSAError: string): Boolean;
   Function GetIpAddress: String;
   Function GetIpAddress2: String;

implementation

Uses YchatU1;


Function GetIpAddress: String;
  var
  IpAddrTable: PMIB_IPADDRTABLE;
  Size, dwResult: dword;
  ErrorMessage: array[0 .. 256] of char;
  LibH: THandle;
  CountIp: Integer;
  theipaddy: array[1..10] of string;
  Res,tmpname,tmpclass,s1 : string;
  C: Integer;
//  countip: integer;
begin
  { Confirm that the IP Helper API DLL exists }
        LibH := LoadLibrary('IPHLPAPI.DLL');
if LibH = 0
  then Exit
  else FreeLibrary(LibH);
//Memo1.Lines.Clear;
 Size := 1;
GetMem(IpAddrTable, Size);
FillChar(IpAddrTable^, Size, #0);
 dwResult := GetIpAddrTable(IpAddrTable, Size, true);
  if dwResult = ERROR_INSUFFICIENT_BUFFER
 then
begin
 FreeMem(IpAddrTable);
 GetMem(IpAddrTable, Size);
 FillChar(IpAddrTable^, Size, #0);
 dwResult := GetIpAddrTable(IpAddrTable, Size, true);
 end
   else
begin
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, dwResult, 0,
  @ErrorMessage, Sizeof(ErrorMessage) - 1, nil);
showmessage('Function GetIpAddrTable failed - ' + ErrorMessage);
  end;

{ Display all IP addresses }
countip:=0;
for C := 0 to IpAddrTable.dwNumEntries - 1 do
 begin
 inc(countip);
   theipaddy[c+1]:=inet_ntoa(in_addr(IpAddrTable.Table[C].dwAddr));
  end;
 FreeMem(IpAddrTable);
 Res:='';

 for c:=1  to countip do
   Res:=Res+theipaddy[c]+', ';
 Res:=Copy(Res,1,Length(Res)-2);
GetIPAddress:=Res;
end;


Function GetIpAddress2: String;
  var
  IpAddrTable: PMIB_IPADDRTABLE;
  Size, dwResult: dword;
  ErrorMessage: array[0 .. 256] of char;
  LibH: THandle;
  CountIp: Integer;
  theipaddy: array[1..10] of string;
  Res,tmpname,tmpclass,s1 : string;
  C: Integer;
//  countip: integer;
begin
  { Confirm that the IP Helper API DLL exists }
        LibH := LoadLibrary('IPHLPAPI.DLL');
if LibH = 0
  then Exit
  else FreeLibrary(LibH);
//Memo1.Lines.Clear;
 Size := 1;
GetMem(IpAddrTable, Size);
FillChar(IpAddrTable^, Size, #0);
 dwResult := GetIpAddrTable(IpAddrTable, Size, true);
  if dwResult = ERROR_INSUFFICIENT_BUFFER
 then
begin
 FreeMem(IpAddrTable);
 GetMem(IpAddrTable, Size);
 FillChar(IpAddrTable^, Size, #0);
 dwResult := GetIpAddrTable(IpAddrTable, Size, true);
 end
   else
begin
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, dwResult, 0,
  @ErrorMessage, Sizeof(ErrorMessage) - 1, nil);
showmessage('Function GetIpAddrTable failed - ' + ErrorMessage);
  end;

{ Display all IP addresses }
countip:=0;
for C := 0 to IpAddrTable.dwNumEntries - 1 do
 begin
 inc(countip);
   theipaddy[c+1]:=inet_ntoa(in_addr(IpAddrTable.Table[C].dwAddr));
  end;
 FreeMem(IpAddrTable);
 Res:='';

 for c:=1 to countip do
  Begin
   If (Pos('127.0.0.1',theipaddy[c])=0) And (Pos('0.0.0.0',theipaddy[c])=0) And (Pos('192.168.',theipaddy[c])=0)  Then
     Res:=Res+theipaddy[c]+', ';
  End;
 Res:=Copy(Res,1,Length(Res)-2);
 Res:=Trim(Res);

  If Res='' Then
    TWhatIsMyIp.Create('','',0);

 GetIPAddress2:=Res;
end;




function GetHostIP(var sHostName, sIPAddr, sWSAError: string): Boolean;
var
  HEnt: pHostEnt;
  HName: PName;
  WSAData: TWSAData;
  iCnt: Integer;
begin
  Result := False;
  if WSAStartup($0101, WSAData) <> 0 then begin
    sWSAError := 'WSAStartup error';
    Exit;
  end;
  sHostName := '';
  sIPAddr := '';
  sWSAError := '';
  New(HName);
  if GetHostName(HName^, SizeOf(TName)) = 0 then begin
    Result := True;
    sHostName := StrPas(HName^);
    HEnt := GetHostByName(HName^);
    for iCnt := 0 to HEnt^.h_length - 1 do
      sIPAddr := sIPAddr + IntToStr(Ord(HEnt^.h_addr_list^[iCnt])) + '.';
    SetLength(sIPAddr, Length(sIPAddr) - 1);
  end
  else begin
    case WSAGetLastError of
      WSAEFAULT        : sWSAError := 'WSAEFault';
      WSANOTINITIALISED: sWSAError := 'WSANotInitialised';
      WSAENETDOWN      : sWSAError := 'WSAENetDown';
      WSAEINPROGRESS   : sWSAError := 'WSAEInProgress';
    end;
  end;
  Dispose(HName);
  WSACleanup;
end;


end.