用DELPHI写的播放器核心代码，播放MP3无压力

主窗口代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, tcMMControl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
     play : TTcPlayer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    play := TTcPlayer.Create('demoplayer');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    play.stop;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    play.PlayFile('D:\MP3\getup\成龙-感受.mp3');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    play.stop;
end;

end.

单元文件：tcMMSystem.pas

unit tcMMSystem;

interface

uses MMSystem, SysUtils;

const
  bufflen = 512;

var
  mciCmd : WideString;
  mciId : WideString;
  mciResult : array[0..bufflen] of WideChar;
  mciLength : Integer;    // 媒体时间长度
  mciString : WideString;

// 执行多媒体命令
function doCmd : Integer;  
// 播放文件
function MciOpenFile(alias:WideString;fn:WideString):Boolean;
// 取得长度
function MciGetLength(alias:WideString):Integer;
// 播放
procedure mciplay(alias:WideString);
// 停止
procedure mcistop(alias:WideString);
// 暂停
procedure mcipause(alias:WideString);
// 关闭
procedure mciclose(alias:WideString);
// 取当前播放位置
function mciGetPosition(alias:WideString) : Integer;
// 设置播放位置
procedure mciSetPosition(alias:WideString; position: Integer);
// 取得音量
function mciGetVolume(alias:WideString): Integer;
// 设置音量
procedure mciSetVolume(alias:WideString; vol: Integer);
// 设置声道
procedure mciSetStereo(alias:WideString; source:WideString);

implementation

// 执行多媒体命令
function doCmd : Integer;
begin
  Result := mciSendStringW(PWideChar(mciCmd), mciresult, bufflen, 0);
  mciString := mciResult;
end;

// 播放文件
function MciOpenFile(alias:WideString;fn:WideString):Boolean;
begin
  mciclose(alias);

  mciCmd := 'open "' + fn + '" alias ' + alias;
  result := doCmd = 0;

  mciCmd := 'set '+ alias +' time format milliseconds';
  doCmd ;
end;

// 播放文件
//function PlayFileSid(sid:Integer):Boolean;
//var
//  snd : tcSound;
//begin
//  snd := GetSoundById(sid);
//  result := playFile(snd.path);
//  snd.Free;
//end;

// 取得长度
function MciGetLength(alias:WideString):Integer;
var
  s : WideString;
begin
  mciCmd := 'status '+ alias +' length';
  doCmd;          
  s := mciResult;
  result := StrToIntDef(s,0);
end;

// 播放
procedure mciPlay(alias:WideString);
begin
  mciCmd := 'play ' + alias;
  doCmd;
end;

// 停止
procedure mciStop(alias:WideString);
begin
  mciCmd := 'stop ' + alias;
  doCmd;
end;

// 暂停
procedure mciPause(alias:WideString);
begin
  mciCmd := 'pause ' + alias;
  doCmd;
end;

// 关闭
procedure mciClose(alias:WideString);
begin
  mciCmd := 'close ' + alias;
  doCmd;
end;

// 取当前播放位置
function mciGetPosition(alias:WideString) : Integer;
var
  s : WideString;
begin
  mciCmd := 'status ' + alias + ' position';
  doCmd;
  s := mciResult;
  result := StrToIntDef(s,0);
end;

// 取得音量
function mciGetVolume(alias:WideString): Integer;
begin
  mciCmd := 'status ' + alias + ' volume';
  doCmd;
  result := StrToIntDef(mciString, 0);
end;

// 设置音量
procedure mciSetVolume(alias:WideString; vol: Integer);
begin
  mciCmd := 'setaudio ' + alias + ' Volume to ' + inttostr(vol);
  doCmd;
end;

// 设置播放位置
procedure mciSetPosition(alias:WideString; position: Integer);
begin
  mciCmd := 'seek ' + alias + ' to ' + inttostr(position);
  doCmd;  
end;

// 设置声道
procedure mciSetStereo(alias:WideString; source:WideString);
begin
  mciCmd := 'Setaudio source to ' + Source;
  doCmd;
end;

end.

单元文件：tcMMControl.pas

unit tcMMControl;

interface

uses tcMMSystem, SysUtils;

const
  bufflen = 512;

type TTcPlayer = class(TObject)
  private
    fn : WideString;
    alias : WideString;
    fopened : Boolean;
    fplaying : Boolean;
    fpaused : Boolean;
  public
    constructor Create(alias:WideString);
    function SetFile(filename:WideString):Boolean;
    function PlayFile(filename:WideString):Boolean;
    procedure play;
    procedure stop;
    procedure close;
    procedure pause;
    procedure SetVolume(volume:Integer);
    function GetVolume:Integer;
    procedure SetPosition(Position:Integer);
    function GetPosition:Integer;
    function GetLength: Integer;
    procedure SetStereo(source: Integer);
  published

  property playing : Boolean read fplaying;
  property opened : Boolean read fopened;
  property paused : Boolean read fpaused;
end;

implementation

constructor TTcPlayer.Create(alias:WideString);
begin
  self.alias := alias;
  fopened := False;
  fplaying := False;

end;

procedure TTcPlayer.stop;
begin
  mcistop(alias);
  fplaying := False;
end;

procedure TTcPlayer.close;
begin
  if fplaying then
    stop;

  mciclose(alias);
  fopened := False;
  fplaying := False;
end; 

procedure TTcPlayer.pause;
begin
  if playing then
  begin
    if fpaused then
      play
    else
    begin
      mcipause(alias);
      fpaused := true;
    end;
  end;
end;

function TTcPlayer.GetVolume:Integer;
begin
  result := mciGetVolume(alias);
end;
procedure TTcPlayer.play;
begin
  if fopened then
  begin
    mciplay(alias);
    fplaying := True;
    fpaused := False;
  end;
end;


procedure TTcPlayer.SetVolume(volume:Integer);  
begin
  mciSetVolume(alias, volume);
end;

procedure TTcPlayer.SetPosition(Position:Integer);
begin
  mciSetPosition(alias, Position);
  if fplaying and not fpaused then
    play
end;

function TTcPlayer.GetPosition:Integer;
begin
  result := mciGetPosition(alias);
end;

function TTcPlayer.GetLength: Integer;
begin
  result := MciGetLength(alias);
end;

procedure TTcPlayer.SetStereo(source: Integer);
var
  src : WideString;
begin
  case source of
  0: src := 'stereo';
  1: src := 'left';
  2: src := 'right';
  else src := 'average';
  end;
  mciSetStereo(alias,src);
end;


function  TTcPlayer.SetFile(filename:WideString):Boolean;
begin
  if fopened then
    close;
  fopened := MciOpenFile(alias, filename);
  Result := fopened;
  if fopened then
    fn := filename;
end;

function  TTcPlayer.PlayFile(filename:WideString):Boolean;
begin
  result := SetFile(filename);
  play;
end;

end.