Обзор сети (типа Network Neighborhood)
Материал из DRKB
Обзор сети (типа 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);
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.
Source: http://articles.org.ru
ID: 03326