{
Bu dosyayı yabancı bir siteden aldım.
}
unit WNetMap;
interface
uses Windows, Classes, SysUtils;
procedure FindDrives( aDrives :TStrings );
function GetRememberedNetworkConnection( cDrive :string; var NetResource :TNetResource ) :Boolean;
function CheckNetworkConnection( cDrive :string; var cExplanation :string ) :Boolean;
function GetNetworkErrorDescription( nError :integer ) :string;
function GetDriveType( cDrive :string ) :integer;
function AddTrailingBackslash( cPath :string ) :string;
const
DriveTypes :array [0..6] of string = ('Unknown','Unknown','Removable Disk','Local Drive',
'Network Drive','CD-Rom', 'RAM-Disk');
implementation
uses Controls, Forms, FileCtrl;
procedure FindDrives( aDrives :TStrings );
var
nCnt :Byte;
cDrv :string;
Drives :set of 0..25;
begin
DWORD(Drives) := GetLogicalDrives;
aDrives.Clear;
for nCnt := 0 to 25 do
if nCnt in Drives then
begin
cDrv := Char( nCnt + Ord('A') );
aDrives.Add( cDrv );
end;
end;
function GetRememberedNetworkConnection( cDrive :string; var NetResource :TNetResource ) :Boolean;
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;
var
I, BufSize, NetResult: Integer;
Drive: Char;
NetHandle: THandle;
NetResources: PNetResourceArray;
RemoteNameInfo: array[0..1023] of Byte;
Size, Count :{$IFDEF VER130} DWord {$ELSE} integer {$ENDIF};
begin
Result := false;
cDrive := cDrive + ' ';
Drive := UpCase(cDrive[1]);
if (Drive < 'A') or (Drive > 'Z') then
exit;
if WNetOpenEnum(RESOURCE_REMEMBERED , RESOURCETYPE_DISK, 0, nil, NetHandle) <> NO_ERROR then
Exit;
try
BufSize := 50 * SizeOf(TNetResource);
GetMem(NetResources, BufSize);
try
while True do
begin
Count := $FFFFFFFF;
Size := BufSize;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
if NetResult = ERROR_MORE_DATA then
begin
BufSize := Size;
ReallocMem(NetResources, BufSize);
Continue;
end;
if NetResult <> NO_ERROR then Exit;
for I := 0 to Count - 1 do
with NetResources^[I] do
if (lpLocalName <> nil) and (Drive = UpCase(lpLocalName[0])) then
begin
NetResource := NetResources^[I];
result := true;
Exit;
end;
end;
finally
FreeMem(NetResources, BufSize);
end;
finally
WNetCloseEnum(NetHandle);
end;
end;
function CheckNetworkConnection( cDrive :string; var cExplanation :string ) :Boolean;
var
aDrives :TStringList;
NetResource :TNetResource;
lFound :Boolean;
iResult :integer;
begin
try
Screen.Cursor := crHourglass;
cExplanation := '';
aDrives := TStringList.Create;
FindDrives( aDrives );
if (aDrives.IndexOf( cDrive[1] ) <> -1) and DirectoryExists( cDrive[1] + ':\' ) then
result := true
else if (aDrives.IndexOf( cDrive[1] ) <> -1) then
begin
result := false;
cExplanation := 'The network connection is broken. Check the remote computer';
end
else
begin
{there is no connection, can we reconnect?}
lFound := GetRememberedNetworkConnection( cDrive, NetResource );
if lFound then
begin
{we found a remembered connection, attempt a reconnect}
iResult := WNetAddConnection2( NetResource, nil, nil, 0 );
result := iResult = NO_ERROR;
if not result then
begin
cExplanation := GetNetworkErrorDescription(iResult);
if cExplanation = '' then
cExplanation := 'Unable to connect to ' + cDrive + ' (ErrorCode = ' + IntToStr(iResult) + ')';
end;
end
else
begin
cExplanation := 'There are no mappings for ' + cDrive;
end;
end;
finally
aDrives.Free;
Screen.Cursor := crDefault;
end;
end;
function GetNetworkErrorDescription( nError :integer ) :string;
var
aDesc, aProv :array[0..255] of Char;
nTemp :{$IFDEF VER130} DWord {$ELSE} integer {$ENDIF};
begin
case nError of
ERROR_NOT_SUPPORTED : result := 'The network request is not supported.';
ERROR_REM_NOT_LIST : result := 'The remote computer is not available.';
ERROR_DUP_NAME : result := 'A duplicate name exists on the network.';
ERROR_BAD_NETPATH : result := 'The network path was not found.';
ERROR_NETWORK_BUSY : result := 'The network is busy.';
ERROR_DEV_NOT_EXIST : result := 'The specified network resource or device is no longer available.';
ERROR_TOO_MANY_CMDS : result := 'The network BIOS command limit has been reached.';
ERROR_ADAP_HDW_ERR : result := 'A network adapter hardware error occurred.';
ERROR_BAD_NET_RESP : result := 'The specified server cannot perform the requested operation.';
ERROR_UNEXP_NET_ERR : result := 'An unexpected network error occurred.';
ERROR_BAD_REM_ADAP : result := 'The remote adapter is not compatible.';
ERROR_PRINTQ_FULL : result := 'The printer queue is full.';
ERROR_NO_SPOOL_SPACE : result := 'Space to store the file waiting to be printed is not available on the server.';
ERROR_PRINT_CANCELLED : result := 'Your file waiting to be printed was deleted.';
ERROR_NETNAME_DELETED : result := 'The specified network name is no longer available.';
ERROR_NETWORK_ACCESS_DENIED : result := 'Network access is denied.';
ERROR_BAD_DEV_TYPE : result := 'The network resource type is not correct.';
ERROR_BAD_NET_NAME : result := 'The network name cannot be found.';
ERROR_TOO_MANY_NAMES : result := 'The name limit for the local computer network adapter card was exceeded.';
ERROR_TOO_MANY_SESS : result := 'The network BIOS session limit was exceeded.';
ERROR_SHARING_PAUSED : result := 'The remote server has been paused or is in the process of being started.';
ERROR_REQ_NOT_ACCEP : result := 'Too many connections';
ERROR_REDIR_PAUSED : result := 'The specified printer or disk device has been paused.';
else
nTemp := nError;
WNetGetLastError( nTemp, aDesc, SizeOf(aDesc), aProv, SizeOf(aProv) );
result := StrPas(aDesc);
if result = '' then
result := 'Network Error ' + IntToStr(nError);
end;
end;
function GetDriveType( cDrive :string ) :integer;
var
aBuffer :array[0..255] of Char;
begin
if Length(cDrive) = 1 then
cDrive := cDrive + ':\';
StrPCopy( aBuffer, cDrive );
result := Windows.GetDriveType( aBuffer );
end;
function AddTrailingBackslash( cPath :string ) :string;
begin
if cPath[Length(cPath)] <> '\' then
cPath := cPath + '\';
result := cPath;
end;
end.