mainunit.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:3k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit mainunit;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5.   Dialogs, StdCtrls,WinSock,Registry;
  6. type
  7.   TForm1 = class(TForm)
  8.     GroupBox1: TGroupBox;
  9.     Button1: TButton;
  10.     Button2: TButton;
  11.     Label1: TLabel;
  12.     Edit1: TEdit;
  13.     GroupBox2: TGroupBox;
  14.     Label2: TLabel;
  15.     Edit2: TEdit;
  16.     Label3: TLabel;
  17.     Edit3: TEdit;
  18.     Label4: TLabel;
  19.     Edit4: TEdit;
  20.     Label6: TLabel;
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure Button2Click(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.   public
  26.     procedure GetLoacalIpAddr;
  27.     function  GetNetCardServiceName:String;
  28.     { Public declarations }
  29.   end;
  30. var
  31.   Form1: TForm1;
  32. implementation
  33. {$R *.dfm}
  34. procedure TForm1.GetLoacalIpAddr;
  35. var
  36.  HostEnt: PHostEnt;
  37.  Ip: String;
  38.  Addr: Pchar;
  39.  Buffer: Array [0..63] of Char;
  40.  GInitData: TWSADATA;
  41. begin
  42.  try
  43.   WSAStartup(2, GInitData);
  44.   GetHostName(Buffer, SizeOf(Buffer));
  45.   HostEnt := GetHostByName(Buffer);
  46.   if HostEnt = nil then
  47.    begin
  48.     ShowMessage('无法取得主机名!请检查网络设置后再进行尝试.');
  49.     Exit;
  50.    end;
  51.   Addr := HostEnt^.h_addr_list^;
  52.   Ip := Format('%d.%d.%d.%d', [byte(addr [0]),
  53.                Byte (addr [1]), byte (addr [2]), byte (addr [3])]);
  54.   Edit1.Text:=Ip;
  55.   ShowMessage('当前主机的IP地址为:'+Ip);
  56.   finally
  57.     WSACleanup;
  58.   end;
  59. end;
  60. function  TForm1.GetNetCardServiceName:String;
  61. var
  62.  Reg:TRegistry;
  63.  SubKeyList:TStringList;
  64.  i:Integer;
  65.  sNetCardRegKey:String;
  66. begin
  67.  Result:='';
  68.  Reg:=TRegistry.Create;
  69.  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  70.  sNetCardRegKey:='SOFTWAREMicrosoftWindows NTCurrentVersionNetworkCards';
  71.  try
  72.   Reg.OpenKeyReadOnly(sNetCardRegKey);
  73.   SubKeyList:=TStringList.Create;
  74.   Reg.GetKeyNames(SubKeyList);
  75.   for i:=0 to SubKeyList.Count-1 do
  76.    begin
  77.      Reg.OpenKeyReadOnly(sNetCardRegKey+''+SubKeyList.Strings[i]);
  78.      if Reg.ValueExists('ServiceName') then
  79.       begin
  80.         Result:=Reg.ReadString('ServiceName');
  81.         Label6.Caption:=Reg.ReadString('Description');
  82.         break;
  83.       end;
  84.    end;
  85.   finally
  86.    Reg.CloseKey;
  87.    Reg.Free;
  88.    SubKeyList.Free;
  89.   end;
  90.   if Result='' then
  91.    ShowMessage('网卡设置存在问题:网卡驱动程序错误或网卡未安装.');
  92. end;
  93. procedure TForm1.Button1Click(Sender: TObject);
  94. begin
  95.  GetLoacalIpAddr;
  96. end;
  97. procedure TForm1.Button2Click(Sender: TObject);
  98. var
  99.  Reg:TRegistry;
  100.  sServiceRegKey,sTCPIPRegKey:String;
  101.  GateWayArray,NetMaskArray,IPAddressArray:Array[1..255]of Char;
  102.  TempStr:String;
  103.  i:Integer;
  104. begin
  105.  Reg:=TRegistry.Create;
  106.  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  107.  try
  108.   sServiceRegKey:= 'SYSTEMCurrentControlSetServices';
  109.   sTCPIPRegKey := sServiceRegKey + GetNetCardServiceName+'ParametersTcpip';
  110.   Reg.OpenKeyReadOnly(sTCPIPRegKey);
  111.   Reg.ReadBinaryData('IPAddress', IPAddressArray, 255);
  112.   Reg.ReadBinaryData('SubNetMask',NetMaskArray, 255);
  113.   Reg.ReadBinaryData('DefaultGateway',GatewayArray, 255);
  114.   Edit2.Text:=IPAddressArray;
  115.   Edit1.Text:=IPAddressArray;
  116.   Edit3.Text:=NetMaskArray;
  117.   Edit4.Text:=GatewayArray;
  118.  finally
  119.   Reg.CloseKey;
  120.   Reg.Free;
  121.  end;
  122. end;
  123. end.