{************************************************************}
{ }
{ DriveTools }
{ Version: 2.0 }
{ }
{ Copyright (c) 2004 Michael Puff }
{ [url]www.luckie-online.de[/url] }
{ }
{************************************************************}
{*************************************************************
History:
- 2004-12-18 - 1.0
- LoadLogicalDrives
- FindAllFiles
- GetVolumeLabel
- 2004-12-18 - 2.0
- Rewrote FindAllFiles (no SysUtils, no Classes)
and added InitFindAllFiles
- Rewrote GetLogicalDrives (no SysUtils, no Classes)
*************************************************************}
unit DriveTools;
interface
uses Windows;
type
TStringArray =
array of string;
var
FoundFiles : TStringArray;
cntFoundFiles: Integer = 0;
procedure GetLogicalDrives(
var Drives: TStringArray; ReadyOnly: Boolean = True;
WithLabels: Boolean = True);
procedure InitFindAllFiles;
procedure FindAllFiles(RootFolder:
string; Mask:
string; Recurse: Boolean =
True);
function GetVolumeLabel(
const Drive:
string):
string;
implementation
////////////////////////////////////////////////////////////////////////////////
//
// GetVolumeLabel
//
function GetVolumeLabel(
const Drive:
string):
string;
var
RootDrive :
string;
Buffer :
array[0..MAX_PATH + 1]
of Char;
FileSysFlags : DWORD;
MaxCompLength: DWORD;
begin
result := '
';
FillChar(Buffer, sizeof(Buffer), #0);
if length(Drive) = 1
then
RootDrive := Drive + '
:\'
else
RootDrive := Drive;
if GetVolumeInformation(PChar(RootDrive), Buffer, sizeof(Buffer),
nil,
MaxCompLength, FileSysFlags,
nil, 0)
then
begin
result :=
string(Buffer);
end;
end;
////////////////////////////////////////////////////////////////////////////////
//
// GetLogicalDrives
//
procedure GetLogicalDrives(
var Drives: TStringArray; ReadyOnly: Boolean = True;
WithLabels: Boolean = True);
function DriveIsReady(
const Drive:
string): Boolean;
var
wfd : TWin32FindData;
hFindData : THandle;
begin
SetErrorMode(SEM_FAILCRITICALERRORS);
hFindData := FindFirstFile(Pointer(Drive + '
*.*'), wfd);
if hFindData <> INVALID_HANDLE_VALUE
then
begin
Result := True;
end
else
begin
Result := False;
end;
FindClose(hFindData);
SetErrorMode(0);
end;
var
FoundDrives : PChar;
CurrentDrive : PChar;
len : DWord;
cntDrives : Integer;
begin
cntDrives := 0;
SetLength(Drives, 26);
GetMem(FoundDrives, 255);
len := GetLogicalDriveStrings(255, FoundDrives);
if len > 0
then
begin
try
CurrentDrive := FoundDrives;
while CurrentDrive[0] <> #0
do
begin
if ReadyOnly
then
begin
if DriveIsReady(
string(CurrentDrive))
then
begin
if WithLabels
then
Drives[cntDrives] := CurrentDrive + '
[' +
GetVolumeLabel(CurrentDrive) + '
]'
else
Drives[cntDrives] := CurrentDrive;
Inc(cntDrives);
end;
end
else
begin
if WithLabels
then
Drives[cntDrives] := CurrentDrive + '
[' +
GetVolumeLabel(CurrentDrive) + '
]'
else
Drives[cntDrives] := CurrentDrive;
Inc(cntDrives);
end;
CurrentDrive := PChar(@CurrentDrive[lstrlen(CurrentDrive) + 1]);
end;
finally
FreeMem(FoundDrives, len);
end;
SetLength(Drives, cntDrives);
end;
end;
////////////////////////////////////////////////////////////////////////////////
//
// InitFindAllFiles
// Resets global variables FoundFiles and cntFoundFiles
// Must always be called before FindAllFiles!!!
procedure InitFindAllFiles;
begin
SetLength(FoundFiles, 0);
cntFoundFiles := 0;
end;
////////////////////////////////////////////////////////////////////////////////
//
// FindAllFiles
//
procedure FindAllFiles(RootFolder:
string; Mask:
string; Recurse: Boolean =
True);
var
hFindFile : THandle;
wfd : TWin32FindData;
Filename :
string;
begin
if RootFolder[length(RootFolder)] <> '
\'
then
RootFolder := RootFolder + '
\';
ZeroMemory(@wfd, sizeof(wfd));
wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
if Recurse
then
begin
hFindFile := FindFirstFile(pointer(RootFolder + '
*.*'), wfd);
if hFindFile <> 0
then
try
repeat
if wfd.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY =
FILE_ATTRIBUTE_DIRECTORY
then
if (
string(wfd.cFileName) <> '
.')
and (
string(wfd.cFileName) <> '
..')
then
begin
FindAllFiles(RootFolder + wfd.cFileName, Mask, Recurse);
end;
until FindNextFile(hFindFile, wfd) = False;
finally
Windows.FindClose(hFindFile);
end;
end;
hFindFile := FindFirstFile(pointer(RootFolder + Mask), wfd);
if hFindFile <> INVALID_HANDLE_VALUE
then
try
repeat
if wfd.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY <>
FILE_ATTRIBUTE_DIRECTORY
then
begin
Filename := RootFolder +
string(wfd.cFileName);
if length(FoundFiles) = cntFoundFiles
then
SetLength(FoundFiles, length(FoundFiles) + 100);
FoundFiles[cntFoundFiles] := Filename;
Inc(cntFoundFiles);
end;
until FindNextFile(hFindFile, wfd) = False;
finally
Windows.FindClose(hFindFile);
setlength(FoundFiles, cntFoundFiles);
end;
end;
end.