Демонстрационная программа получения информации о компьютере по IP

Previous  Top  Next

    
 

 

 

Code:

// Демонстрационная программа получения информации о компьютере

// на основе 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.

 

 

 

 

 

Автор Rouse_

©Drkb::03316

Взято из http://forum.sources.ru