unit CDControl;
interface
uses
Windows, Dialogs, SysUtils, Classes;
Const
VWIN32_DIOC_DOS_IOCTL : longint = 1;
IOCTL_STORAGE_MEDIA_REMOVAL = $2D4804;
IOCTL_STORAGE_EJECT_MEDIA = $2D4808;
IOCTL_STORAGE_LOAD_MEDIA = $2D480C;
IOCTL_STORAGE_CHECK_VERIFY = $2D4800;
{Eject Media}
type
TIoCtlRegs =
record
EBX : DWORD;
EDX : DWORD;
ECX : DWORD;
EAX : DWORD;
EDI : DWORD;
ESI : DWORD;
Flags : DWORD;
end;
{Lock Media}
PREVENT_MEDIA_REMOVAL =
record
p1: byte;
end;
PREVENT_MEDIA_REMOVAL1 =
record
p1: byte;
p2: byte;
end;
{}
type
TCDControl =
Class(TObject)
private
public
function CDDriveCount : Integer;
function Check_Media(Drive : Char) : Boolean;
function Eject_Media(Drive : Char) : Boolean;
function Load_Media(Drive: Char): Boolean;
function Lock_UnLock(drive: char; lock: boolean) : boolean;
end;
var cdc : TCDControl;
implementation
function TCDControl.CDDriveCount : Integer;
var i, fType : integer;
s :
String;
begin
result:= 0;
for I := 0
to 25
do
begin
s:= Chr(i+65)+'
:\';
fType:= GetDriveType(Pchar(s));
if (ftype = DRIVE_CDROM)
then
begin
inc(result);
end;
end;
end;
{-------------------------- Check Media Availability --------------------------}
function TCDControl.Check_Media(Drive : Char) : boolean;
var
hDevice: THandle;
bytesReturned: DWORD;
begin
result:= false;
try
hDevice:= CreateFile(PChar('
\\.\' + Drive + '
:'),
GENERIC_READ,
FILE_SHARE_READ
Or
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);
If hDevice <> INVALID_HANDLE_VALUE
Then
begin
result:= DeviceIoControl(hDevice,
IOCTL_STORAGE_CHECK_VERIFY,
nil, 0,
nil, 0,
bytesReturned,
nil);
CloseHandle(hDevice);
end;
except
on E :
Exception do
ShowMessage(E.
Message);
end;
end;
{---------------------------- Eject Removable Media ---------------------------}
function TCDControl.Eject_Media(Drive : Char) : Boolean;
var
hDevice: THandle;
bytesReturned: DWORD;
DriveStr:
String;
ctrlcode: Cardinal;
Regs: TIoCtlRegs;
begin
Result:=FALSE;
try
DriveStr:='
\\.\' + Drive + '
:';
hDevice := CreateFile(PAnsiChar(DriveStr),
GENERIC_READ,
FILE_SHARE_READ
or
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);
if hDevice <> INVALID_HANDLE_VALUE
then
begin
Result := DeviceIoControl(hDevice,
IOCTL_STORAGE_EJECT_MEDIA,
nil, 0,
nil, 0,
bytesReturned,
nil);
CloseHandle(hDevice);
if Result
then
Exit;
end;
except
on E :
Exception do
ShowMessage(E.
Message);
end;
try
hDevice := CreateFile('
\\.\VWIN32', 0, 0,
nil, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
if hDevice = INVALID_HANDLE_VALUE
then Exit;
with Regs
do begin
EAX := $440D;
EBX := Ord(UpCase(Drive)) - Ord('
A') + 1;
ECX := $0849;
Flags := $0001;
end;
Result := DeviceIOControl(hDevice, 1,
@Regs, SizeOf(Regs),
@Regs, SizeOf(Regs),
bytesReturned,
nil);
CloseHandle(hDevice);
except
on E :
Exception do
ShowMessage(E.
Message);
end;
end;
{---------------------------- Load Removable Media ----------------------------}
function TCDControl.Load_Media(Drive: Char): Boolean;
var
hDevice: THandle;
bytesReturned: DWORD;
ctrlcode: Cardinal;
Regs: TIoCtlRegs;
begin
Result:= FALSE;
try
hDevice := CreateFile(PChar('
\\.\' + Drive + '
:'),
GENERIC_READ,
FILE_SHARE_READ
or
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);
if hDevice <> INVALID_HANDLE_VALUE
then
begin
Result := DeviceIoControl(hDevice,
IOCTL_STORAGE_LOAD_MEDIA,
nil, 0,
nil, 0,
bytesReturned,
nil);
CloseHandle(hDevice);
if Result
then
Exit;
end;
except
on E :
Exception do
ShowMessage(E.
Message);
end;
try
hDevice := CreateFile('
\\.\VWIN32', 0, 0,
nil, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
if hDevice = INVALID_HANDLE_VALUE
then
Exit;
with Regs
do
begin
EAX := $440D;
EBX := Ord(UpCase(Drive)) - Ord('
A') + 1;
ECX := $0849;
Flags := $0001;
end;
Result := DeviceIOControl(hDevice,
VWIN32_DIOC_DOS_IOCTL,
@Regs, SizeOf(Regs),
@Regs, SizeOf(Regs),
bytesReturned,
nil);
if Regs.Flags
and 1 = 1
then
case Regs.EAX
of
$01 : ShowMessage('
The function is not supported.');
$B1 : ShowMessage('
The volume is locked in the drive.');
$B2 : ShowMessage('
The volume is not removable.');
$B5 : ShowMessage('
The valid eject request has failed.');
end;
CloseHandle(hDevice);
except
on E :
Exception do
ShowMessage(E.
Message);
end;
end;
{------------------------- Lock+UnLock Removable Media ------------------------}
function TCDControl.Lock_UnLock(drive: char; lock: boolean) : boolean;
var osv: _osversioninfoA;
retdummy: cardinal;
retdummy1: boolean;
hLwStatus: cardinal;
xlockdrive,hdrivex:
string;
rawstuff: TIoCtlRegs;
pmr32: prevent_media_removal;
pmr9x: prevent_media_removal1;
begin
result:= false;
if lock = True
then
begin
PMR32.P1 := 1;
PMR9x.P1 := 0;
end
else
begin
PMR32.P1 := 0;
PMR9x.P1 := 1;
end;
PMR9x.P2 := 0;
OSV.dwOSVersionInfoSize := 148;
retDummy1 := GetVersionExA(OSV);
xLockDrive := copy(upcase(drive), 1,1);
hDriveX := xLockDrive + '
:';
if OSV.dwPlatformId >= 2
then
begin
hLwStatus := CreateFile(pchar('
\\.\' + hDriveX),
GENERIC_WRITE
or
GENERIC_READ, 0, 0,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,0);
if hLwStatus <> INVALID_HANDLE_VALUE
then
begin
result:= DeviceIoControl(hLwStatus,
IOCTL_STORAGE_MEDIA_REMOVAL,
@PMR32.p1,
sizeof(pmr32), 0, 0,
retDummy, 0);
CloseHandle(hlwstatus);
end;
end
else
begin
hLwStatus := CreateFile('
\\.\VWIN32', 0, 0, 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
if hLwStatus <> INVALID_HANDLE_VALUE
then
begin
RawStuff.EBX := ord(hDriveX[1]) - ord('
A') + 1;
RawStuff.EAX := $440D;
RawStuff.ECX := $48
or $800;
RawStuff.EDX := PMR9x.p1;
result:= DeviceIoControl(hLwStatus,
VWIN32_DIOC_DOS_IOCTL,
@RawStuff, sizeof(RawStuff),
@RawStuff, sizeof(RawStuff),
retDummy, 0);
CloseHandle(hLwStatus);
end;
end;
end;
end.