Автор: Алексей Вуколов
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение списка серверов в локальной сети

Класс-оболочка для функции NetServerEnum.

Примечание. Проверялось только под WinNT/Win2000 (ничего другого под рукой нет).

Методы
------------------
Create( AServer, ADomain : string; AServerMask : longint );

AServer - имя сервера, на котором выполняется функция;
ADomain - имя домена, для которого запрашивается список серверов;
AServerMask - флаги, задающие, список серверов какого типа следует получить.
Этот параметр представляет собой набор флагов SV_TYPE_XXXX. подробнее -
в исходнике и справке по функции WinAPI NetServerEnum.

Refresh.
Обновление списка серверов. Автоматически вызывается при создании класса,
а также при присвоении значения свойству ServerMask.

Свойства
------------------
Servers[ index : integer ] : TServerInfo
Список объектов TServerInfo, содержащих информацию о найденных серверах
- имя, версию, флаги.

Count : integer
Количество найденных серверов

ServerMask : longint
Маска поиска серверов. См. описание параметра AServerMask в конструкторе.

Зависимости: Classes
Автор:       vuk
Copyright:   Алексей Вуколов
Дата:        26 апреля 2002 г.
***************************************************** }

unit NetSrvList;

interface
uses Classes;

const

  SV_TYPE_WORKSTATION = $00000001; // All LAN Manager workstations
  SV_TYPE_SERVER = $00000002; // All LAN Manager servers
  SV_TYPE_SQLSERVER = $00000004; // Any server running with Microsoft SQL Server
  SV_TYPE_DOMAIN_CTRL = $00000008; // Primary domain controller
  SV_TYPE_DOMAIN_BAKCTRL = $00000010; // Backup domain controller
  SV_TYPE_TIMESOURCE = $00000020; // Server running the Timesource service
  SV_TYPE_AFP = $00000040; // Apple File Protocol servers
  SV_TYPE_NOVELL = $00000080; // Novell servers
  SV_TYPE_DOMAIN_MEMBER = $00000100; // LAN Manager 2.x Domain Member
  SV_TYPE_LOCAL_LIST_ONLY = $40000000; // Servers maintained by the browser
  SV_TYPE_PRINT = $00000200; // Server sharing print queue
  SV_TYPE_DIALIN = $00000400; // Server running dial-in service
  SV_TYPE_XENIX_SERVER = $00000800; // Xenix server
  SV_TYPE_MFPN = $00004000; // Microsoft File and Print for Netware
  SV_TYPE_NT = $00001000; // Windows NT (either Workstation or Server)
  SV_TYPE_WFW = $00002000; // Server running Windows for Workgroups
  SV_TYPE_SERVER_NT = $00008000; // Windows NT non-DC server
  SV_TYPE_POTENTIAL_BROWSER = $00010000;
    // Server that can run the Browser service
  SV_TYPE_BACKUP_BROWSER = $00020000;
    // Server running a Browser service as backup
  SV_TYPE_MASTER_BROWSER = $00040000;
    // Server running the master Browser service
  SV_TYPE_DOMAIN_MASTER = $00080000; // Server running the domain master Browser
  SV_TYPE_DOMAIN_ENUM = $80000000; // Primary Domain
  SV_TYPE_WINDOWS = $00400000; // Windows 95 or later
  SV_TYPE_ALL = $FFFFFFFF; // All servers

type
  TServerInfo = class(TObject)
    svr_Platform_ID: integer;
    svr_Name: WideString;
    svr_Version_Major,
      svr_Version_Minor,
      svr_Type: integer;
    svr_Comment: WideString;
  end;

  TServerList = class(TObject)
  protected
    FList: TList;
    FServer, FDomain: WideString;
    FServerMask: longint;
    procedure Clear;
    function GetServer(Index: integer): TServerInfo;
    function GetCount: integer;
    procedure SetServerMask(const Value: longint);

  public
    constructor Create(AServer, ADomain: string; AServerMask: longint);
    destructor Destroy; override;
    procedure Refresh;
    property Servers[index: integer]: TServerInfo read GetServer; default;
    property Count: integer read GetCount;
    property ServerMask: longint read FServerMask write SetServerMask;
  end;

implementation
uses
  Sysutils;
type
  TServer_Info_101 = record
    svr_Platform_ID: integer;
    svr_Name: PWideChar;
    svr_Version_Major,
      svr_Version_Minor,
      svr_Type: integer;
    svr_Comment: PWideChar;
  end;
  TServer_Infos_101 = array[1..($1FFFFFFF div SizeOf(TServer_Info_101))] of
    TServer_Info_101;

function NetServerEnum(ServerName: PWideChar; Level: longint;
  var BufPtr: pointer; PrefMaxLen: longint;
  var EntriesRead, TotalEntries: longint;
  ServType: longint; Domain: PWideChar;
  var ResumeHandle: integer): longint;
  stdcall; external 'netapi32.dll' name 'NetServerEnum';

constructor TServerList.Create(AServer, ADomain: string; AServerMask: longint);
begin
  inherited Create;
  Flist := TList.Create;
  FServer := Aserver;
  FDomain := ADomain;
  FServerMask := AServerMask;
  Refresh;
end;

destructor TServerList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

function TServerList.GetServer(Index: integer): TServerInfo;
begin
  Result := TServerInfo(FList[Index]);
end;

function TServerList.GetCount: integer;
begin
  Result := FList.Count;
end;

procedure TServerList.Clear;
var
  i: integer;
begin
  for i := 0 to FList.Count - 1 do
    Servers[i].Free;
  Flist.Clear;
end;

procedure TServerList.Refresh;
var
  EntRead, EntTotal, Resume, i: integer;
  Info: integer;
  Itm: TServerInfo;
  Data: pointer;
  pServer, pDomain: PWideChar;
begin
  if FServer <> '' then
    pServer := PWideChar(FServer)
  else
    pServer := nil;
  if FDomain <> '' then
    pDomain := PWideChar(FDomain)
  else
    pDomain := nil;

  Clear;

  Info := NetServerEnum(pServer, 101, Data, -1, EntRead, EntTotal,
    FServerMask, pDomain, Resume);

  if Info = 0 then

    for i := 1 to EntRead do
    begin
      Itm := TServerInfo.Create;
      with TServer_Infos_101(Data^)[i] do
      begin
        Itm.svr_Platform_ID := svr_Platform_ID;
        Itm.svr_Name := svr_Name;
        Itm.svr_Version_Major := svr_Version_Major;
        Itm.svr_Version_Minor := svr_Version_Minor;
        Itm.svr_Type := svr_Type;
        Itm.svr_Comment := svr_Comment;
      end;
      FList.Add(Itm);
    end
  else
    raise Exception.Create('Cannot get server list');

end;

procedure TServerList.SetServerMask(const Value: longint);
begin
  FServerMask := Value;
  Refresh;
end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TServerList;
  i: integer;
begin
  List := TServerList.Create('', '', SV_TYPE_ALL);
  for i := 0 to List.Count - 1 do
    with List[i] do
      Memo1.Lines.Add(Format('%s %s %d.%d %s %x',
        [svr_Name, #9, svr_Version_Major, svr_Version_Minor, #9, svr_Type]));
end;