Советы по 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); 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.

[000200]



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