(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

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

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;



 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 25.01.2007 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
ABViewer Standart пользовательская
IBM Domino Messaging Client Access License Authorized User License + SW Subscription & Support 12 Months
Quest Software. TOAD Professional Edition
TeeChart Pro VCL/FMX with source code single license
Enterprise Connectors (1 Year term)
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новые материалы
Вопросы и ответы по MS SQL Server
Новые программы для Windows
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100