Обзор сети (типа Network Neighborhood - Сетевое Окружение)

{
Сетевая утилита. Аналогична функции 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);
  public
    { Public declarations }
  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.