Советы по Delphi
       

Обзор сети (типа 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);privateListType, 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 dotvResources.Items[Loop].Delete;exceptend;
{ Начинаем перечисление: }r:=WNetOpenEnum(ListType,ResourceType,0,nil,hEnum);if r<>NO_ERROR thenbeginif r=ERROR_EXTENDED_ERROR thenMessageDlg('Невозможно сделать обзор сети.'+#13+'Произошла сетевая ошибка.',mtError,[mbOK],0)elseMessageDlg('Невозможно сделать обзор сети.',mtError,[mbOK],0);Exit;end;
try{ Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }while (1=1) dobeginEntryCount:=1;NetResLen:=SizeOf(NetRes);r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);case r of0: begin{ Это контейнер, организуем итерацию: }if NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER thenDoEnumerationContainer(NetRes[0])else{ Здесь получаем подключенные и возобновляемые ресурсы: }if ListType in [RESOURCE_REMEMBERED,RESOURCE_CONNECTED]then
AddConnection(NetRes[0]);end;
{ Получены все ресурсы: }ERROR_NO_MORE_ITEMS: Break;{ Другие ошибки: }else beginMessageDlg('Ошибка опроса ресурсов.',mtError,[mbOK],0);Break;end;end;end;
finallyScreen.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 thenbeginAddShareString(TopContainerIndex,'<Не могу опросить ресурсы(Ошибка #'+
IntToStr(r)+'>');WNetCloseEnum(hEnum);Exit;end;
{ Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }while (1=1) dobeginEntryCount:=1;NetResLen:=SizeOf(NetRes);r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);case r of0: begin{ Другой контейнер для перечисления;необходим рекурсивный вызов: }if (NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER) or(NetRes[0].dwUsage=10) thenDoEnumerationContainer(NetRes[0])elsecase 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 beginMessageDlg('Ошибка #'+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))<>'' thenbeginif 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))<>'' thenbeginif 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))<>'' thenbeginif 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 thentvResources.SaveToFile(dlgSave.FileName);end;

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

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

end.

[000200]



Содержание раздела