Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

Delphi , Файловая система , CD-ROM

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

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;
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.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: CD-ROM ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
13.08.2020 22:40:08/0.044976234436035/2