CD-ROM/CD-R/CD-RW

CD Remember

2017-09-30T04:36:05+07:00

Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?

Подробнее...

How to check, if a CD-Recorder is available?

2017-09-30T04:38:38+07:00

Code:

{....}

uses Registry;

{....}

function HasCDRecorder: Boolean;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

// set the the Mainkey,

reg.RootKey := HKEY_CURRENT_USER;

// Open a key

reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\CD Burning', False);

// Check if the Key exists

Result := reg.ValueExists('CD Recorder Drive');

// Close the key

reg.CloseKey;

finally

// and free the TRegistry Object

reg.Free;

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

if HasCDRecorder then

ShowMessage('CD-Recorder available.')

else

ShowMessage('CD-Recorder NOT available.');

end;

Активизация или отключение автоматического проигрывания CD

2017-09-30T04:45:08+07:00

Code:

uses

Registry;

procedure CDSetAutoPlay(SioNo: Boolean);

var

Reg: TRegistry;

begin

try

Reg := TRegistry.Create;

Reg.RootKey := HKEY_LOCAL_MACHINE;

if Reg.KeyExists('Software\Classes\AudioCD\') then

if Reg.OpenKey('Software\Classes\AudioCD\Shell\', False) then

if SioNo then Reg.WriteString('', 'play')

else

Reg.WriteString('', '');

finally

Reg.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

{Activate AutoPlay}

CDSetAutoPlay(True);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

{Deactivate Autoplay}

CDSetAutoPlay(False);

end;

Блокировка/Разблокировка CD-ROM

2017-09-30T04:16:06+07:00

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

Исходный код

Подробнее...

Есть ли CD-ROM?

2017-09-30T04:17:15+07:00

Code:

GetLogicalDrives()

GetDriveType()

Изменение скорости привода CD-ROM

2017-09-30T04:44:18+07:00

Находим в интернете файл ASPI.pas (еще есть wnaspi32.pas), подключаем его к проекту, пишем следующий код:

Подробнее...

Как выдвинуть дверцу CD-ROM?

2017-09-30T04:26:16+07:00

Code:

mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);

mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

Подробнее...

Как загрузить иконку CD-ROM?

2017-09-30T04:29:53+07:00

Code:

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;

Как открыть CD-ROM, если их несколько в системе?

2017-09-30T04:29:02+07:00

DriveTools 1.0 Jan Peter Stotz If you find bugs, has ideas for missing featurs, feel free to contact me jpstotz@gmx.de

Подробнее...

Как получить информацию о дорожке аудио-CD?

2017-09-30T04:34:50+07:00

Code:

unit frmMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, MMSystem;

type

TForm1 = class(TForm)

Memo1: TMemo;

Button2: TButton;

Button3: TButton;

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

function IsAudioCD(Drive: char): bool;

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.IsAudioCD(Drive: char): bool;

var

DrivePath: string;

MaximumComponentLength: DWORD;

FileSystemFlags: DWORD;

VolumeName: string;

begin

Result := false;

DrivePath := Drive + ':\';

if GetDriveType(PChar(DrivePath)) = DRIVE_CDROM then

begin

SetLength(VolumeName, 64);

GetVolumeInformation(PChar(DrivePath), PChar(VolumeName), Length(VolumeName), nil,

MaximumComponentLength, FileSystemFlags, nil, 0);

if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then

Result := True;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if IsAudioCD(' D ') then

showmessage('Cd is an audio cd')

else

showmessage('Cd is not an audio cd');

end;

procedure TForm1.Button3Click(Sender: TObject);

type

TDWord = record

High: Word;

Low: Word;

end;

var

msp: TMCI_INFO_PARMS;

MediaString: array[0..255] of char;

ret: longint;

I: integer;

StatusParms: TMCI_STATUS_PARMS;

MciSetParms: TMCI_SET_PARMS;

MciOpenParms: TMCI_OPEN_PARMS;

aDeviceID: MCIDEVICEID;

function GetTheDeviceID: MCIDEVICEID;

begin

FillChar(MciOpenParms, SizeOf(MciOpenParms), #0);

try

MciOpenParms.lpstrDeviceType := 'cdaudio';

ret := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE + MCI_OPEN_SHAREABLE,

LongInt(@MciOpenParms));

Result := MciOpenParms.wDeviceID;

except

on E: Exception do

begin

Result := 0;

showmessage('error receiving deviceIDt' + #13 + SysErrorMessage(GetLastError)

+ #13 + E.Message);

end;

function GetTrackInfo(const uMsg: UInt; const fdwCommand: DWord;

const dwItem: DWord; const dwTrack: DWord): string;

begin

Result := 'Did not work...';

FillChar(MediaString, SizeOf(MediaString), #0);

FillChar(StatusParms, SizeOf(StatusParms), #0);

StatusParms.dwItem := dwItem;

StatusParms.dwTrack := dwTrack;

ret := mciSendCommand(aDeviceID, uMsg, fdwCommand, longint(@StatusParms));

if Ret = 0 then

Result := IntToStr(StatusParms.dwReturn);

end;

procedure SetTimeInfo;

begin

FillChar(MciSetParms, SizeOf(MciSetParms), #0);

MciSetParms.dwTimeFormat := MCI_FORMAT_MSF;

ret := mciSendCommand(aDeviceID {Mp.DeviceId}, MCI_SET, MCI_SET_TIME_FORMAT,

longint(@MciSetParms));

if Ret <> 0 then

Showmessage('Error convering timeformat...');

end;

begin

Memo1.Clear;

aDeviceID := GetTheDeviceID;

Application.ProcessMessages;

Memo1.Lines.Add('Track info :');

SetTimeInfo;

Memo1.Lines.Add('Tracks: ' + GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,

MCI_STATUS_NUMBER_OF_TRACKS, 0));

Memo1.Lines.Add(' ');

for I := 1 to StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,

MCI_STATUS_NUMBER_OF_TRACKS, 0)) do

begin

Memo1.Lines.Add('Track ' + IntToStr(I) + ' : ' + IntToStr(MCI_MSF_MINUTE

(StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM +

MCI_TRACK, MCI_STATUS_LENGTH, I)))) + ':' +

IntToStr(MCI_MSF_SECOND(StrToInt(GetTrackInfo(MCI_STATUS,

MCI_STATUS_ITEM + MCI_TRACK, MCI_STATUS_LENGTH, I)))));

