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

Delphi , Интернет и Сети , Сетевые диски

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

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

Программный код на Delphi, используя функции Windows API для подключения и отключения сетевых ресурсов (дисковых накопителей и принтеров). Функции:

ConnectDrive: Подключает сетевой диск с указанными _drvLetter, _netPath и параметрами для отображения ошибки, если она возникнет, а также для reconnect после перезапуска компьютера.
ConnectPrinterDevice: Подключает устройство принтера с указанным _lptPort и _netPath.
DisconnectNetDrive: Отключает сетевой диск с указанным _locDrive, отображает ошибку, если она возникнет, forcing disconnection, если это необходимо, и сохраняет изменения.

Примеры процедур в конце демонстрируют использование этих функций:

Button1Click подключает сетевой диск 'h:' с путем '\Servername\C'.
Button2Click отключает тот же сетевой диск 'h:'.

Обратите внимание, что в Delphi используются функции WNetAddConnection3 и WNetCancelConnection2 для управления подключениями к ресурсам сети. Свойство Form1.Handle используется как handle для текущей формы.

Пример улучшения кода:

function ConnectNetworkResource(const resourceType: TResourceType; const resourcePath, localName: string; reconnect: Boolean): DWORD;
var
  nRes: TNetResource;
  errCode: DWORD;
  dwFlags: DWORD;
begin
  FillChar(nRes, SizeOf(nRes), #0);
  nRes.dwType := resourceType;
  nRes.lpLocalName := PChar(localName);
  nRes.lpRemoteName := PChar(resourcePath);

  if reconnect then
    dwFlags := CONNECT_UPDATE_PROFILE and CONNECT_INTERACTIVE
  else
    dwFlags := CONNECT_INTERACTIVE;

  errCode := WNetAddConnection3(Form1.Handle, @nRes, nil, nil, dwFlags);
  if (errCode <> NO_ERROR) and ShowError then
  begin
    Application.MessageBox(PChar('An error occurred while connecting: ' + #13#10 + SysErrorMessage(GetLastError)), 'Error while connecting!', MB_OK);
  end;
  Result := errCode;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ConnectNetworkResource(RESOURCETYPE_DISK, '\\Servername\C', 'h:', True);
end;

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

В улучшенном коде:

Функция ConnectNetworkResource является более общепринятой функцией, которая может использоваться для подключения любого типа сетевого ресурса (не только дисковых накопителей).
Процедуры Button1Click и Button2Click используют новую функцию.
Обработка ошибок была улучшена с помощью использования переменной ShowError вместо жесткого кодирования boolean-значений.

В этой статье описываются функции для подключения и отключения сетевых дисков и принтеров в дельфийском программном обеспечении.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: Сетевые диски ::

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 12:09:21/0.0061309337615967/1