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

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
;

Другое по теме:

• Состояние подключения к сети
• Как подключать сетевые диски
• Как подключить и отключить сетевые диски