(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
Dr.Web Security Space, продление лицензии на 1 год, 1 ПК
Quest Software. Toad for DBA Suite for Oracle
DevExpress / DXperience Subscription
SAP Crystal Reports XI R2 Dev 2006 INTL WIN NUL License (Version 11)
ABBYY Lingvo x6 Английская Профессиональная версия
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новые материалы
Краткие описания программ и ссылки на них
Corel DRAW - от идеи до реализации
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100