Демонстрационная программа получения информации о компьютере по IP
01.01.2007
// Демонстрационная программа получения информации о компьютере // на основе IP адреса // Автор: Александр (Rouse_) Багель // 30 декабря 2004 // ============================================================= // Специально для FAQ сайта Мастера Дельфи и Исходники.RU // http://www.delphimaster.ru // http://forum.sources.ru // Windows9x, Windows Millenium не поддерживются // Примечание: Я не любитель венгерской нотации в отношении переменных // и давно выработал собственный, удобный для меня, стиль написания кода, // (да и начальство не против :) поэтому не судить строго ;) 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; //$202; // Для работы с ARP (Address Resolution Protocol) таблицей IPHLPAPI = 'IPHLPAPI.DLL'; MAX_ADAPTER_ADDRESS_LENGTH = 7; type LMSTR = LPWSTR; NET_API_STATUS = DWORD; // Следующие три типа используются для работы с Iphlpapi.dll // Выдрал из Iphlpapi.h // Так будет выглядеть МАС 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; // Структура для перечисления залогиненных пользователей _WKSTA_USER_INFO_1 = record wkui1_username: LPWSTR; wkui1_logon_domain: LPWSTR; wkui1_oth_domains: LPWSTR; wkui1_logon_server: LPWSTR; end; WKSTA_USER_INFO_1 = _WKSTA_USER_INFO_1; PWKSTA_USER_INFO_1 = ^_WKSTA_USER_INFO_1; LPWKSTA_USER_INFO_1 = ^_WKSTA_USER_INFO_1; // Структура для определения принадлежности пользователя к группам PGroupUsersInfo0 = ^_GROUP_USERS_INFO_0; _GROUP_USERS_INFO_0 = packed record grui0_name: LPWSTR; end; TGroupUsersInfo0 = _GROUP_USERS_INFO_0; GROUP_USERS_INFO_0 = _GROUP_USERS_INFO_0; // Структура для отределения доступных сетевых ресурсов PSHARE_INFO_1 = ^SHARE_INFO_1; _SHARE_INFO_1 = record shi1_netname: LMSTR; shi1_type: DWORD; shi1_remark: LMSTR; end; SHARE_INFO_1 = _SHARE_INFO_1; TShareInfo1 = SHARE_INFO_1; PShareInfo1 = PSHARE_INFO_1; TMainForm = class(TForm) gbIP: TGroupBox; gbInfo: TGroupBox; memInfo: TMemo; btnGetInfo: TButton; procedure btnGetInfoClick(Sender: TObject); procedure FormCreate(Sender: TObject); private IP, Font: Integer; // Это переменные для работы с edIP: HWND; // WC_IPADDRESS классом function GetNameFromIP(const IP: String): String; function GetUsers(const CompName: String): String; function GetDomain(const CompName, Provider: String): String; function GetComment(CompName, Provider: String): String; function GetProvider(const CompName: String): String; function GetMacFromIP(const IP: String): String; function GetDomainServer(const DomainName: String): String; function GetGroups(DomainServer: String; UserName: String): String; function GetShares(const CompName: String): String; end; // Объявим функции, так как их объявлений нет в Дельфи. // Здесь идет статическая загрузка библиотек, только потому, // что данные функции есть во всех системах, начиная с W95... {$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'; function NetGetAnyDCName(servername: LPCWSTR; domainname: LPCWSTR; bufptr: Pointer): Cardinal; stdcall; external 'netapi32.dll'; function NetShareEnum(servername: LMSTR; level: DWORD; var bufptr: Pointer; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; external 'Netapi32.dll'; function NetApiBufferFree(buffer: Pointer): Cardinal; stdcall; external 'netapi32.dll'; function NetWkstaUserEnum(ServerName: LPCWSTR; Level: DWORD; BufPtr: Pointer; PrefMaxLen: DWORD; EntriesRead: LPDWORD; TotalEntries: LPDWORD; ResumeHandle: LPDWORD): LongInt; stdcall; external 'netapi32.dll'; function NetUserGetGroups(ServerName: LPCWSTR; UserName: LPCWSTR; level: DWORD; bufptr: Pointer; prefmaxlen: DWORD; var entriesread: DWORD; var totalentries: DWORD): LongInt; stdcall; external 'netapi32.dll'; var MainForm: TMainForm; implementation {$R *.dfm} // Для ввода IP адреса будем использовать класс WC_IPADDRESS // именно для этого и предназначеный... procedure TMainForm.FormCreate(Sender: TObject); begin // Зададим первоначальный IP адрес (это адрес моей машины) IP := MAKEIPADDRESS(192, 168, 2, 108); // Инициализируем дополнительные классы библиотеки ComCtl32.dll. InitCommonControl(ICC_INTERNET_CLASSES); // Создадим само окошко (предком ему будет gbIP) edIP:= CreateWindow(WC_IPADDRESS, nil, WS_CHILD or WS_VISIBLE, 6, 16, 100, 21, gbIP.Handle, 0, hInstance, nil); // Укажем ему какой IP показывать 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; begin Time := GetTickCount; // Засечем время... // Узнаем, что за адрес введен... (он появится в IP) SendMessage(edIP, IPM_GETADDRESS, 0, Longint(PDWORD(@IP))); // Преобразуем эту абракадабру в нормальный "Dotted 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); // Выводим имя компьютера TmpUser := GetUsers(IPStr); Add(RES_USR + TmpUser); // Выводим имя пользователя TmpProvider := GetProvider(TmpCompName); Add(RES_PROV + TmpProvider); // Выводим провайдера Add(RES_COM + GetComment(TmpCompName, TmpProvider)); // Выводим комментарий к ресурсу TmpGroup := GetDomain(TmpCompName, TmpProvider); Add(RES_DOM + TmpGroup); // Выводим группу TmpServer := GetDomainServer(TmpGroup); if TmpServer <> '' then begin Add(RES_SER + TmpServer); // Выводим имя сервера Add(RES_GRP + GetGroups(TmpServer, TmpUser)); // Выводим группы домена в которые входит пользователь end; Add(RES_SHARES + GetShares(TmpCompName)); // Выводим список доступных ресурсов Add(RES_MAC + GetMacFromIP(IPStr)); // Выводим МАС адрес Add(RES_TIME + IntToStr(GetTickCount - Time)); // Сколько времени затрачено end; end; // Вообщето желательно запускать данную функцию отдельным потоком. // Поясню: при отсутствии компьютера с заданным IP программа будет // ожидать выполнения gethostbyaddr и на это время подвиснет. 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 // отсутствии компьютера с заданым IP, получим AV else ShowMessage(SysErrorMessage(GetLastError)); finally WSACleanup; end; end; // Перечисляем всех залогиненных на машине пользователей // начинаем перечисления со второго пользователя, потомчто // первым будет "имя компьютера"$ function TMainForm.GetUsers(const CompName: String): String; var Buffer, tmpBuffer: Pointer; PrefMaxLen : DWORD; Resume_Handle : DWORD; EntriesRead : DWORD; TotalEntries : DWORD; I, Size : Integer; PSrvr : PWideChar; begin PSrvr := nil; try // Переводим имя компьютера типа PWideChar Size := Length(CompName); GetMem(PSrvr, Size * SizeOf(WideChar) + 1); StringToWideChar(CompName, PSrvr, Size + 1); PrefMaxLen := DWORD(-1); EntriesRead := 0; TotalEntries := 0; Resume_Handle := 0; Buffer := nil; // Получаем список пользователей на компьютере из PSrvr if NetWkstaUserEnum( PSrvr, 1, @Buffer, PrefMaxLen, @EntriesRead, @TotalEntries, @Resume_Handle) = S_OK then begin tmpBuffer := Pointer(DWORD(Buffer) + SizeOf(WKSTA_USER_INFO_1)); for I := 1 to TotalEntries - 1 do begin Result := Result + WKSTA_USER_INFO_1(tmpBuffer^).wkui1_username + ', '; tmpBuffer := Pointer(DWORD(tmpBuffer) + SizeOf(WKSTA_USER_INFO_1)); end; Result := Copy(Result, 1, Length(Result) - 2); end else ShowMessage(SysErrorMessage(GetLastError)); finally NetApiBufferFree(Buffer); FreeMem(PSrvr); end; end; // Все-таки будем сканировать сеть, НО!!! // Мы не будем производить рекурсивное сканирование ресурсов с // dwDisplayType равным RESOURCEDISPLAYTYPE_SERVER!!! // В основном все торможение происходить именно здесь, // так как эти ресурсы являются так называемыми корневыми // для компьютеров. Если компьютер отключен его имя может сохраниться // в кэше и при попытке сканирования получим ненужные нам тормоза. // В принципе, у меня эта функция выдавала неплохие результаты по скорости... // (Около 31 мс - максимум с отображением на memInfo, сеть 100Мб, 28 компов) function TMainForm.GetComment(CompName, Provider: String): String; var StopScan: Boolean; TmpRes: TNetResource; // Само сканирование procedure Scan(Res: TNetResource; Root: boolean); var Enum, I: Cardinal; ScanRes: array [0..512] of TNetResource; // Можно сделать и больший размер массива Size, Entries, Err: DWORD; // но, как показывает практика, такого достаточно begin if StopScan then Exit; // Используем флаг для выхода из рекурсии // Ну тут думаю все понятно... просто два типа начала сканирования if Root = True then Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, nil, Enum) // корневой... else Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, @Res, Enum); // и рекурсионный для поиска вложений... if Err = NO_ERROR then begin Size := SizeOf(ScanRes); Entries := DWORD(-1); Err := WNetEnumResource(Enum, Entries, @ScanRes, Size); if Err = NO_ERROR then try for I := 0 to Entries - 1 do begin if StopScan then Exit; // Еще один флаг, так как выход на верхний вызов with ScanRes[i] do // может осуществиться из цикла begin if dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then if lpRemoteName = CompName then // если нашли наш компьютер... begin Result := lpComment; // вытаскиваем комментарий StopScan := True; // и выставляем флаг для выхода из рекуссии Exit; end; if dwDisplayType <> RESOURCEDISPLAYTYPE_SERVER then // не будем сканировать шары у компов... Scan(ScanRes[i], False); end; end; finally WNetCloseEnum(Enum); end else if Err <> ERROR_NO_MORE_ITEMS then // Нет элементов для отображения... MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0); end else ShowMessage(SysErrorMessage(GetLastError)); end; // Основная процедура begin // Подготовительные действия... Result := RES_UNKNOWN; if CompName = RES_UNKNOWN then Exit; // Если имя компа не найдено, // незачем и продолжать. CompName := '\\' + CompName; // Подправим имя, // чтоб не делать это далее в цикле... StopScan := False; // Снимем флаг выхода из рекурсии. // Здесь обязательно инициализирование переменной // типа Boolean, так как было замечено, что // некоторые версии Дельфи криво инициализируют // значение по умолчанию, после чего логические // операторы типа AND - OR - NOT перестают работать. // Например: по умолчанию переменная StopScan равна False // без инициализации, после StopScan := not StopScan; // переменная StopScan НЕ ВСЕГДА станет True!!! // Запускаем сканирование... // (можно и в потоке, но у меня время на сканирование уходит 8 мс.) Scan(TmpRes, True); // И смотрим результаты... if Result = '' then Result := RES_COM_NO; end; // Задача этой функции предельно проста: // При известном имени компьютера мы можем заполнить структуру // и передать ее функции WNetGetResourceParent которая и вернет // нам предка, в моем случае группу. // Да, чуть не забыл, если имя компьютера есть в кэше, а сам // компьютер отключен, то в качестве результата будет либо // пустая строка либо 'Нет данных'... // Поэтому опять придется сканировать, если слишком уж критично... function TMainForm.GetDomain(const CompName, Provider: String): String; var CurrRes: TNetResource; ParentName: array [0..1] of TNetResource; Enum: DWORD; Err: Integer; begin with CurrRes do begin dwScope := RESOURCE_GLOBALNET; dwType := RESOURCETYPE_DISK; dwDisplayType := RESOURCEDISPLAYTYPE_SERVER; dwUsage := RESOURCEUSAGE_CONTAINER; lpLocalName := ''; lpRemoteName := PChar('\\' + CompName); lpComment := ''; lpProvider := PChar(Provider); end; Enum := SizeOf(ParentName); Err := WNetGetResourceParent(@CurrRes, @ParentName, Enum); if Err = NO_ERROR then begin Result := ParentName[0].lpRemoteName; if Result = '' then Result := RES_COM_NO; end else ShowMessage(SysErrorMessage(GetLastError)); end; // А этой функцией мы можем узнать провайдера // (в основном это Microsoft Network). function TMainForm.GetProvider(const CompName: String): String; var Buffer: array [0..255] of Char; Size: DWORD; begin Size := SizeOf(Buffer); if WNetGetProviderName(WNNC_NET_LANMAN, @Buffer, Size) <> NO_ERROR then Result := RES_COM_NO else Result := String(Buffer); end; // Из всех приведенных функций эта самая интересная. // Я много раз говорил о незаслуженном невнимании программистов // к IPHLPAPI.DLL. Данный пример подтверждает это. На всех форумах // можно услышать о получании МАС адреса посредством посылки IPX пакета // и разбора заголовка ответа от удаленного компьютера // (что само по себе геморой, если не принимать во внимание, // что IPX уже практически вымер, и его мало где встретишь). // Здесь же строится полная ARP таблица, на основании которой мы // можем спокойно произвести выборку по нужному IP адресу, // а так как все берется из кэша, то мы сможем узнать МАС адреса // даже выключенных компьютеров... // Единственный минус: в таблице (не всегда) отсутсвует информация // по локальному компьютеру, т.е. таким образом можно получить // все МАС адреса за исключением своего, // но для этого есть уже другие функции... // Приведу выдержку из MSDN: // You can use IP Helper to perform Address Resolution Protocol (ARP) operations for the local computer. // Use the following functions to retrieve and modify the ARP table. // The GetIpNetTable retrieves the ARP table. // The ARP table contains the mapping of IP addresses to physical addresses. // Physical addresses are sometimes referred to as Media Access Controller (MAC) addresses. // Хочу заметить что для NT есть очень интересная функция SendARP - позволяющая // напрямую получить требуемый МАС без построения таблицы, поэтому советую // модифицировать код программы для более эффективного исполнения участков кода // под различными системами. 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; // Получаем IP адрес, заметь в отличии от работы с классом WC_IPADDRESS // здесь преобразование идет в обратном порядке! 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; // Теперь мы имеем таблицу из IP адресов и соответсвующих им MAC адресов for I := 0 to Table.dwNumEntries - 1 do // Ищем нужный IP ... 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; // Полуение доступных сетевых ресурсов на удаленном компьютере function TMainForm.GetShares(const CompName: String): String; type TShareInfo1Array = array of TShareInfo1; var entriesread, totalentries: DWORD; Info: Pointer; I: Integer; CN: PWideChar; begin CN := StringToOleStr(CompName); // так как нам нужны только имена ресурсов, воспользуемся струтурой TShareInfo1 // тогда, не нужно будет получать привилегии администратора на удаленной машине :) if NetShareEnum(CN, 1, Info, DWORD(-1), @entriesread, @totalentries, nil) = 0 then try // список ресурсов смотрим здесь if entriesread > 0 then for I := 0 to entriesread - 1 do Result := Result + TShareInfo1Array(@(Info^))[I].shi1_netname + ' '; finally NetApiBufferFree(Info); end; end; // Вот таким простым путем будем получать имя сервера домена function TMainForm.GetDomainServer(const DomainName: String): String; var pwDomain:pWideChar; pwServer:pWideChar; begin GetMem(pwDomain, 512); GetMem(pwServer, 512); StringToWideChar(DomainName, pwDomain, 255); NetGetAnyDCName(nil, pwDomain, @pwServer); Result := WideCharToString(pwServer); NetApiBufferFree(pwServer); FreeMem(pwDomain, 512); end; // перечисление доменных групп в которые входит пользователь function TMainForm.GetGroups(DomainServer: String; UserName: String): String; type TGroupUsersInfoArray = array of TGroupUsersInfo0; var Info: PGroupUsersInfo0; Sn, Un: PWideChar; entriesread, totalentries: DWORD; I, A, B, Size: Integer; P: Pointer; begin // нам нужно только имя сервера домена Sn := StringToOLEStr(DomainServer); // и имя пользователя Un := StringToOleStr(UserName); // делаем запрос if NetUserGetGroups(Sn, Un, 0, @Info, DWORD(-1), entriesread, totalentries) = NO_ERROR then try // и смотрим, что там у нас получилось if entriesread > 0 then for I := 0 to entriesread - 1 do Result := Result + TGroupUsersInfoArray(@(Info^))[I].grui0_name + ' '; finally NetApiBufferFree(Info); end; end; end.
Взято из https://forum.sources.ru