Обзор сети (типа Network Neighborhood)

Материал из DRKB


Обзор сети (типа Network Neighborhood)

Пример может служить отправной точкой для создания рабочего варианта.

unit netres_main_unit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;

type
  TfrmMain = class(TForm)
    tvResources: TTreeView;
    btnOk: TBitBtn;
    btnClose: TBitBtn;
    Label1: TLabel;
    barBottom: TStatusBar;
    popResources: TPopupMenu;
    mniExpandAll: TMenuItem;
    mniCollapseAll: TMenuItem;
    mniSaveToFile: TMenuItem;
    mniLoadFromFile: TMenuItem;
    grpListType: TRadioGroup;
    grpResourceType: TRadioGroup;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mniExpandAllClick(Sender: TObject);
    procedure mniCollapseAllClick(Sender: TObject);
    procedure mniSavetoFileClick(Sender: TObject);
    procedure mniLoadFromFileClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    ListType, ResourceType: DWord;
    procedure ShowHint(Sender: TObject);
    procedure DoEnumeration;
    procedure DoEnumerationContainer(NetResContainer: TNetResource);
    procedure AddContainer(NetRes: TNetResource);
    procedure AddShare(TopContainerIndex: Integer; NetRes: TNetResource);
    procedure AddShareString(TopContainerIndex: Integer; ItemName: string);
    procedure AddConnection(NetRes: TNetResource);
  end;

var
  frmMain: TfrmMain;

implementation

{$r *.dfm}

procedure TfrmMain.ShowHint(Sender: TObject);
begin
  barBottom.Panels.Items[0].Text := Application.Hint;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Application.OnHint := ShowHint;
  barBottom.Panels.Items[0].Text := '';
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Close;
end;

{ Перечисляем все сетевые ресурсы }
procedure TfrmMain.DoEnumeration;
var
  NetRes: array[0..2] of TNetResource;
  loop: Integer;
  r, hEnum, EntryCount, NetResLen: DWORD;
begin
  case grpListType.ItemIndex of
    { Подключенные ресурсы: }
    1: ListType := RESOURCE_CONNECTED;

    { Возобновляемые ресурсы: }
    2: ListType := RESOURCE_REMEMBERED;
      { Глобальные: }
    else
      ListType := RESOURCE_GLOBALNET;
  end;
  case grpResourceType.ItemIndex of
    { Дисковые ресурсы: }
    1: ResourceType := RESOURCETYPE_DISK;
    { Принтерные ресурсы: }
    2: ResourceType := RESOURCETYPE_PRINT;
      { Все: }
    else
      ResourceType := RESOURCETYPE_ANY;
  end;
  Screen.Cursor := crHourGlass;
  try
    { Удаляем любые старые элементы из дерева }
    for loop := tvResources.Items.Count - 1 downto 0 do
      tvResources.Items[loop].Delete;
  except
  end;
  { Начинаем перечисление: }
  r := WNetOpenEnum(ListType, ResourceType, 0, nil, hEnum);
  if r <> NO_ERROR then
  begin
    if r = ERROR_EXTENDED_ERROR then
      MessageDlg('Невозможно сделать обзор сети.' +
        #13 + 'Произошла сетевая ошибка.', mtError, [mbOK], 0)
    else
      MessageDlg('Невозможно сделать обзор сети.',
        mtError, [mbOK], 0);
    exit;
  end;
  try
    { Мы получили правильный дескриптор перечисления; опрашиваем ресурсы }
    while (1 = 1) do
    begin
      EntryCount := 1;
      NetResLen := SizeOf(NetRes);
      r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);
      case r of
        0:
        begin { Это контейнер, организуем итерацию: }
          if NetRes[0].dwUsage = RESOURCEUSAGE_CONTAINER then
            DoEnumerationContainer(NetRes[0])
          else { Здесь получаем подключенные и возобновляемые ресурсы }
          if ListType in [RESOURCE_REMEMBERED, RESOURCE_CONNECTED] then
            AddConnection(NetRes[0]);
        end;
        ERROR_NO_MORE_ITEMS: { Получены все ресурсы: }
          break;
      else
        begin { Другие ошибки: }
          MessageDlg('Ошибка опроса ресурсов.', mtError, [mbOK], 0);
          break;
        end;
      end;
    end;
  finally
    Screen.Cursor := crDefault;
    { Закрываем дескриптор перечисления: }
    WNetCloseEnum(hEnum);
  end;
end;

{ Перечисление заданного контейнера. Эта функция обычно вызывается рекурсивно }
procedure TfrmMain.DoEnumerationContainer(NetResContainer: TNetResource);
var
  NetRes: array[0..10] of TNetResource;
  TopContainerIndex: Integer;
  r, hEnum, EntryCount, NetResLen: dword;
