Author: Tomas Rutkauskas
How to get track information from an Audio CD
Answer:
Solve 1:
This gets the audio tracks from an Audio CD and puts them in a TMemo:
1 unit frmMain;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, MMSystem;
8
9 type
10 TForm1 = class(TForm)
11 Memo1: TMemo;
12 Button2: TButton;
13 Button3: TButton;
14 procedure Button2Click(Sender: TObject);
15 procedure Button3Click(Sender: TObject);
16 private
17 function IsAudioCD(Drive: char): bool;
18 public
19 end;
20
21 var
22 Form1: TForm1;
23
24 implementation
25
26 {$R *.DFM}
27
28 function TForm1.IsAudioCD(Drive: char): bool;
29 var
30 DrivePath: string;
31 MaximumComponentLength: DWORD;
32 FileSystemFlags: DWORD;
33 VolumeName: string;
34 begin
35 Result := false;
36 DrivePath := Drive + ':\';
37 if GetDriveType(PChar(DrivePath)) = DRIVE_CDROM then
38 begin
39 SetLength(VolumeName, 64);
40 GetVolumeInformation(PChar(DrivePath), PChar(VolumeName), Length(VolumeName),
41 nil,
42 MaximumComponentLength, FileSystemFlags, nil, 0);
43 if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then
44 Result := True;
45 end;
46 end;
47
48 procedure TForm1.Button2Click(Sender: TObject);
49 begin
50 if IsAudioCD(' D ') then
51 showmessage('Cd is an audio cd')
52 else
53 showmessage('Cd is not an audio cd');
54 end;
55
56 procedure TForm1.Button3Click(Sender: TObject);
57 type
58 TDWord = record
59 High: Word;
60 Low: Word;
61 end;
62 var
63 msp: TMCI_INFO_PARMS;
64 MediaString: array[0..255] of char;
65 ret: longint;
66 I: integer;
67 StatusParms: TMCI_STATUS_PARMS;
68 MciSetParms: TMCI_SET_PARMS;
69 MciOpenParms: TMCI_OPEN_PARMS;
70 aDeviceID: MCIDEVICEID;
71
72 function GetTheDeviceID: MCIDEVICEID;
73 begin
74 FillChar(MciOpenParms, SizeOf(MciOpenParms), #0);
75 try
76 MciOpenParms.lpstrDeviceType := 'cdaudio';
77 ret := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE + MCI_OPEN_SHAREABLE,
78 LongInt(@MciOpenParms));
79 Result := MciOpenParms.wDeviceID;
80 except
81 on E: Exception do
82 begin
83 Result := 0;
84 showmessage('error receiving deviceIDt' + #13 +
85 SysErrorMessage(GetLastError)
86 + #13 + E.message);
87 end;
88 end;
89 end;
90
91 function GetTrackInfo(const uMsg: UInt; const fdwCommand: DWord;
92 const dwItem: DWord; const dwTrack: DWord): string;
93 begin
94 Result := 'Did not work...';
95 FillChar(MediaString, SizeOf(MediaString), #0);
96 FillChar(StatusParms, SizeOf(StatusParms), #0);
97 StatusParms.dwItem := dwItem;
98 StatusParms.dwTrack := dwTrack;
99 ret := mciSendCommand(aDeviceID, uMsg, fdwCommand, longint(@StatusParms));
100 if Ret = 0 then
101 Result := IntToStr(StatusParms.dwReturn);
102 end;
103
104 procedure SetTimeInfo;
105 begin
106 FillChar(MciSetParms, SizeOf(MciSetParms), #0);
107 MciSetParms.dwTimeFormat := MCI_FORMAT_MSF;
108 ret := mciSendCommand(aDeviceID {Mp.DeviceId}, MCI_SET, MCI_SET_TIME_FORMAT,
109 longint(@MciSetParms));
110 if Ret <> 0 then
111 Showmessage('Error convering timeformat...');
112 end;
113
114 begin
115 Memo1.Clear;
116 aDeviceID := GetTheDeviceID;
117 Application.ProcessMessages;
118 Memo1.Lines.Add('Track info :');
119 SetTimeInfo;
120 Memo1.Lines.Add('Tracks: ' + GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,
121 MCI_STATUS_NUMBER_OF_TRACKS, 0));
122 Memo1.Lines.Add(' ');
123 for I := 1 to StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,
124 MCI_STATUS_NUMBER_OF_TRACKS, 0)) do
125 begin
126 Memo1.Lines.Add('Track ' + IntToStr(I) + ' : ' + IntToStr(MCI_MSF_MINUTE
127 (StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM +
128 MCI_TRACK, MCI_STATUS_LENGTH, I)))) + ':' +
129 IntToStr(MCI_MSF_SECOND(StrToInt(GetTrackInfo(MCI_STATUS,
130 MCI_STATUS_ITEM + MCI_TRACK, MCI_STATUS_LENGTH, I)))));
131 end;
132 Application.ProcessMessages;
133 end;
134
135 end.
Solve 2:
To get the number of tracks and the length of the current track that is playing,
use this code :
136 uses
137 mmsystem;
138
139 procedure GetInfo(mp: TMediaPlayer);
140 var
141 Trk, Min, Sec: word;
142 begin
143 with mp do
144 begin
145 Trk := MCI_TMSF_TRACK(Position);
146 Min := MCI_TMSF_MINUTE(Position);
147 Sec := MCI_TMSF_SECOND(Position);
148 end;
149 label1.caption := Format('%.2d/%.2d %.2d:%.2d', [Trk, mp.tracks, min, sec]);
150 end;
151
152
153 //And if you would like to check for an audio CD, try this code:
154
155
156 function IsAudioCD(Drive: char): bool;
157 var
158 DrivePath: string;
159 MaximumComponentLength: DWORD;
160 FileSystemFlags: DWORD;
161 VolumeName: string;
162 begin
163 Result := false;
164 DrivePath := Drive + ':\';
165 if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then
166 exit;
167 SetLength(VolumeName, 64);
168 GetVolumeInformation(PChar(DrivePath), PChar(VolumeName), Length(VolumeName), nil,
169 MaximumComponentLength, FileSystemFlags, nil, 0);
170 if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then
171 result := true;
172 end;
|