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;
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;
end;
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? раздела Файловая система CD-ROM может быть полезна для разработчиков на Delphi и FreePascal.
