|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как програмно открыть/закрыть CDRom?
// Способ первый
uses
{...,} MMSystem;
// Открыть CDRom
mciSendString( 'Set cdaudio door open wait', nil, 0, handle );
// Закрыть CDRom
mciSendString( 'Set cdaudio door closed wait', nil, 0, handle );
// Способ второй
uses
{...,} MMSystem;
function OpenCD(Drive: Char; Open: Boolean): Boolean;
var
Res: MciError;
OpenParm: TMCI_Open_Parms;
Flags: DWord;
S: string;
DeviceID: Word;
begin
Result := false;
S := Drive + ':';
Flags := mci_Open_Type or mci_Open_Element;
with OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
if Res <> 0 then
Exit;
DeviceID := OpenParm.wDeviceID;
try
if Open then
Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0)
else
Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
if Res = 0 then
Exit;
Result := true;
finally
mciSendCommand( DeviceID, mci_Close, Flags, Longint( @OpenParm ) );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenCD('E', True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
OpenCD('E', False);
end;
// Способ третий
function OpenCD(Drive: Char; Open: Boolean): Boolean;
//const
// IOCTL_DISK_EJECT_MEDIA =
// (IOCTL_DISK_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0202 shl 2) or (METHOD_BUFFERED);
// IOCTL_DISK_LOAD_MEDIA =
// (IOCTL_DISK_BASE shl 16) or (FILE_READ_ACCESS shl 14) or ($0203 shl 2) or (METHOD_BUFFERED);
var
hCDDevice: THandle;
lpBytesReturned: DWORD;
begin
hCDDevice := CreateFile(PChar('\\.\' + Drive + ':'), GENERIC_READ {or GENERIC_WRITE},
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hCDDevice <> INVALID_HANDLE_VALUE then
begin
if Open then
DeviceIoControl(hCDDevice, IOCTL_DISK_EJECT_MEDIA, nil, 0, nil, 0, lpBytesReturned, nil)
else
DeviceIoControl(hCDDevice, IOCTL_DISK_LOAD_MEDIA, nil, 0, nil, 0, lpBytesReturned, nil);
CloseHandle(hCDDevice);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenCD('E', True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
OpenCD('E', False);
end;
|
Как получить имена всех CDRom'ов, установленных в системе?
uses
{...,} Registry;
procedure GetAviableCDROM( ListCD: TStrings );
var
Reg: TRegistry;
Key, SubKey, TempKey: string;
i, KolCD: byte;
begin
Reg := TRegistry.Create;
with Reg do
try
RootKey := HKEY_LOCAL_MACHINE;
// Здесь лежат имена ключей с информацией об установленных CDROM'ах
Key := 'SYSTEM\CurrentControlSet\Services\Cdrom\Enum';
SubKey := 'SYSTEM\CurrentControlSet\Enum\';
Access := KEY_READ; // На общих правах NT не пускает к этим ключам
if not OpenKey( Key, false ) then Exit;
// Узнаем количество CDROM'ов
KolCD := ReadInteger( 'Count' );
if KolCD = 0 then Exit;
for i:=0 to KolCD-1 do
begin
OpenKey( Key, False );
TempKey := ReadString( IntToStr( i ) );
CloseKey;
if not OpenKey( SubKey + Tempkey, false ) then Break;
ListCD.Add( ReadString( 'FriendlyName' ) );
CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
GetAviableCDROM( Memo1.Lines );
end;
|
Как проверить, включен ли автозапуск CDRom'а?
// Проверено в Windows 2000
uses
{...,} Registry;
function IsCDAutoRun: boolean;
var
Reg: TRegistry;
i: integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists( 'System\CurrentControlSet\Services\CDROM' ) then
begin
if Reg.OpenKey( 'System\CurrentControlSet\Services\CDROM', false ) then
i := Reg.ReadInteger( 'AutoRun' );
end;
case i of
0: Result := false;
else
Result := true;
end;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsCDAutoRun then
ShowMessage( 'Автозапуск включен' )
else
ShowMessage( 'Автозапуск выключен' );
end;
|
Как включить/отключить автозапуск CDRom'а?
// Проверено в Windows 2000
uses
{...,} Registry;
procedure SetCDAutoRun( ARun: boolean );
var
Reg: TRegistry;
i: integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists( 'System\CurrentControlSet\Services\CDROM' ) then
begin
if Reg.OpenKey( 'System\CurrentControlSet\Services\CDROM', false ) then
Reg.WriteInteger( 'AutoRun', Abs( Integer( ARun ) ) );
end;
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Включить
SetCDAutoRun( true );
// Отключить
SetCDAutoRun( false );
end;
|
Как заблокировать/разблокировать CDRom?
const
{$EXTERNALSYM IOCTL_CDROM_MEDIA_REMOVAL}
IOCTL_CDROM_MEDIA_REMOVAL =
(FILE_DEVICE_CD_ROM shl 16) or (FILE_READ_ACCESS shl 14) or ($201 shl 2) or (METHOD_BUFFERED);
// Вместо IOCTL_CDROM_MEDIA_REMOVAL можно использовать значения:
// • IOCTL_DISK_MEDIA_REMOVAL
// • IOCTL_STORAGE_MEDIA_REMOVAL
// • $00024804;
// • $002D4804;
type
PREVENT_MEDIA_REMOVAL = packed record
PreventMediaRemoval: ByteBool;
end;
function LockCD(Drive: Char; Lock: Boolean): Boolean;
var
hCDDevice: THandle;
lpBytesReturned: DWORD;
pmrLockCDROM: PREVENT_MEDIA_REMOVAL;
begin
hCDDevice := CreateFile(PChar('\\.\' + Drive + ':'), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hCDDevice <> INVALID_HANDLE_VALUE then
begin
pmrLockCDROM.PreventMediaRemoval := Lock;
DeviceIoControl(hCDDevice, IOCTL_CDROM_MEDIA_REMOVAL, @pmrLockCDROM,
SizeOf(PREVENT_MEDIA_REMOVAL), nil, 0, lpBytesReturned, nil);
CloseHandle(hCDDevice);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LockCD('E', True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
LockCD('E', False);
end;
// Вариация "на тему" 1
procedure CD_Lock( DriveLetter: string; Locked: Boolean );
const
IOCTL_STORAGE_MEDIA_REMOVAL = $002D4804;
var
hDrive: THandle;
Returned: DWORD;
begin
hDrive := CreateFile( PChar( '\\.\' + DriveLetter ), GENERIC_READ,
FILE_SHARE_READ, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0 );
if GetLastError <> 0 then
MessageDlg( 'Ошибка: ' + IntToStr( GetLastError ), mtError, [mbOK], 0 );
try
if not DeviceIoControl( hDrive, IOCTL_STORAGE_MEDIA_REMOVAL,
@Locked, SizeOf( Locked ), nil, 0, Returned, nil ) then
MessageDlg( 'Ошибка: ' + IntToStr( GetLastError ), mtError, [mbOK], 0 );
finally
CloseHandle( hDrive );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Заблокировать
CD_Lock( 'f:', True );
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// Разблокировать
CD_Lock( 'f:', False );
end;
// Вариация "на тему" 2
function LockMedia(ADriveLetter: Char; ALock: Boolean): Boolean;
var
LWStatus: Hwnd;
LTemp: Cardinal;
LPMR32: Boolean;
const
IOCTL_STORAGE_MEDIA_REMOVAL = $2D4804;
begin
LwStatus := CreateFile( PChar( '\\.\' + ADriveLetter + ':' ), GENERIC_READ or
GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0 );
LPMR32 := ALock;
if LwStatus <> INVALID_HANDLE_VALUE then
begin
Result := DeviceIoControl( LwStatus, IOCTL_STORAGE_MEDIA_REMOVAL, @LPMR32, sizeof( LPMR32 ), nil, 0, LTemp, nil );
CloseHandle( LwStatus );
end
else
Result := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Заблокировать
LockMedia( 'm', True );
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// Разблокировать
LockMedia( 'm', False );
end;
|
Как проверить состояние лотка CDRom (открыт/закрыт)?
// Способ первый
type
USHORT = Word;
PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;
_SCSI_PASS_THROUGH_DIRECT = {packed} record
Length: USHORT;
ScsiStatus: UCHAR;
PathId: UCHAR;
TargetId: UCHAR;
Lun: UCHAR;
CdbLength: UCHAR;
SenseInfoLength: UCHAR;
DataIn: UCHAR;
DataTransferLength: ULONG;
TimeOutValue: ULONG;
DataBuffer: ULONG;
SenseInfoOffset: ULONG;
Cdb: array [0..15] of UCHAR;
end;
SCSI_PASS_THROUGH_DIRECT = _SCSI_PASS_THROUGH_DIRECT;
TSCSIPassThroughDirectBuffer = record
Header: SCSI_PASS_THROUGH_DIRECT;
SenseBuffer: array [0..31] of UCHAR;
DataBuffer: array [0..191] of UCHAR;
end;
const
IOCTL_SCSI_BASE = FILE_DEVICE_CONTROLLER;
IOCTL_SCSI_PASS_THROUGH = (IOCTL_SCSI_BASE shl 16) or
((FILE_WRITE_ACCESS or FILE_READ_ACCESS) shl 14) or
($0401 shl 2) or METHOD_BUFFERED;
SCSI_IOCTL_DATA_IN = 1;
SCSIOP_MECHANISM_STATUS = $BD;
function IsCDOpen(const Drive: Char): Boolean;
var
PassTrought: TSCSIPassThroughDirectBuffer;
dwQueryLen, dwBytesReturned: DWORD;
hCDHandle: THandle;
begin
Result := False;
// Подготавливаем буффер запроса
ZeroMemory(@PassTrought, SizeOf(TSCSIPassThroughDirectBuffer));
PassTrought.Header.Length := SizeOf(SCSI_PASS_THROUGH_DIRECT);
// Размер команды в байтах
PassTrought.Header.CdbLength := 12;
// Тип обмена данных
PassTrought.Header.DataIn := SCSI_IOCTL_DATA_IN;
// Размер буффера данных
PassTrought.Header.DataTransferLength := SizeOf(PassTrought.DataBuffer);
// Время ожидания ответа
PassTrought.Header.TimeOutValue := 10;
// Оффсет на начало буффера данных
PassTrought.Header.DataBuffer :=
DWORD(@PassTrought.DataBuffer) - DWORD(@PassTrought);
// Заполняем Command Descriptor Block
// Код команды
PassTrought.Header.Cdb[0] := SCSIOP_MECHANISM_STATUS;
// Размер ожидаемого ответа
PassTrought.Header.Cdb[8] := 8;
// общий размер запроса
dwQueryLen := PassTrought.Header.DataBuffer + PassTrought.Header.DataTransferLength;
// Открываем устройство
hCDHandle := CreateFile(PChar(Format('\\.\%s:', [Drive])),
GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if hCDHandle <> INVALID_HANDLE_VALUE then
try
// Отправка запроса
if DeviceIoControl(hCDHandle, IOCTL_SCSI_PASS_THROUGH, @PassTrought,
dwQueryLen, @PassTrought, dwQueryLen, dwBytesReturned, nil) then
// при успешном ответе 12-ый бит буффера будет содержать состояние лотка
// 1 - открыт, 0 - закрыт
Result := PassTrought.DataBuffer[1] and $10 = $10;
finally
CloseHandle(hCDHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Drive: Char = 'E';
begin
if IsCDOpen(Drive) then
ShowMessage('Лоток устройства ' + Drive + ': открыт.')
else
ShowMessage('Лоток устройства ' + Drive + ': закрыт.');
end;
// Способ второй
function IsCDDoorOpen(CDDrive:string):boolean;
type
_SCSI_PASS_THROUGH_DIRECT = record
Length: USHORT;
ScsiStatus: UCHAR;
PathId: UCHAR;
TargetId: UCHAR;
Lun: UCHAR;
CdbLength: UCHAR;
SenseInfoLength: UCHAR;
DataIn: UCHAR;
DataTransferLength: ULONG;
TimeOutValue: ULONG;
DataBuffer: PUCHAR;
SenseInfoOffset: ULONG;
Cdb: array[0..15] of UCHAR;
end;
SCSI_PASS_THROUGH_DIRECT = _SCSI_PASS_THROUGH_DIRECT;
PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;
const
FILE_DEVICE_CONTROLLER = $00000004;
IOCTL_SCSI_BASE = FILE_DEVICE_CONTROLLER;
FILE_READ_ACCESS = $0001;
FILE_WRITE_ACCESS = $0002;
METHOD_BUFFERED = 0;
IOCTL_SCSI_PASS_THROUGH_DIRECT = (IOCTL_SCSI_BASE shl 16) or
((FILE_READ_ACCESS or FILE_WRITE_ACCESS) shl 14)
or ($0405 shl 2) or METHOD_BUFFERED;
var
hCD: THandle;
srb: SCSI_PASS_THROUGH_DIRECT;
returned:DWORD;
buf: PUCHAR;
state: UCHAR;
c: string;
begin
Result := False;
if Length(CDDrive) = 1 then
c := ':'
else
c := '';
// открываем устройство
hCD := CreateFile(PChar('\\.\' + CDDrive + c), GENERIC_WRITE or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hCD = INVALID_HANDLE_VALUE then
Exit;
try
buf := HeapAlloc(GetProcessHeap,HEAP_ZERO_MEMORY,8); // выделяем буфер
if buf <> nil then
try
ZeroMemory(@srb, SizeOf(srb));
srb.Length := SizeOf(srb);
srb.CdbLength := 12; // длина CDB пакета
srb.DataTransferLength := 8; // сколько мы будем читать
srb.TimeOutValue := 200; // время выхода по TimeOut
srb.DataBuffer := buf; // указатель на буфер
srb.DataIn := 1;
srb.Cdb[0] := $0bd; // mechanism status
srb.Cdb[8] := 0; // старш байт длины буфера
srb.Cdb[9] := 8; // мл. байт длины буфера
// запрашиваем информацию
if not DeviceIoControl(hCD, IOCTL_SCSI_PASS_THROUGH_DIRECT,
@srb, sizeof(srb), nil, 0, returned, nil) then
Exit;
// При некоторых обстоятельствах привод может возвращать больше данных
// чем их было запрошено
// В полученном буфере информацию несут только первые 2 байта:
// Первый байт: биты 5 и 6 - состояние механизма,где 0 - механ готов...
// Второй байт: бит 4 - сост дверцы, чего нам и надо.
// Биты 5, 6, 7 - состояние устройства. где 0 - сост ожидания
// хотя они документированы, но в некоторых приводах почему-то не используются
Inc(buf); // смотрим второй байт
state := buf^;
Dec(buf); // для корректного освобождения буфера
finally
HeapFree(GetProcessHeap, 0, buf) // освобождаем буфер
end;
finally
CloseHandle(hCD); // и закрываем дескриптор
end;
// тут анализируем нужный нам бит
case (state and $10) of
$10: Result := True; // дисковод открыт
$0: begin
SetLastError(ERROR_SUCCESS); // говорим вызывающей проге, что
// False возвратилось не в результате ошибки
Result := False; // дисковод закрыт. эту строчку можно убрать,
// тут она просто для наглядности
end;
end;
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
