Delphi经典实例6------三种方式获取本机IP

unit mainunit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WinSock,Registry;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Edit1: TEdit;
GroupBox2: TGroupBox;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
Label4: TLabel;
Edit4: TEdit;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
procedure GetLoacalIpAddr;
function  GetNetCardServiceName:String;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.GetLoacalIpAddr;
var
HostEnt: PHostEnt;
Ip: String;
Addr: PAnsiChar;
Buffer: Array [0..63] of AnsiChar;
GInitData: TWSADATA;
begin
try
WSAStartup(2, GInitData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt := GetHostByName(Buffer);
if HostEnt = nil then
begin
ShowMessage('无法取得主机名!请检查网络设置后再进行尝试.');
Exit;
end;
Addr := HostEnt^.h_addr_list^;
Ip := Format('%d.%d.%d.%d', [byte(addr [0]),
Byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Edit1.Text:=Ip;
ShowMessage('当前主机的IP地址为：'+Ip);
finally
WSACleanup;
end;
end;

function  TForm1.GetNetCardServiceName:String;
var
Reg:TRegistry;
SubKeyList:TStringList;
i:Integer;
sNetCardRegKey:String;
begin
Result:='';
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
sNetCardRegKey:='/SOFTWARE/Microsoft/Windows NT/CurrentVersion/NetworkCards';
try
Reg.OpenKeyReadOnly(sNetCardRegKey);
SubKeyList:=TStringList.Create;
Reg.GetKeyNames(SubKeyList);
for i:=0 to SubKeyList.Count-1 do
begin
Reg.OpenKeyReadOnly(sNetCardRegKey+'/'+SubKeyList.Strings[i]);
if Reg.ValueExists('ServiceName') then
begin
Result:=Reg.ReadString('ServiceName');
Label6.Caption:=Reg.ReadString('Description');
break;
end;
end;
finally
Reg.CloseKey;
Reg.Free;
SubKeyList.Free;
end;
if Result='' then
ShowMessage('网卡设置存在问题：网卡驱动程序错误或网卡未安装.');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetLoacalIpAddr;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Reg:TRegistry;
sServiceRegKey,sTCPIPRegKey:String;
GateWayArray,NetMaskArray,IPAddressArray:Array[1..255]of Char;
TempStr:String;
i:Integer;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
try
sServiceRegKey:= '/SYSTEM/CurrentControlSet/Services/';
sTCPIPRegKey := sServiceRegKey + GetNetCardServiceName+'/Parameters/Tcpip';
Reg.OpenKeyReadOnly(sTCPIPRegKey);
Reg.ReadBinaryData('IPAddress', IPAddressArray, 255);
Reg.ReadBinaryData('SubNetMask',NetMaskArray, 255);
Reg.ReadBinaryData('DefaultGateway',GatewayArray, 255);
Edit2.Text:=IPAddressArray;
Edit1.Text:=IPAddressArray;
Edit3.Text:=NetMaskArray;
Edit4.Text:=GatewayArray;
finally
Reg.CloseKey;
Reg.Free;
end;
end;

end.

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdIPWatch;

type
TForm2 = class(TForm)
IdIPWatch1: TIdIPWatch;
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
Edit1.Text := IdIPWatch1.LocalIP;
end;

end.