(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
Quest Software. TOAD Professional Edition
SAP® Crystal Presentation Design 2016 WIN INTL NUL
Panda Global Protection - ESD версия - на 1 устройство - (лицензия на 1 год)
The BAT! Home Upgrade- 1 компьютер
Microsoft Office 365 Бизнес. Подписка на 1 рабочее место на 1 год
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Реестр Windows. Секреты работы на компьютере
Новые материалы
Один день системного администратора
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100