{codecitation class="brush: pascal; gutter: false;" width="600px"}

Сеть — это дырки, связанные веревками.

В свое время я начал писать эту утилиту для своего развлечения, шутки ради. Она так и осталась незавершенной. Не знаю, хватит ли времени и желания дописать ее теперь. Но тем не менее вы можете использовать ее в качестве отправной точки для создания чего-то покруче. Я надеюсь, что приведеный здесь код поможет понять технологию поиска сетевых машин и мой труд не пропадет даром.

{

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

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® ' при перечислении

ресурсов.',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.

{/codecitation}