|
发表于 2012-4-21 03:19:12
|
显示全部楼层
LZ 的是Win平台用的,我把我在项目里用的贴出来吧,作为LZ的补充,包括Win和Linux平台的。
unit LocalIPUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, {$IFDEF MSWINDOWS}Windows, Winsock2{$ELSE}BaseUnix, Sockets{$ENDIF};
function GetLocalIPAddress:string;
implementation
{$IFNDEF MSWINDOWS}
const
IF_NAMESIZE = 16;
SIOCGIFCONF = $8912;
type
{$packrecords c}
tifr_ifrn = record
case integer of
0 : (ifrn_name: array [0..IF_NAMESIZE-1] of char);
end;
tifmap = record
mem_start : cardinal;
mem_end : cardinal;
base_addr : word;
irq : byte;
dma : byte;
port : byte;
end;
PIFrec = ^TIFrec;
TIFrec = record
ifr_ifrn : tifr_ifrn;
case integer of
0 : (ifru_addr : TSockAddr);
1 : (ifru_dstaddr : TSockAddr);
2 : (ifru_broadaddr : TSockAddr);
3 : (ifru_netmask : TSockAddr);
4 : (ifru_hwaddr : TSockAddr);
5 : (ifru_flags : word);
6 : (ifru_ivalue : longint);
7 : (ifru_mtu : longint);
8 : (ifru_map : tifmap);
9 : (ifru_slave : Array[0..IF_NAMESIZE-1] of char);
10 : (ifru_newname : Array[0..IF_NAMESIZE-1] of char);
11 : (ifru_data : pointer);
end;
TIFConf = record
ifc_len : longint;
case integer of
0 : (ifcu_buf : pointer);
1 : (ifcu_req : ^tifrec);
end;
function GetLocalIPAddress:string;
var
i, n : Integer;
aSocket : Tsocket;
ifc : TIfConf;
ifp : PIFRec;
Buf : array[0..1023] of byte;
FIPAddress:string;
FIPList:TStrings;
begin
Result := '';
aSocket := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if aSocket < 0 then Exit;
try
ifc.ifc_len:=Sizeof(Buf);
ifc.ifcu_buf:=@Buf;
if FpIOCtl(aSocket, SIOCGIFCONF, @ifc)<0 then Exit;
finally
CloseSocket(aSocket);
end;
FIPList := TStringList.Create;
try
i:=0;
n := ifc.ifc_len;
while i < n do
begin
ifp:=PIFRec(PByte(ifc.ifcu_buf)+i);
FIPAddress:= NetAddrToStr(ifp^.ifru_addr.sin_addr);
if not SameText(FIPAddress, '127.0.0.1') then
FIPList.Add(FIPAddress);
Inc(i, SizeOf(TIFrec));
end;
Result := FIPList.Text;
finally
FIPList.Free;
end;
end;
{$ELSE}
function GetLocalIPAddress:string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array[0..63] of Char;
I : Integer;
FLocalIP : TStrings;
begin
Result := '';
FLocalIP := TStringList.Create;
try
FillChar(Buffer, 64, 0);
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
FLocalIP.Add(StrPas(inet_ntoa(pptr^[I]^)));
Inc(I);
end;
Result := FLocalIP.Text;
finally
FLocalIP.Free;
end;
end;
procedure InitSocketSDK;
var
FWsaData : TWSAData;
begin
if WSAStartup(MakeWord(2, 2), FWsaData) <> 0 then Exit;
if FWsaData.wVersion <> MakeWord(2, 2) then WSACleanup;
end;
procedure UnInitSocketSDK;
begin
WSACleanup;
end;
initialization
InitSocketSDK;
finalization
UnInitSocketSDK;
{$ENDIF}
end. |
|