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;
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);
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.
18.09.2007, 19:45
Не знаю как сделать:(
Линейный вид
