unit unit1;
interface
uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
stdctrls, shlobj, buttons;
//необходимые константы
const
lm20_nnlen = 12;
shpwlen = 8;
shi50f_rdonly = 1;
shi50f_full = 2;
stype_disktree = 0;
maxnetarrayitems = 512;
//формируем тип для записи с необходимыми параметрами
type
//для win'9x
tshareinfo50 = packed record
shi50_netname: array[0..lm20_nnlen] of char; //сетевое имя
shi50_type: byte; //тип ресурса
shi50_flags: short; //флаг доступа
shi50_remark: pchar; // комментарий
shi50_path: pchar; // путь к ресурсу
shi50_rw_password: array[0..shpwlen] of char; //пароль полного доступа
shi50_ro_password: array[0..shpwlen] of char;
//пароль "только чтение" доступа
end;
tshareevent = record //информация о сетевом ресурсе
res: integer;
readonlypassword: string;
fullaccesspassword: string;
comments: string;
path: string;
end;
< a name = form > < / a >
tform1 = class(tform)
edcomputernetname: tedit;
button1: tbutton;
combobox1: tcombobox;
bitbtn1: tbitbtn;
bitbtn2: tbitbtn;
lbreadonlypassword: tlabel;
edreadonlypassword: tedit;
lbfullaccesspassword: tlabel;
edfullaccesspassword: tedit;
lbcomments: tlabel;
edcomments: tedit;
lbphysicalpath: tlabel;
edphysicalpath: tedit;
label1: tlabel;
label2: tlabel;
procedure button1click(sender: tobject);
procedure bitbtn1click(sender: tobject);
procedure bitbtn2click(sender: tobject);
private
{ private declarations }
procedure fillshareenum(items: tstrings);
function getcomputernetname: string;
function getshareinfo(computernetname, resourcenetname: string):
tshareevent;
procedure connectadmin;
public
{ public declarations }
end;
var
form1: tform1;
function netsharegetinfo(const pszserver: pchar; const psznetname: pchar;
slevel: smallint; pbbuffer: pointer; cbbuffer: word;
var pctotalavail: word): dword; stdcall; external 'svrapi.dll' name
'netsharegetinfo';
function netshareenum(const pszserver: pchar; slevel: smallint;
pbbuffer: pointer; cbbuffer: word; var pcentriesread: word;
var pctotalavail: word): dword; stdcall; external 'svrapi.dll';
implementation
{$r *.dfm}
procedure tform1.connectadmin;
var
compname: string;
res: integer;
lpnetresource: tnetresource;
computername: array[0..max_computername_length] of char;
bufsize: integer;
begin
//получим имя локальной машины
bufsize := max_computername_length + 1;
getcomputername(@computername, bufsize);
compname := string(computername);
//если имя локальной машины совпадает с сетевым именем машины,
//значит идет запрос о сетевом ресурсе локальной машины -
//в этом случае admin$ не нужен
if ansiuppercase(compname) = ansiuppercase(edcomputernetname.text)thenexit;
//заполним нолями значение указателя
zeromemory(@lpnetresource, sizeof(lpnetresource));
//укажем нужные значения
with lpnetresource do
begin
dwtype := resourcetype_any;
lpremotename := '';
lpremotename := pchar('' + edcomputernetname.text + 'admin$' + #0);
end;
//Сезам, откройся!
res := wnetaddconnection3(application.handle, lpnetresource, nil, nil,
connect_interactive);
//Сезам, к сожалению не открылся...
if not (res = no_error) then
begin
showmessage('with out connected resource "admin$" a work impossible!');
application.terminate;
end;
end;
function tform1.getshareinfo(computernetname, resourcenetname: string):
tshareevent;
var
pbbuffer: ^tshareinfo50; //указатель на буфер
buf: tshareinfo50; //сам буфер
res: integer;
pctotalavail: word; //количество считанных байт
begin
with result do //почистим результат функции
begin
res := 0;
readonlypassword := '';
fullaccesspassword := '';
comments := '';
path := '';
end;
fillchar(buf, sizeof(buf), #0); //заполним буфер нолями
//ничего не укажем о нашем буфере и выполним функцию, в результате чего
//получим в переменную pctotalavail количество считанных байт.
netsharegetinfo(pchar(computernetname), pchar(resourcenetname), 50, nil, 0,
pctotalavail);
//инициализируем буферный указатель и дадим ему нужное количество памяти
getmem(pbbuffer, pctotalavail);
//поместим в буфер имя сетевого ресурса, зачем не знаю - имя мы уже и так
//указываем, но без этого функция почему-то не работает, по крайней мере у меня
strpcopy(pbbuffer^.shi50_netname, resourcenetname);
//выполним функцию еще раз уже указав параметры буфера
res := netsharegetinfo(pchar(computernetname), pchar(resourcenetname), 50,
pbbuffer, pctotalavail, pctotalavail);
if res = 0 then //все в порядке
begin
//передадим данные из указателя в "обычную" переменную
buf := pbbuffer^;
//заполним результат полученными значениями
result.readonlypassword := string(buf.shi50_ro_password);
result.fullaccesspassword := string(buf.shi50_rw_password);
result.comments := string(buf.shi50_remark);
result.path := string(buf.shi50_path);
end;
//освободим указатель
freemem(pbbuffer);
end;
procedure tform1.fillshareenum(items: tstrings);
var
shareinfo: array[0..maxnetarrayitems - 1] of tshareinfo50;
entriesread, totalavial: word;
res: integer;
n: integer;
begin
items.clear; //почистим items
fillchar(shareinfo, sizeof(shareinfo), #0); //заполним буфер нолями
res := netshareenum(pchar('' + edcomputernetname.text), 50, @shareinfo,
sizeof(shareinfo),
entriesread, totalavial); //имя сетевой машины возьмем из строки ввода,
//предварительно озаглавив его двумя обратными слэшами
if res = no_error then //функция выполнена без ошибок
for n := 0 to entriesread - 1 do
//пройдемся по буферу считанных имен ресурсов
if not (string(shareinfo[n].shi50_netname) = '') then
items.add(string(shareinfo[n].shi50_netname));
//добавим имя машины в список
end;
function tform1.getcomputernetname: string;
var
rootitemidlist: pitemidlist;
//идентификатор объекта в пространстве имен проводника
browseinfo: tbrowseinfo; //структура, в которой содержится информация о диалоге
buffer: pchar; //сюда получим имя компьютера
begin
result := '';
//получим нужный идентификатор pitemidlist, csidl_network - в сетевом окружении
if not (shgetspecialfolderlocation(0, csidl_network, rootitemidlist) =
no_error) then
exit;
//подготовим буфер, в который получим имя компьютера
getmem(buffer, max_path);
fillchar(browseinfo, sizeof(browseinfo), 0);
//подготовим структуру tbrowseinfo
with browseinfo do
begin {with browseinfo}
hwndowner := application.handle; //хозяин окна - наше приложение
pidlroot := rootitemidlist; //полученный ранее идентификатор
// объекта в списке объектов проводника
pszdisplayname := buffer; //имя компьютера будем принимать в buffer
lpsztitle := 'Подключенные компьютеры'; //заголовок диалога
ulflags := bif_browseforcomputer; //будут показаны имена только компьютеров
end; {with browseinfo}
//выполним нужную функцию
if shbrowseforfolder(browseinfo) = nil thenexit;
result := string(buffer); //вот оно - сетевое имя компьютера
freemem(buffer);
end;
procedure tform1.button1click(snder: tobject);
begin
edcomputernetname.text := getcomputernetname;
fillshareenum(combobox1.items);
combobox1.itemindex := 0;
end;
procedure tform1.bitbtn1click(sender: tobject);
var
shareevent: tshareevent;
begin
if (edcomputernetname.text = '') or (combobox1.text = '') then
begin
edcomputernetname.setfocus;
exit;
end;
connectadmin;
shareevent := getshareinfo('' + edcomputernetname.text, combobox1.text);
edreadonlypassword.text := shareevent.readonlypassword;
edfullaccesspassword.text := shareevent.fullaccesspassword;
edcomments.text := shareevent.comments;
edphysicalpath.text := shareevent.path;
end;
procedure tform1.bitbtn2click(sender: tobject);
begin
close;
end;
end.