[~ SaM ~]

Если кому-нибудь понадобится, то вот исходник!! Долбялся+рылся в инэте долго, но все работает!

Код:

unit uMain;

{$DEFINE RUS}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, CommCtrl, Winsock;

const
  {$IFDEF RUS}
    RES_UNKNOWN = 'Неизвестно';
    RES_IP      = 'IP адрес: ';
    RES_CMP     = 'Имя компьютера: ';
    RES_USR     = 'Имя пользователя: ';
    RES_DOM     = 'Домен: ';
    RES_SER     = 'Сервер домена: ';
    RES_COM     = 'Коментарий: ';
    RES_PROV    = 'Провайдер: ';
    RES_GRP     = 'Группы: ';
    RES_MAC     = 'MAC адресс: ';
    RES_SHARES  = 'Доступные ресурсы: ';
    RES_TIME    = 'Времени затрачено: ';
    RES_COM_NO  = 'Отсутствует';
  {$ELSE}
    RES_UNKNOWN = 'Unknown';
    RES_IP      = 'IP adress: ';
    RES_CMP     = 'Computer name: ';
    RES_USR     = 'User name: ';
    RES_DOM     = 'Domen: ';
    RES_SER     = 'Domen server: ';
    RES_COM     = 'Comment: ';
    RES_PROV    = 'Provider: ';
    RES_GRP     = 'Groups: ';
    RES_MAC     = 'MAC adress: ';
    RES_SHARES  = 'Available shares: ';
    RES_TIME    = 'Expended time: ';
    RES_COM_NO  = 'Absent';
  {$ENDIF}

  WSA_TYPE = $101;

  //ARP (Address Resolution Protocol)
  IPHLPAPI = 'IPHLPAPI.DLL';
  MAX_ADAPTER_ADDRESS_LENGTH = 7;