end;

Application.ProcessMessages;

end;

end.

Подробнее...

Как различать звуковые CD

2017-09-30T04:37:25+07:00

лазерный диск имеет свой идентификатор. Если сохранить, какому диску соответствует какой идентификатор, то можно реализовать определение диска.

В этой программе при нажатии на кнопку происходит проверка, есть ли название этого диска в файле. Если есть, то в заголовок окна выводится его название, если нет, то введенное пользователем название диска сохраняется в файл.

Подробнее...

Как узнать букву CD-ROM?

2017-09-30T04:21:42+07:00

Code:

var DriveType: UInt;

DriveType := GetDriveType(PChar('F:\'));

if DriveType = DRIVE_CDROM then ShowMessage('Сидюк');

Подробнее...

Как узнать есть ли в заданном CD-ROM'е Audio CD?

2017-09-30T04:32:27+07:00

Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.

Пример:

Подробнее...

Как узнать количество CD в системе?

2017-09-30T04:48:11+07:00

Code:

function GetNumberOfCDDrives: Byte;

var

drivemap, mask: DWORD;

i: integer;

root: string;

begin

Result := 0;

root := 'A:\';

drivemap := GetLogicalDrives;

mask := 1;

for i := 1 to 32 do

begin

if (mask and drivemap) <> 0 then

if GetDriveType(PChar(root)) = DRIVE_CDROM then

begin

Inc(Result);

end;

mask := mask shl 1;

Inc(root[1]);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption := IntToStr(GetNumCDDrives);

end;

Как узнать производителя CD/DVD?

2017-09-30T04:43:20+07:00

Как это сделать через WMI я вроде разобрался.

Только не нравиться мне, что приходится перебирать в цикле все свойства

Win32_CDROMDrive. Может кто знает как сразу к конкретному свойству обратиться, т.е.

избавиться от строки "while PropEnum.Next(1, TempObj, Value) = S_OK do"

Вот рабочий пример для D7.

Подробнее...

Как узнать серийный номер аудио CD?

2017-09-30T04:31:26+07:00

CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку.

Пример:

Подробнее...

Обработать момент вставки и вытаскивания CD

2017-09-30T04:47:13+07:00

Некоторые приложения должны знать, когда пользователь вставляет или удаляет компакт-диска или DVD-диска с компакт-дисков без

опрос для медиа-изменений. Windows предоставляет способ уведомить об этом приложения через сообщение WM_DEVICECHANGE.

Подробнее...

Практически все о взломе CD

2017-09-30T04:42:08+07:00

Вступление

Наконец, я решился на написание этой статьи, идея пришла давно, но полностью систематизировать решился только сегодня. Сегодня мы не будем рассматривать конкретного взлома. На это есть две причины:

1) У меня начал глючить CD-ROM, пора менять

2) Статья получилась бы слишком длинной

В принципе вторая причина меня волнует мало, но первая встала доста- точно остро.

Подробнее...