function TForm1.LocalIP: string;
type
   TaPInAddr = array [0..10] of PInAddr;
   PaPInAddr = ^TaPInAddr;
var
    phe: PHostEnt;
    pptr: PaPInAddr;
    Buffer: array [0..63] of char;
    i: Integer;
    GInitData: TWSADATA;
begin
    WSAStartup($101, GInitData);
    Result := '';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    i := 0;
    while pptr^[i] <> nil do
    begin
      result:=StrPas(inet_ntoa(pptr^[i]^));
      Inc(i);
    end;
    WSACleanup;
end;

function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean; 
type 
  Name = array[0..100] of Char; 
  PName = ^Name; 
var 
  HEnt: pHostEnt; 
  HName: PName; 
  WSAData: TWSAData; 
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := 'Winsock is not responding."'; 
    Exit; 
  end; 
  IPaddr := ''; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.'); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True; 
  end
  else begin 
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised'; 
    WSAENETDOWN      :WSAErr:='WSAENetDown'; 
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress'; 
   end; 
  end; 
  Dispose(HName); 
  WSACleanup; 
end;

function LWToIP(LW: LongWord): string;
begin
  Result := IntToStr(LW and $FF);
  LW := LW shr 8;
  Result := Result + '.' + IntToStr(LW and $FF);
  LW := LW shr 8;
  Result := Result + '.' + IntToStr(LW and $FF);
  LW := LW shr 8;
  Result := Result + '.' + IntToStr(LW and $FF);
end;
function TForm1.GetLocalIP: string;
var
  name, A: PChar;
  h: hostent;
  I: Integer;
begin
  GetMem(name,255);
  try
    I := GetHostName(name,255);
    if I <> 0 then
      I := wsagetlastError;
    if I <> 0 then
      StatusBar1.Panels[0].Text := 'Error: ' + IntToStr(I)
    else
    begin
      h := GetHostByName(name)^;
      if h.h_length <> 4 then Result := ''
      else
      begin
        A := h.h_addr_list^;
        I := 0;
        while (A^ <>#0)and (CompareStr(A,h.h_name) <> 0) do
        begin
          inc(I,4);
          Inc(A,4)
        end;
        if I < 4 then
        begin
          Result := h.h_name
        end
        else
        begin
          while I >= 4 do
          begin
            Dec(A,4);
            Dec(I,4);
            Result := Result + LWToIP(PLongWord(A)^) + ', ';
          end;
          Delete(Result,Length(Result)-1,2);
        end
      end
    end
  finally
    FreeMem(name)
  end
end;