type

  LMSTR = LPWSTR;
  NET_API_STATUS = DWORD;


  // МАС
  TMacAddress = array[0..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

  //единичный запрос
  TMibIPNetRow = packed record
    dwIndex         : DWORD;
    dwPhysAddrLen   : DWORD;
    bPhysAddr       : TMACAddress;
    dwAddr          : DWORD;
    dwType          : DWORD;
  end;

  TMibIPNetRowArray = array [0..512] of TMibIPNetRow;


  PTMibIPNetTable = ^TMibIPNetTable;
  TMibIPNetTable = packed record
    dwNumEntries    : DWORD;
    Table: TMibIPNetRowArray;
  end;

  TMainForm = class(TForm)
    btnGetInfo: TButton;
    memInfo: TMemo;
    Label1: TLabel;
    Button1: TButton;
    GetMem_M: TLabel;
    SetMem_M: TLabel;
    MemFree_M: TLabel;
    procedure btnGetInfoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    IP, Font: Integer;
    edIP: HWND;
    function GetNameFromIP(const IP: String): String;
    function GetMacFromIP(const IP: String): String;
  end;


  {$EXTERNALSYM WNetGetResourceInformation}
  function WNetGetResourceInformation(lpNetResource: PNetResource;
    lpBuffer: Pointer; var lpcbBuffer: DWORD; lplpSystem: Pointer): DWORD; stdcall;
  {$EXTERNALSYM GetIpNetTable}
  function GetIpNetTable(pIpNetTable: PTMibIPNetTable;
    pdwSize: PULONG; bOrder: Boolean): DWORD; stdcall;

  function WNetGetResourceInformation; external mpr name 'WNetGetResourceInformationA';
  function GetIpNetTable; external IPHLPAPI name 'GetIpNetTable';


var
  MainForm: TMainForm;

implementation

{$R *.dfm}


procedure TMainForm.FormCreate(Sender: TObject);
begin
   IP := MAKEIPADDRESS(192, 168, 1, 3);

  InitCommonControl(ICC_INTERNET_CLASSES);

  edIP:= CreateWindow(WC_IPADDRESS, nil, WS_CHILD or WS_VISIBLE,
    6, 16, MainForm.Width-22, 21, MainForm.Handle, 0, hInstance, nil);

  SendMessage(edIP, IPM_SETADDRESS, 0, IP);

  Font := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
    DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

  SendMessage(edIP, WM_SETFONT, Font, 0);
end;


procedure TMainForm.btnGetInfoClick(Sender: TObject);
var
  TmpCompName, TmpProvider, TmpGroup, TmpUser, TmpServer: String;
  Time: Cardinal;
  IPStr: String;
  i:byte;
begin
  Time := GetTickCount;

  SendMessage(edIP, IPM_GETADDRESS, 0, Longint(PDWORD(@IP)));

  IPStr := IntToStr(FIRST_IPADDRESS(IP));
  IPStr := IPStr + '.' + IntToStr(SECOND_IPADDRESS(IP));
  IPStr := IPStr + '.' + IntToStr(THIRD_IPADDRESS(IP));
  IPStr := IPStr + '.' + IntToStr(FOURTH_IPADDRESS(IP));


  with memInfo, memInfo.Lines do                        // Вывод информации
  begin
    Clear;                                              // Очищаем экран
    Refresh;                                            // Обновляем...

    Add(RES_IP + IPStr);                                // Выводим IP
    TmpCompName := GetNameFromIP(IPStr);
    if TmpCompName = RES_UNKNOWN then Exit;
    Add(RES_CMP + TmpCompName);                         // Выводим имя компьютера
    Add(RES_MAC + GetMacFromIP(IPStr));                 // Выводим МАС адрес
    for i:=1 to 3 do begin
    Add('');
    end;
    Add(GetMem_M.Caption);
    Add(SetMem_M.Caption);
    Add(MemFree_M.Caption);
    for i:=1 to 3 do begin
    Add('');
    end;
    Add('Затрачено времени на выполнение программы: '+ IntToStr(GetTickCount - Time));      // Сколько времени затрачено
  end;
end;

function TMainForm.GetNameFromIP(const IP: String): String;
var
  WSA: TWSAData;
  Host: PHostEnt;
  Addr: Integer;
  Err: Integer;
begin
  Result := RES_UNKNOWN;
  Err := WSAStartup(WSA_TYPE, WSA);
  if Err <> 0 then
  begin
    ShowMessage(SysErrorMessage(GetLastError));  //при ошибке ее код
    Exit;
  end;
  try
    Addr := inet_addr(PChar(IP));
    if Addr = INADDR_NONE then
    begin
      ShowMessage(SysErrorMessage(GetLastError));
      WSACleanup;
      Exit;
    end;
    Host := gethostbyaddr(@Addr, SizeOf(Addr), PF_INET);
    if Assigned(Host) then
      Result := Host.h_name
    else
      ShowMessage(SysErrorMessage(GetLastError));
  finally
    WSACleanup;
  end;
end;


function TMainForm.GetMacFromIP(const IP: String): String;

  function GetMAC(Value: TMacAddress; Length: DWORD): String;
  var
    I: Integer;
  begin
    if Length = 0 then Result := '00-00-00-00-00-00' else
    begin
      Result := '';
      for i:= 0 to Length -2 do
        Result := Result + IntToHex(Value[i], 2) + '-';
      Result := Result + IntToHex(Value[Length-1], 2);
    end;
  end;

function GetDottedIPFromInAddr(const InAddr: Integer): String;
  begin
    Result := '';
    Result := IntToStr(FOURTH_IPADDRESS(InAddr));
    Result := Result + '.' + IntToStr(THIRD_IPADDRESS(InAddr));
    Result := Result + '.' + IntToStr(SECOND_IPADDRESS(InAddr));
    Result := Result + '.' + IntToStr(FIRST_IPADDRESS(InAddr));
  end;

var
  Table: TMibIPNetTable;
  Size: Integer;
  CatchIP: String;
  Err, I: Integer;
begin
  Result := RES_UNKNOWN;
  Size := SizeOf(Table);
  Err := GetIpNetTable(@Table, @Size, False);
  if Err <> NO_ERROR then                     // Проверка на ошибку...
  begin
    ShowMessage(SysErrorMessage(GetLastError));
    Exit;
  end;

  for I := 0 to Table.dwNumEntries - 1 do
  begin
    CatchIP := GetDottedIPFromInAddr(Table.Table[i].dwAddr);
    if CatchIP = IP then                      //Выводим МАС
    begin
      Result := GetMAC(Table.Table[i].bPhysAddr, Table.Table[i].dwPhysAddrLen);
      Break;
    end;
  end;
end;


procedure TMainForm.Button1Click(Sender: TObject);
begin
Close;
end;

end.