Mega Code Archive
Cdcode
<![CDATA[
> Does anyone know of a routine in Delphi5 to check if the CD drive is
> present and what the path to it is on a system?
function IsCDReady(var C : Char): boolean;
var
CD : Char;
begin
Result := False;
for CD := 'A' to 'Z' do
begin
Result := ((GetDriveKind(CD) = dkCDRom) and IsDiskUsable(CD));
if Result then
begin
C := CD;
Exit;
end;
end;
end;
(*----------------------------------------------------------------------------------
Description : returns the status of a drive
Platform : Win32
Error checking : ?
Example call :
Notes : declare the TDiskStatus (the return type) and option as following
type
TDiskStatus = ( dsUnKnown, dsPathNotFound, dsDriveIsInvalid, dsDiskHasFiles, dsDiskIsEmpty,
dsNoDiskInDrive, dsDiskIsUnAccessible, dsDiskIsFull,
dsDiskIsCorrupted, dsDiskIsUnFormatted, dsDiskIsWriteProtected );
TDriveKind = ( dkUnKnown, dkDriveIsInvalid, dkRootNotExists, dkRemovable,
dkFixed, dkNerWorkDrive, dkCDRom, dkRamDisk);
const
arDiskStates : array[TDiskStatus] of string =
('Unknown drive', 'Disk/Path not found','Drive is invalid', 'Disk has files', 'Disk is empty',
'No disk in drive', 'Disk in not accessible', 'Disk is full', 'Disk is corrupted',
'Disk is unformatted', 'Disk has write protection' );
Author : Theo Bebekis - bebekis@otenet.gr
-----------------------------------------------------------------------------------*)
function GetDiskStatus(C: Char): TDiskStatus;
const
cMask = ':\*.*';
var
iCode : LongInt;
SR : TSearchRec;
OldErrorMode : cardinal;
begin
Result := dsUnKnown;
if not IsValidDriveLetter(C) then Exit;
{ turn off critical errors }
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
{$I-} { turn off exceptions }
iCode := SysUtils.FindFirst( C + cMask, faAnyfile, SR);
SysUtils.FindClose(SR);
{$I+} { turn on exceptions }
{ turn on critical errors }
SetErrorMode(OldErrorMode);
case iCode of
ERROR_SUCCESS : Result := dsDiskHasFiles;
ERROR_FILE_NOT_FOUND ,
ERROR_PATH_NOT_FOUND : Result := dsPathNotFound;
ERROR_NO_MORE_FILES : Result := dsDiskIsEmpty;
ERROR_NOT_READY : Result := dsNoDiskInDrive;
ERROR_NOT_DOS_DISK : Result := dsDiskIsUnAccessible;
ERROR_HANDLE_DISK_FULL,
ERROR_DISK_FULL : Result := dsDiskIsFull;
ERROR_DISK_CORRUPT : Result := dsDiskIsCorrupted;
ERROR_UNRECOGNIZED_MEDIA : Result := dsDiskIsUnFormatted;
STG_E_DISKISWRITEPROTECTED : Result := dsDiskIsWriteProtected;
end;
end;
{----------------------------------------------------------------------------------
Description :
Parameters :
Author : Theodoros Bebekis, email bebekis@otenet.gr
-----------------------------------------------------------------------------------}
function GetDriveKind(C: Char): TDriveKind;
begin
Result := dkUnKnown;
if not IsValidDriveLetter(C) then Exit;
case Windows.GetDriveType(PChar(C + ':\')) of
0 : Result := dkUnKnown;
1 : Result := dkRootNotExists;
DRIVE_REMOVABLE : Result := dkRemovable;
DRIVE_FIXED : Result := dkFixed;
DRIVE_REMOTE : Result := dkNerWorkDrive;
DRIVE_CDROM : Result := dkCDRom;
DRIVE_RAMDISK : Result := dkRamDisk;
end;
end;
{----------------------------------------------------------------------------------
Description :
Notes :
Author : Theodoros Bebekis, email bebekis@otenet.gr
-----------------------------------------------------------------------------------}
function IsDiskUsable(C: Char): boolean;
begin
Result := not (GetDiskStatus(C) in [ dsUnKnown, dsDriveIsInvalid, dsNoDiskInDrive,
dsDiskIsUnAccessible, dsDiskIsCorrupted,
dsDiskIsUnFormatted, dsDiskIsWriteProtected]);
end;
{----------------------------------------------------------------------------------
Description :
Notes :
Author : Theodoros Bebekis, email bebekis@otenet.gr
-----------------------------------------------------------------------------------}
function IsValidDriveLetter(C: Char): boolean;
begin
Result := UpCase(C) in ['A'..'Z'];
end;
Theo
-----------------------------------
Theo Bebekis
Thessaloniki, Greece
bebekis@otenet.gr
-----------------------------------
_______________________________________________
Delphi mailing list -> Delphi@elists.org
http://elists.org/mailman/listinfo/delphi
]]>