1、//取IP地址
function GetIP : 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; 2、获取路由、网关信息、网卡信息: Procedure TForm1.Button1Click(Sender:TObject); begin Memo1.Lines.Clear; if FileExists(Temp) then DeleteFile(Temp); WinExec(PChar('command.com /C route print >'+Temp),SW_HIDE); while not FileExists(Temp) do Sleep(1000) Try Memo1.Lines.LoadFromFile(Temp); except end; end; 3、所有信息 function 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; program get_ip; uses winsock,sysutils; VAR ch : ARRAY[1..32] OF Char; i : Integer; WSData: TWSAData; MyHost: PHostEnt; begin IF WSAstartup(2,wsdata)<>0 THEN BEGIN Writeln('can''t start Winsock: Error ',WSAGetLastError); Halt(2); END; try IF getHostName(@ch[1],32)<>0 THEN BEGIN Writeln('getHostName failed'); Halt(3); END; except Writeln('getHostName failed'); halt(3); end; MyHost:=GetHostByName(@ch[1]); IF MyHost=NIL THEN BEGIN Writeln(GetHostName('+StrPas(@ch[1])+') failed : Error '+IntToStr(WSAGetLastError)); Halt(4); END ELSE BEGIN Write('address '); FOR i:=1 TO 4 DO BEGIN Write(Ord(MyHost.h_addr^[i-1])); IF i<4 THEN then write('.') ELSE writeln; END; END; end. 4、获取路由、网关信息、网卡信息: Procedure TForm1.Button1Click(Sender:TObject); begin Memo1.Lines.Clear; if FileExists(Temp) then DeleteFile(Temp); WinExec(PChar('command.com /C route print >'+Temp),SW_HIDE); while not FileExists(Temp) do Sleep(1000) Try Memo1.Lines.LoadFromFile(Temp); except end; end; 5、MAC代码: procedure TForm1.Button1Click(Sender: TObject); Var NCB : TNCB; ADAPTER : TADAPTERSTATUS; LANAENUM : TLANAENUM; intIdx : Integer; re : Char; buf : String; begin Try { ZeroMemory(@NCB, SizeOf(NCB)); NCB.ncb_command := Chr(NCBENUM); re := NetBios(@NCB); // Reissue enum command NCB.ncb_buffer := @LANAENUM; NCB.ncb_length := SizeOf(LANAENUM); re := NetBios(@NCB); If Ord(re)<>0 Then exit; } { Copyright (C) Bowman } { MatthewBowman@21cn.com } // Reset adapter ZeroMemory(@NCB, SizeOf(NCB)); NCB.ncb_command := Chr(NCBRESET); NCB.ncb_lana_num := LANAENUM.lana[0];//important re := NetBios(@NCB); If Ord(re)<>0 Then exit; // Get adapter address ZeroMemory(@NCB, SizeOf(NCB)); NCB.ncb_command := Chr(NCBASTAT); NCB.ncb_lana_num := LANAENUM.lana[0];////bowman StrPCopy(NCB.ncb_callname, '*'); NCB.ncb_buffer := @ADAPTER; NCB.ncb_length := SizeOf(ADAPTER); re := NetBios(@NCB); If Ord(re)<>0 Then exit; buf := ''; For intIdx := 0 To 5 Do buf := buf + InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2)+'-'; edit1.Text := copy(buf,0,length(buf)-1); Finally End; end; 6、取子网隐码: procedure TForm1.Button1Click(Sender: TObject); var reg:TRegistry; re:boolean; device:string; buf:pchar; mask:string; adapter:string; begin reg:=TRegistry.Create(); try Reg.RootKey := HKEY_LOCAL_MACHINE; //open key //win NT //get bind device re:=Reg.OpenKey('SYSTEM/CurrentControlSet/Services/Tcpip/Linkage', false); if re then begin getmem(buf,1024); Reg.ReadBinaryData('Bind',buf^,1024); device := strpas(buf); freemem(buf); end else begin edit1.text:='Failed to get bind device'; reg.closekey(); reg.Free; exit; end; reg.CloseKey; //get adapter adapter:=copy(device,2,length(device)-1); showmessage(adapter); adapter:=copy(adapter,POS('/',adapter)+1,length(adapter)-POS('/',adapter)); showmessage(adapter); //query re:=Reg.OpenKey('SYSTEM/CurrentControlSet/Services/'+ adapter+ '/Parameters/Tcpip', false); if re then begin getmem(buf,1024); Reg.ReadBinaryData('SubnetMask',buf^,1024); mask := strpas(buf); freemem(buf); end else mask:='Failed to get subnet mask'; finally Reg.CloseKey; Reg.Free; end; edit1.text:=device; edit2.text:=mask; end; 7、子网隐码WIn98下: procedure TForm1.Button1Click(Sender: TObject); var reg:TRegistry; re:boolean; mask:string; begin reg:=TRegistry.Create(); try Reg.RootKey := HKEY_LOCAL_MACHINE; //open key //win 9x re:=Reg.OpenKey('System/CurrentControlSet/Services/Class/NetTrans/0000', false); if re then begin mask := Reg.Readstring('IPMask'); end else begin edit1.text:='Failed to get mask'; reg.closekey(); reg.Free; exit; end; finally Reg.CloseKey; Reg.Free; end; edit1.text:=mask; end; 8、这一段获得主机名字,IP地址等的代码 =============================================== unit hostName; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Winsock; type TForm1 = class(TForm) Edit1: TEdit; Label1: TLabel; Label2: TLabel; Edit2: TEdit; Edit3: TEdit; Label3: TLabel; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var Ip:string; Ipstr:string; Buffer:Array[1..32] of char; i:integer; WSData:TWSAdata; Host:PHostEnt; begin if WSAstartup(2,WSData)<>0 then begin ShowMessage('WS2_32.DLL初始化失败!'); halt; end; try if GetHostName(@Buffer[1],32)<>0 then begin ShowMessage('没有得到主机名!'); halt; end; except ShowMessage('没有成功返回主机名'); halt; end; Host := GetHostByName(@Buffer[1]); if Host = nil then begin ShowMessage('IP地址为空'); halt; end else begin Edit2.Text := Host.h_name; Edit3.Text := Chr(Host.h_addrtype+64); for i:=1 to 4 do begin Ip:=IntToStr(Ord(Host.h_addr^[i-1])); ShowMessage('分段IP地址为:'+Ip); if i<4 then Ipstr := Ipstr + Ip + '.' else Edit1.Text:=Ipstr+Ip; end; end; WSACleanup; end; end. |
|