| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Монтирование сетевого диска

lightix ©   (2004-04-23 13:02:00) 

Подскажите, как смонтировать\размонтировать сетевой диск, чтобы при монтировании получить его имя ?

---

RAIN   (2004-04-23 13:15:00) [1]

Вот пример:

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: \\Test\C }
 { 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: \\Test\Printer1 }
 { 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:', '\\Servername\C', True, True);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 DisconnectNetDrive('h:', True, True, True);
end;

---

Наверх