Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 3199|回复: 3

获取本机IP(uses 加上winsock)

[复制链接]

该用户从未签到

发表于 2012-4-12 17:02:53 | 显示全部楼层 |阅读模式
uses 加上winsock,感觉和delphi一样
function TForm1.getLocalIP : string;
  type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe  : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [0..63] of ANSIchar;
    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;  

评分

参与人数 1威望 +6 收起 理由
bugxiong + 6 Lazarus社区有你更精彩!

查看全部评分

回复

使用道具 举报

该用户从未签到

发表于 2012-4-13 07:57:26 | 显示全部楼层
Lazarus社区有你更精彩!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 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.
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-10-7 17:50:00 | 显示全部楼层
本机信息呀
学习一下
回复 支持 反对

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2025-5-2 20:28 , Processed in 0.035722 second(s), 14 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表