unit MapNetDrive2;
{$D-}
interface
function IsUncPath(UncPath: string) : boolean;
function GetUnc2DriveLetter(UncPathIn, Terminator: String; var Path: String): boolean;
function CancelUncDrive : boolean;
function ConvertToUNCPath(MappedDrive: string) : string;
function DriveIsMapped(UncPath: String; var Path: String): boolean;
//function GetAssignedDriveLetter(n : integer) : char;
implementation
uses
Windows, Forms, Dialogs, Sysutils, FileCtrl;
const
AvailDrvs : set of char = ['C'..'Z'];
var
AssignedDriveLetters : string;
function AssignedCount : integer;
begin
result:= length(AssignedDriveLetters);
end;
function IsUncPath(UncPath: string) : boolean;
begin
result:= (pos('\\', UncPath) = 1) and DirectoryExists(UncPath)
end;
procedure RemoveUnMapableDrive(ch: char);
Begin
Exclude(AvailDrvs, ch); //AvailDrvs:= AvailDrvs - [ch];
end;
function ConvertToUNCPath(MappedDrive: string) : string;
var
RemoteString : array[0..255] of char;
lpRemote : PChar;
StringLen : DWord; //Integer;
begin
lpRemote := @RemoteString;
StringLen := 255;
WNetGetConnection(Pchar(ExtractFileDrive(MappedDrive)),
lpRemote,
StringLen);
Result := RemoteString;
end;
function DriveIsMapped(UncPath: String; var Path: String): boolean;
var
ch: Char;
root: String;
begin
result:= false;
root:= 'C:\';
for ch := 'C' to 'Z' do
if not (ch in AvailDrvs) then begin
root[1] := ch;
if GetDriveType(Pchar(root))= DRIVE_REMOTE then
if Uppercase(ConvertToUNCPath(root)) = Uppercase(UncPath) then begin
Path[1]:= root[1]; //just change the drive letter...
result:= true;
exit
end
end;
end; //DriveIsMapped
(*
function GetAssignedDriveLetter(n : integer) : char;
begin
if n <= AssignedCount then
result:= AssignedDriveLetter[n]
else
result:= #0;
end;
*)
var
LogFile : string;
procedure WriteLog(Msg: string);
var f: textfile;
begin
assignfile(f, LogFile);
if FileExists(LogFile) then
append(f)
else
rewrite(f);
writeln(f, FormatDateTime('mm/dd/yy hh:mm:ss "' + Msg + '"', now));
closefile(f);
end; //WriteLog
function CancelUncDrive : boolean;
var drive: String;
begin
result:= true;
if AssignedCount >0 then begin
drive:= AssignedDriveLetters[AssignedCount] + ':';
if WNetCancelConnection(pchar(drive), true) = NO_ERROR then begin
WriteLog('WNetCancelConnection: ' + Drive + ' sucessfully disconnected');
Delete(AssignedDriveLetters, pos(Drive[1], AssignedDriveLetters), 1)
end else
begin
WriteLog('*** WNetCancelConnection: Unable to disconnect ' + Drive + '! ***');
result:= false
end;
end else
WriteLog('*** WNetCancelConnection: Called with nothing to disconnect ' + Drive + '! ***');
end;
function FirstAvailDrive: char;
var
ch: Char;
root: String;
Begin
root:= 'C:\';
for ch := 'C' to 'Z' do
if ch in AvailDrvs then begin
root[1] := ch;
if GetDriveType(Pchar(root))= 1 then
Break; //The root directory does not exist, so USE IT!!!
end;
result:= ch
end; //FirstAvailDrive
function TestPath(const Path: string) : boolean;
var Seconds, Start: TDateTime;
begin
Start:= Now;
repeat
Application.ProcessMessages;
Seconds:= (Now - Start) * 86400;
until (Seconds > 1) or DirectoryExists(Path);
if DirectoryExists(Path) then begin
WriteLog('TestPath: Directory '+ path + ' found ok.');
result:= true
end else
begin
WriteLog('*** TestPath: Directory '+ path + ' does not exist! ***');
result:= false
end
end; //TestPath
function GetExtendedError(var Error : DWord) : string;
var
rc : word;
ErrMsg : array[0..256] of char;
Provider: string;
begin
Provider:= 'Microsoft Network';
Rc:= WNetGetLastError(Error, ErrMsg, sizeof(ErrMsg), pchar(Provider), length(Provider));
if Rc=0 then result:= ErrMsg else result:= inttostr(error)
end;
function NewMap(drive, UncPath: string) : boolean;
var
NRW: TNetResource;
rc : DWord;
begin
result:= true;
with NRW do begin
dwType := RESOURCETYPE_ANY;
lpLocalName := pchar(drive); // map to this driver letter
lpRemoteName := pchar(UncPath);
lpProvider := 'Microsoft Network'; // Must be filled in. If an empty string is used, it will use the lpRemoteName.
end;
rc:= WNetAddConnection2(NRW, pchar(''), pchar(''), CONNECT_UPDATE_PROFILE);
case rc of
NO_ERROR: result:=true;
ERROR_ACCESS_DENIED: showMessage('Access to the network resource was denied.');
ERROR_ALREADY_ASSIGNED: showMessage('The local device specified by lpLocalName is already connected to a network resource.');
ERROR_BAD_DEV_TYPE: showMessage('The type of local device and the type of network resource do not match.');
ERROR_BAD_DEVICE: showMessage('The value specified by lpLocalName is invalid.');
ERROR_BAD_NET_NAME: showMessage('The value specified by lpRemoteName is not acceptable to any network resource provider. The resource name is invalid, or the named resource cannot be located.');
ERROR_BAD_PROFILE: showMessage('The user profile is in an incorrect format.');
ERROR_BAD_PROVIDER: showMessage('The value specified by lpProvider does not match any provider.');
ERROR_BUSY: showMessage('The router or provider is busy, possibly initializing. The caller should retry.');
ERROR_CANCELLED: showMessage('The attempt to make the connection was cancelled by the user through a dialog box from one of the network resource providers, or by a called resource.');
ERROR_CANNOT_OPEN_PROFILE: showMessage('The system is unable to open the user profile to process persistent connections.');
ERROR_DEVICE_ALREADY_REMEMBERED: showMessage('An entry for the device specified in lpLocalName is already in the user profile.');
ERROR_EXTENDED_ERROR: showMessage('Extended error: [' + GetExtendedError(Rc) + ']');
ERROR_INVALID_PASSWORD: showMessage('The specified password is invalid.');
ERROR_NO_NET_OR_BAD_PATH: showMessage('A network component has not started, or the specified name could not be handled.');
ERROR_NO_NETWORK: showMessage('There is no network present.');
ERROR_DEVICE_IN_USE: showMessage('The device is in use by an active process and cannot be disconnected.');
ERROR_NOT_CONNECTED: showMessage('The name specified by the lpName parameter is not a redirected device, or the system is not currently connected to the device specified by the parameter.');
ERROR_OPEN_FILES: showMessage('There are open files, and the fForce parameter is FALSE.');
else showMessage('GetUnc2DriveLetter: Unable to map drive - Undetermined error occured!!!');
end; //case
end;
function GetUnc2DriveLetter(UncPathIn, Terminator: String; var Path: String): boolean;
//diagnostic version
var
UncPathOut: String;
Drive: String;
n: integer;
ch : char;
begin
n:=0;
ch:=#0;
result:=false; //assume failure...
WriteLog('GetUnc2DriveLetter(' + UncPathIn + ', ' + Terminator + ', '+ path + ')');
UncPathOut:= UNCPathIn;
try
ch:= Upcase(FirstAvailDrive);
if ch in AvailDrvs then begin
drive:= ch + ':';
n:= pos(uppercase(Terminator), uppercase(UncPathIn)) - 1;
Path:= Drive + copy(UncPathIn, n, length(UncPathIn));
UncPathOut:= copy(UncPathIn, 1, n - 1);
If DriveIsMapped(UncPathOut, Path) then
//Path now contains the already mapped drive letter
WriteLog('GetUnc2DriveLetter: UNC ' + UncPathOut + ' already mapped as ' + path)
else if NewMap(drive, UncPathOut) then begin
AssignedDriveLetters:= AssignedDriveLetters + ch;
WriteLog('GetUnc2DriveLetter: AssignedDriveLetters now ' + AssignedDriveLetters);
result:=true
end else
begin // try again with next letter
RemoveUnMapableDrive(ch);
WriteLog('*** GetUnc2DriveLetter: ' + Ch + ': removed from list of mapable drives - will try again: ***');
Result:= GetUnc2DriveLetter(UncPathOut + '\' + Terminator, Terminator, Path);
end
end else
begin
showMessage('GetUnc2DriveLetter: No available drive letters!');
WriteLog('*** GetUnc2DriveLetter: No available drive letters to try! ***');
result:= false;
exit;
end;
except
result:=false;
WriteLog('*** GetUnc2DriveLetter: Failed with exception : ___ ***');
showMessage('GetUnc2DriveLetter: Unable to map drive' + ch + ':\');
end;
if TestPath(Path) then //Now, try to access the drive to make SURE it is there...
result:= true
else if InputQuery('Unable to map ' + UNCPathOut + ' to ' + Drive + '\',
'Please map a drive and enter the drive letter:',
Drive) then
begin
Path:= Upcase(Drive[1]) + ':' + copy(UncPathIn, n, length(UncPathIn));
WriteLog('GetUnc2DriveLetter: Trying user defined path - ' + path);
//will work if user enters 'U' or 'U:' or 'U:\'
result:= TestPath(Path)
end else
result:= false;
end; //GetUnc2DriveLetter
procedure GetAllAvailableDrives;
var
ch: Char;
root: String;
Begin
root:= 'C:\';
for ch := 'C' to 'Z' do
if ch in AvailDrvs then begin
root[1] := ch;
if GetDriveType(Pchar(root)) <> 1 then
RemoveUnMapableDrive(ch)
end;
end;
initialization
begin
LogFile:= ChangeFileExt(Application.ExeName, '.LOG');
DeleteFile(LogFile);
WriteLog('Init:');
WriteLog(paramstr(0) + ' ' + paramstr(1) + ' ' + paramstr(2));
setlength(AssignedDriveLetters, 0);
GetAllAvailableDrives;
end;
finalization
begin
while AssignedCount <> 0 do
begin
CancelUncDrive;
application.ProcessMessages;
end;
WriteLog('Done');
end
end.
As I'm using a standard shell tree view component I can't stop users selecting drives like this, hence my original question as to how to convert one form of path to another. Do you have a suggestion as to how I might get round this problem?