Delphi World - Получение списка серверов в локальной сети
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получение списка серверов в локальной сети

Автор: Алексей Вуколов
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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования