Идёт загрузка страницы...

htp://aptem.net.ru
Навигатор
На форум
Софт
Программирование
Delphi
Visual Basic
Borland C++
1С
Вебмастеру
HTML
PHP
Perl
ОС
Windows XP
Windows 98
Windows 2000




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