mainunit.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:3k
- 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: Pchar;
- Buffer: Array [0..63] of Char;
- 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:='SOFTWAREMicrosoftWindows NTCurrentVersionNetworkCards';
- 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:= 'SYSTEMCurrentControlSetServices';
- sTCPIPRegKey := sServiceRegKey + GetNetCardServiceName+'ParametersTcpip';
- 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.