Получение списка серверов в локальной сети

{ **** 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
;

Другое по теме:

• Состояние подключения к сети
• Как подключать сетевые диски
• Как подключить и отключить сетевые диски