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