線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:1116
推到 Plurk!
推到 Facebook!

如何掀取CD上的音軌

尚未結案
CHIWW
初階會員


發表:8
回覆:16
積分:29
註冊:2002-09-15

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-08-04 17:29:01 IP:61.227.xxx.xxx 未訂閱
請問用程式如何去實現抓取CD上的音軌呢 謝謝
hagar
版主


發表:143
回覆:4056
積分:4445
註冊:2002-04-14

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-08-04 18:04:40 IP:202.39.xxx.xxx 未訂閱
http://www.lmc-mediaagentur.de/dpool/tips/0486.htm Answer 1: This gets the audio tracks from an Audio CD and puts them in a TMemo:
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.
Tip by Guido Geurts Answer 2: To get the number of tracks and the length of the current track that is playing, use this code :
uses
  mmsystem;    procedure GetInfo(mp: TMediaPlayer);
var
  Trk, Min, Sec: word;
begin
  with mp do
  begin
    Trk :=MCI_TMSF_TRACK(Position);
    Min :=MCI_TMSF_MINUTE(Position);
    Sec := MCI_TMSF_SECOND(Position);
  end;
  label1.caption := Format('%.2d/%.2d %.2d:%.2d', [Trk, mp.tracks, min, sec]);
end;    And if you would like to check for an audio CD, try this code:    function 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
    exit;
  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;
Tip by Marcus Padovani --- --<-<-<@
CHIWW
初階會員


發表:8
回覆:16
積分:29
註冊:2002-09-15

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-08-04 23:12:11 IP:61.227.xxx.xxx 未訂閱
謝謝hagar的提供的資料 但我要如何把CD音軌資料抓取下來,儲存檔案呢 ?
系統時間:2024-05-09 6:10:31
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!