Обзор сети (типа 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
.

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

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