Отобразить, присоединить сетевые диски (исходники)

function connectdrive(_drvletter: string; _netpath: string; _showerror: boolean;
_reconnect: boolean): dword;
var
nres: tnetresource;
errcode: dword;
dwflags: dword;
begin
{ fill netressource with #0 to provide uninitialized values }
{ netressource mit #0 fullen => keine unitialisierte werte }
fillchar(nres, sizeof(nres), #0);
nres.dwtype := resourcetype_disk;
{ set driveletter and networkpath }
{ laufwerkbuchstabe und netzwerkpfad setzen }
nres.lplocalname := pchar(_drvletter);
nres.lpremotename := pchar(_netpath); { example: testc }
{ check if it should be saved for use after restart and set flags }
{ uberprufung, ob gespeichert werden soll }
if _reconnect then
dwflags := connect_update_profile and connect_interactive
else
dwflags := connect_interactive;

errcode := wnetaddconnection3(form1.handle, nres, nil, nil, dwflags);
{ show errormessage, if flag is set }
{ fehlernachricht aneigen }
if (errcode <> no_error) and (_showerror) then
begin
application.messagebox(pchar('an error occured while connecting:' + #13#10 +
syserrormessage(getlasterror)),
'error while connecting!',
mb_ok);
end;
result := errcode; { no_error }
end;

function connectprinterdevice(_lptport: string; _netpath: string; _showerror: boolean;
_reconnect: boolean): dword;
var
nres: tnetresource;
errcode: dword;
dwflags: dword;
begin
{ fill netressource with #0 to provide uninitialized values }
{ netressource mit #0 fullen => keine unitialisierte werte }
fillchar(nres, sizeof(nres), #0);
nres.dwtype := resourcetype_print;
{ set printername and networkpath }
{ druckername und netzwerkpfad setzen }
nres.lplocalname := pchar(_lptport);
nres.lpremotename := pchar(_netpath); { example: testprinter1 }
{ check if it should be saved for use after restart and set flags }
{ uberprufung, ob gespeichert werden soll }
if _reconnect then
dwflags := connect_update_profile and connect_interactive
else
dwflags := connect_interactive;

errcode := wnetaddconnection3(form1.handle, nres, nil, nil, dwflags);
{ show errormessage, if flag is set }
{ fehlernachricht aneigen }
if (errcode <> no_error) and (_showerror) then
begin
application.messagebox(pchar('an error occured while connecting:' + #13#10 +
syserrormessage(getlasterror)),
'error while connecting!',
mb_ok);
end;
result := errcode; { no_error }
end;

function disconnectnetdrive(_locdrive: string; _showerror: boolean; _force: boolean;
_save: boolean): dword;
var
dwflags: dword;
errcode: dword;
begin
{ set dwflags, if necessary }
{ setze dwflags auf gewunschten wert }
if _save then
dwflags := connect_update_profile
else
dwflags := 0;
{ cancel the connection see also at http://www.swissdelphicenter.ch/en/showcode.php?id=391 }
{ siehe auch oben genannten link (netzlaufwerke anzeigen) }
errcode := wnetcancelconnection2(pchar(_locdrive), dwflags, _force);
{ show errormessage, if flag is set }
{ fehlernachricht anzeigen }
if (errcode <> no_error) and (_showerror) then
begin
application.messagebox(pchar('an error occured while disconnecting:' + #13#10 +
syserrormessage(getlasterror)),
'error while disconnecting',
mb_ok);
end;
result := errcode; { no_error }
end;

{beispiel / example:}

procedure tform1.button1click(sender: tobject);
begin
connectdrive('h:', 'servernamec', true, true);
end;

procedure tform1.button2click(sender: tobject);
begin
disconnectnetdrive('h:', true, true, true);
end;


Страница сайта http://test.interface.ru
Оригинал находится по адресу http://test.interface.ru/home.asp?artId=4028