mainunit.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

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:='\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.