Обзор сети (типа Network Neighborhood - Сетевое Окружение)

Советы » Сеть » Обзор сети (типа 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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com