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

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

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

Вовочка прибегает домой 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;