Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Демонстрационная программа получения информации о компьютере по IP 
:(
    Опции темы
Poseidon
Дата 18.5.2005, 22:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 4
Всего: 133



Код
// Демонстрационная программа получения информации о компьютере 
// на основе 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. 



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »


 




[ Время генерации скрипта: 0.0766 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.