获取计算机名和IP

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function GetIP:String;
    function GetPCName:string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetIP: String;
var
  phe:pHostEnt;
  w:TWSAData;
  ip_address:longint;
  p:^longint;
  ipstr:string;
begin
  if WSAStartup(2,w)<>0 then exit;
  phe:=GetHostbyName(pchar(GetPCName));
  if phe<>nil then
    begin
      p:=pointer(phe^.h_addr_list^);
      ip_address:=p^;
      ip_address:=ntohl(ip_address);
      ipstr:=IntToStr(ip_address shr 24)+'.'+IntToStr((ip_address shr 16) and $ff)
         +'.'+IntToStr((ip_address shr 8) and $ff)+'.'+IntToStr(ip_address and $ff);
      Result :=ipstr;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Text :=GetIP;
edit2.Text := GetPCName;
end;

function TForm1.GetPCName: string;
var
  LocalMachine: PChar;
  Len: DWord;
begin
  Len := MAX_COMPUTERNAME_LENGTH + 1; // 取得本机电脑名称
  GetMem(LocalMachine,Len);
  if GetComputerName(LocalMachine,Len) then Result := LocalMachine
  else  Result := 'UnKnow';
  FreeMem(LocalMachine,Len);

end;

end.

posted on 2011-11-17 22:15  舟山牙医  阅读(248)  评论(0编辑  收藏  举报

导航