如何獲得IP地址，網域名稱，電腦名稱等資訊

在程式中，想要實現一個根據使用者提供的IP地址、網域名稱或者電腦名稱等資訊來驗證使用者的輸入資訊是否正確，但是一般用於是對於這些資訊是模糊的，也許有人連電腦名稱是什麼都不知道，那此時如何提供一個快捷的通道，來實現這樣的驗證資訊呢，或者就像SQLServer一樣，如何通過域認證來實現登入呢，這就和今天要說的內容相關，如果我能通過一些api預設得到域中的資訊，就可以實現了類似的功能。

下面介紹相關的實現內容：

unit Unit1;

interface

uses
  Windows, SysUtils, Variants, StdCtrls, ExtCtrls, Forms, Classes, Controls;

type
  TMainFrom = class(TForm)
  private
    function  GetLocalHostIp(const AMachine: string): string;
    function  GetMacAddresses(const AMachine: string): string;
    function  GetPCName: string;
    function  GetUserAndDomainFromPID(AProcessHandle: THandle;
      out ADomain, AUser: string): Boolean;
  end;

implementation

{$R *.dfm}

uses
  Nb30, Winsock;

const
  conHostIpFmt          = '%d.%d.%d.%d';

{TMainFrom}

function TMainFrom.GetLocalHostIp(const AMachine: string): string;
var
  pHost: PHostEnt;
  strName: string;
  nLength: Integer;
  cData: TWSAData;
begin
  WSAStartup(2, cData);
  try
    Result := '';
    strName := AMachine;
    nLength := StrLen(PChar(strName));
    SetLength(strName, nLength);
    pHost := GetHostByName(PChar(strName));
    if pHost = nil then
      Exit;
    with pHost^ do
      Result := Format(conHostIpFmt, [Byte(h_addr^[0]), Byte(h_addr^[1]),
        Byte(h_addr^[2]), Byte(h_addr^[3])]);
  finally
    WSACleanup;
  end;
end;

function TMainFrom.GetMacAddresses(const AMachine: string): string;
  function AdapterToString(Adapter: PChar): string;
  begin
    Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
     [Integer(Adapter[0]), Integer(Adapter[1]),
      Integer(Adapter[2]), Integer(Adapter[3]),
      Integer(Adapter[4]), Integer(Adapter[5])]);
  end;
type
  AStat = packed record
    adapt: TAdapterStatus;
    NameBuff: array [0..29] of TNameBuffer;
  end;
var
  NCB: TNCB;
  Enum: TLanaEnum;
  I, L, NameLen: Integer;
  Adapter: AStat;
  MachineName: string;
begin
  Result := '';
  MachineName := UpperCase(AMachine);
  if MachineName = '' then
    MachineName := '*';
  NameLen := Length(MachineName);
  L := NCBNAMSZ - NameLen;
  if L > 0 then
  begin
    SetLength(MachineName, NCBNAMSZ);
    FillChar(MachineName[NameLen + 1], L, ' ');
  end;
{
  From Junior/RO in NG: Microsoft's implementation limits NETBIOS names to 15 characters
}
  MachineName[NCBNAMSZ] := #0;
  FillChar(NCB, SizeOf(NCB), #0);
  NCB.ncb_command := Char(NCBENUM);
  NCB.ncb_buffer := Pointer(@Enum);
  NCB.ncb_length := SizeOf(Enum);
  if NetBios(@NCB) <> Char(NRC_GOODRET) then
    Exit;
  for I := 0 to Ord(Enum.Length) - 1 do
  begin
    FillChar(NCB, SizeOf(NCB), #0);
    NCB.ncb_command := Char(NCBRESET);
    NCB.ncb_lana_num := Enum.lana[I];
    if NetBios(@NCB) = Char(NRC_GOODRET) then
    begin
      FillChar(NCB, SizeOf(NCB), #0);
      NCB.ncb_command := Char(NCBASTAT);
      NCB.ncb_lana_num := Enum.lana[I];
      Move(MachineName[1], NCB.ncb_callname, SizeOf(NCB.ncb_callname));
      NCB.ncb_buffer := PChar(@Adapter);
      NCB.ncb_length := SizeOf(Adapter);
      if NetBios(@NCB) = Char(NRC_GOODRET) then
        Result := AdapterToString(PChar(@Adapter.adapt));
    end;
  end;
end;

function TMainFrom.GetPCName: string;
var
  nSize: Cardinal;
  pBuffer: array[0..MAX_PATH - 1] of Char;
begin
  nSize := MAX_PATH;
  if GetComputerName(pBuffer, nSize) then
    Result := StrPas(pBuffer)
  else Result := '';
end;

function TMainFrom.GetUserAndDomainFromPID(AProcessHandle: THandle;
  out ADomain, AUser: string): Boolean;
type
  PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
    AUser: TSidAndAttributes;
  end;
  TOKEN_USER = _TOKEN_USER;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  nUserSize, nDomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  if OpenProcessToken(AProcessHandle, TOKEN_QUERY, hToken) then
  try
    bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
    ptiUser  := nil;
    while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
    begin
      ReallocMem(ptiUser, cbBuf);
      bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
    end;
    if not bSuccess then
      Exit;
    nUserSize := 0;
    nDomainSize := 0;
    LookupAccountSid(nil, ptiUser.AUser.Sid, nil, nUserSize, nil, nDomainSize, snu);
    if (nUserSize <> 0) and (nDomainSize <> 0) then
    begin
      SetLength(AUser, nUserSize);
      SetLength(ADomain, nDomainSize);
      if LookupAccountSid(nil, ptiUser.AUser.Sid, PChar(AUser), nUserSize,
        PChar(ADomain), nDomainSize, snu) then
      begin
        Result := True;
        AUser := StrPas(PChar(AUser));
        ADomain := StrPas(PChar(ADomain));
      end;
    end;
    if bSuccess then
      FreeMem(ptiUser);
  finally
    CloseHandle(hToken);
  end;
end;

end.

現在就可以自由擷取電腦名稱，並通過電腦名稱來獲得IP地址，Mac地址和網域名稱了。

這個程式不僅試用於本機，也可以傳遞一個指定的電腦名稱，來獲得相關的資訊，其中注意網域名稱是通過當前的進程資訊獲得的。