{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Baa

WEB-сайт: http://forum.vingrad.ru

Вы уж простите, что на сях… сподручней было:\

//заблокировать

void CMFcDlg::OnBnClickedButton1()

{

HANDLE hDevice = CreateFile («\\\\.\\E:»,

GENERIC_READ,

FILE_SHARE_READ | FILE_SHARE_WRITE,

NULL,

OPEN_EXISTING,

NULL,

NULL);

DWORD dwBytesReturned = 0;

PREVENT_MEDIA_REMOVAL pmr = {TRUE};

if (!DeviceIoControl (hDevice, IOCTL_STORAGE_MEDIA_REMOVAL,

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: ReLock

Я сам долго искал, как блокировать/разблокировать CD-ROM на Delphi. Поэтому не претендую на авторство этой статьи. Просто собрал все, так сказать, в кучу. Проверено на D7.

procedure TMainForm.CD_Lock (Locked: Boolean, DriveLetter: string);

const

IOCTL_STORAGE_MEDIA_REMOVAL = $002D4804;

var

hDrive: THandle;

Returned: DWORD;

DisableEject: boolean;

begin

hDrive:= CreateFile (PChar ('\\.\' DriveLetter), GENERIC_READ,

FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,

0);

if GetLastError 0 then

MessageDlg ('Error:' IntToStr (GetLastError), mtError, [mbOK], 0);

try

DisableEject:= Locked;

if not DeviceIoControl (hDrive,

IOCTL_STORAGE_MEDIA_REMOVAL, // PREVENT_MEDIA_REMOVAL,

@DisableEject,

SizeOf (DisableEject),

nil,

0,

Returned,

nil) then

MessageDlg ('Ошибка:' IntToStr (GetLastError), mtError, [mbOK], 0)

finally

CloseHandle (hDrive)

end;

end;

CD_Lock (True) — блокирует CD-ROM

CD_Lock (False) — разблокирует CD-ROM

Для полного веселья можно заблокировать все CD-ROMы в системе через это:

procedure TMainForm.LockCDROMs;

var

w: dword;

Root: string;

i: byte;

begin

w:= GetLogicalDrives;

Root:= '#:\';

for i:= 0 to 25 do

begin

Root[1]:= Char (Ord ('A') i);

if (W and (1 shl i)) > 0 then

if GetDriveType (PChar (Root)) = DRIVE_CDROM then

begin

DriveLetter:= Copy (Root, 1, Length (Root) — 1);

CD_Lock (True, DriveLetter)

end

end;

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

procedure TForm1.SetCDAutoRun (AAutoRun: Boolean);

const

DoAutoRun: array[Boolean] of Integer = (0, 1);

var

Reg: TRegistry;

begin

try

Reg:= TRegistry.Create;

Reg.RootKey:= HKEY_LOCAL_MACHINE;

if Reg.KeyExists ('System\CurrentControlSet\Services\Class\CDROM') then

begin

if Reg.OpenKey ('System\CurrentControlSet\Services\Class\CDROM', False) then

Reg.WriteBinaryData ('AutoRun', DoAutoRun[AAutoRun], 1);

end

finally

Reg.Free;

end;

ShowMessage ('Your settings will take effect on the next reboot of Windows.');

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: http://www.swissdelphicenter.ch

function GetCDIcon (Drive: Char): TIcon;

var

ico: TIcon;

ini: TIniFile;

s, p: string;

i, j: Integer;

begin

//Abbrechen wenn «AutoRun.Inf» nicht existiert.

//Abort if «AutoRun.inf» doesn't exists.

if FileExists (Drive ':\autorun.inf') = False then

Exit;

//"AutoRun.inf" offnen

//Opens the «AutoRun.inf»

ini:= TIniFile.Create (Drive ':\autorun.inf');

ico:= TIcon.Create;

try

//Dateinamen lesen

//Read the filename

s:= ini.ReadString ('Autorun', 'ICON', '');

//Abbrechen, wenn kein Icon festgelegt wurde

//Abort if there is no icon specified

if s = '' then

Exit;

//Icon von Datei laden

//load the icon from a file

if FileExists (s) then

ico.LoadFromFile (s);

if FileExists (Drive ':\' s) then

ico.LoadFromFile (Drive ':\' s);

//Icon aus einer Resource laden

//Load the icon from a Win32 resource

if (FileExists (s) = False) and (FileExists (Drive ':\' s) = False) then

begin

for j:= (Pos (',', s) 1) to Length (s) do

begin

p:= p s[j];

end;

i:= StrToInt (p);

for j:= Length (s) downto (Pos (',', s)) do

Delete (s, j, Length (s));

if FileExists (s) = False then

s:= Drive ':\' s;

ico.Handle:= ExtractIcon (hinstance, PChar (s), i);

end;

Result:= ico;

finally

ini.Free;

end;

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: http://forum.vingrad.ru

К сожалению, реальных примеров пока не найдено, а литература в сети крайне скудна по этому поводу. Вот список линков по которым удалось хоть что-то найти:

1) на torry есть компонент

http://www.torry.net/vcl/filedrv/cd/xpburn.zip (только для WindowsXP)

2)http://www.rsdn.ru/forum/Message.aspx?mid=81732