Обзор сети (типа 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);
 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
Category:Связь