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

← →
lightix (2004-04-23 13:02) [0]

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

← →
RAIN © (2004-04-23 13:15) [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;

Монтирование сетевого диска Найти похожие ветки