begin
  { Добавляем имя контейнера к найденным сетевым ресурсам }
  AddContainer(NetResContainer);
  { Делаем этот элемент текущим корневым уровнем }
  TopContainerIndex := tvResources.Items.Count - 1;
  { Начинаем перечисление: }
  if ListType = RESOURCE_GLOBALNET then
    { Перечисляем глобальные объекты сети: }
    r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER,
      @NetResContainer, hEnum)
  else
  { Перечисляем подключаемые и возобновляемые ресурсы
    (другие получить здесь невозможно) }
    r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER, nil, hEnum);
  { Невозможно перечислить ресурсы данного контейнера, выводим соответствующее
    предупреждение и едем дальше }
  if r <> NO_ERROR then
  begin
    AddShareString(TopContainerIndex,
      '<Не могу опросить ресурсы (Ошибка #' + IntToStr(r) + '>');
    WNetCloseEnum(hEnum);
    exit;
  end;
  { Мы получили правильный дескриптор перечисления; опрашиваем ресурсы }
  while (1 = 1) do
  begin
    EntryCount := 1;
    NetResLen := SizeOf(NetRes);
    r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);
    case r of
      0:
      begin { Другой контейнер для перечисления, необходим рекурсивный вызов }
        if (NetRes[0].dwusage = RESOURCEUSAGE_CONTAINER) or (NetRes[0].dwUsage = 10) then
          DoEnumerationContainer(NetRes[0])
        else
          case NetRes[0].dwDisplayType of
            { Верхний уровень }
            RESOURCEDISPLAYTYPE_GENERIC,
            RESOURCEDISPLAYTYPE_DOMAIN,
            RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);
            { Ресурсы общего доступа: }
            RESOURCEDISPLAYTYPE_SHARE:
              AddShare(TopContainerIndex, NetRes[0]);
          end;
      end;
      ERROR_NO_MORE_ITEMS: break;
    else
      begin
        MessageDlg('Ошибка #' + IntToStr(r) +
          ' при перечислении ресурсов.',
          mtError, [mbOK], 0);
        break;
      end;
    end;
  end;
  { Закрываем дескриптор перечисления }
  WNetCloseEnum(hEnum);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  DoEnumeration;
end;

{ Добавляем элементы дерева; помечаем, что это контейнер }
procedure TfrmMain.AddContainer(NetRes: TNetResource);
var
  ItemName: string;
begin
  ItemName := Trim(string(NetRes.lpRemoteName));
  if Trim(string(NetRes.lpComment)) <> '' then
  begin
    if ItemName <> '' then
      ItemName := ItemName + ' ';
    ItemName := ItemName + '(' + string(NetRes.lpComment) + ')';
  end;
  tvResources.Items.Add(tvResources.Selected, ItemName);
end;

{ Добавляем дочерние элементы к контейнеру, обозначенному как текущий
верхний уровень }
procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes: TNetResource);
var
  ItemName: string;
begin
  ItemName := Trim(string(NetRes.lpRemoteName));
  if Trim(string(NetRes.lpComment)) <> '' then
  begin
    if ItemName <> '' then
      ItemName := ItemName + ' ';
    ItemName := ItemName + '(' + string(NetRes.lpComment) + ')';
  end;
  tvResources.Items.AddChild(tvResources.Items[TopContainerIndex], ItemName);
end;

{ Добавляем дочерние элементы к контейнеру, обозначенному как текущий верхний
уровень; это просто добавляет строку для таких задач, как, например, перечисление
контейнера. То есть некоторые контейнерные ресурсы общего доступа нам не
доступны. }
procedure TfrmMain.AddShareString(TopContainerIndex: Integer; ItemName: string);
begin
  tvResources.Items.AddChild(tvResources.Items[TopContainerIndex], ItemName);
end;

{ Добавляем соединения к дереву. По большому счету, к этому моменту все сетевые
ресурсы типа возобновляемых и текущих соединений уже отображены. }
procedure TfrmMain.AddConnection(NetRes: TNetResource);
var
  ItemName: string;
begin
  ItemName := Trim(string(NetRes.lpLocalName));
  if Trim(string(NetRes.lpRemoteName)) <> '' then
  begin
    if ItemName <> '' then
      ItemName := ItemName + ' ';
    ItemName := ItemName + '-> ' + Trim(string(NetRes.lpRemoteName));
  end;
  tvResources.Items.Add(tvResources.Selected, ItemName);
end;

{ Раскрываем все контейнеры дерева }
procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin
  tvResources.FullExpand;
end;


{ Схлопываем все контейнеры дерева }
procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin
  tvResources.FullCollapse;
end;

{ Записываем дерево в выбранный файл }
procedure TfrmMain.mniSavetoFileClick(Sender: TObject);
begin
  if dlgSave.Execute then
    tvResources.SaveToFile(dlgSave.FileName);
end;

{ Загружаем дерево из выбранного файла }
procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin
  if dlgOpen.Execute then
    tvResources.LoadFromFile(dlgOpen.FileName);
end;

{ Обновляем }
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
  DoEnumeration;
end;

end.


Source: http://articles.org.ru
ID: 03326