mpegplay.pas

mp3 播放器 delphi 源码

unit MPEGPlay;

interface

uses
  Windows, Messages, SysUtils, Classes, ExtCtrls;

type ErrString = array[0..5] of string[50];

const plmOpened  = 0;
      plmReady   = 1;
      plmStopped = 2;
      plmPlaying = 3;
      plmPaused  = 4;

const  ErrStr : ErrString = ('MPEG library not loaded',
                             'Internal decoder error',
                             'Incorrect mode',
                             'Input stream error',
                             'Input stream is non-seekable',
                             'Output device failure');

type TMPEGError = class (Exception)
                  public
                    ErrCode : byte;
                    Constructor CreateErr(Mess:string; Err:byte);
                  end;

type TMPEGPlayer = class;

     MPInitProc = function:integer; stdcall;
     MPCMProc   = function:boolean; stdcall;
     MPOFNProc  = function (mode:integer; value:pchar):boolean; stdcall;
     MPSVProc   = function (value:integer):boolean; stdcall;
     MPPProc    = function (sp, ep :integer; v:pointer):integer; stdcall;
     MPDProc    = function (value:boolean):boolean; stdcall;
     MPFProc    = function:single; stdcall;
     CBCSProc   = procedure (obj:TMPegPlayer; var cant_seek:boolean; var res:pointer); stdcall;
     CBClSProc  = (*ResCloseStream*)procedure (obj:TMPegPlayer; handle :pointer); stdcall;
     CBRSSProc  = (*ResRestartStream*)procedure (obj:TMPegPlayer; handle :pointer; var res:boolean); stdcall;
     CBRSProc   = (*ResReadStream*) procedure(obj:TMPegPlayer; handle:pointer;
                                        var read_buffer;
                                        nNumberOfBytesToRead:longInt;
                                        var nNumberOfBytesRead:longInt;var res:boolean); stdcall;
     CBRSPProc  = (*ResSetPointer*)procedure(obj:TMPegPlayer; handle:pointer;
                                            NumBytes,MoveMethod:LongInt;var res:LongInt); stdcall;
     CBGSProc   = (*ResGetSize*) procedure (obj:TMPegPlayer; handle:pointer; var res:longint); stdcall;
     MPSISProc  = function (value:pchar;
                            from_res:boolean;
                            CBCS:CBCSProc;
                            CBClS:CBClSProc;
                            CBRSS:CBRSSProc;
                            CBRS:CBRSProc;
                            CBRSP:CBRSPProc;
                            CBGS:CBGSProc;opps:pointer):boolean; stdcall;

  TPlayPriority = (Idle,Lowest,BelowNormal,Normal,AboveNormal, Highest, TimeCritical);
  TOutputDevice = (wavemapper, pcmfile);

     TOpenStreamEvent = procedure (var Nonseekable:boolean; var Context:pointer) of object;
     // Event must return context, that will be passes to other stream-handling
     // functions
     // if the event fails, it returns nil
     TCloseStreamEvent = procedure (Context:pointer) of object;
     TRestartStreamEvent = procedure (Context:pointer; var res:boolean) of object;
     TReadStreamEvent = procedure (Context:pointer;var read_buffer;
                                   nNumberOfBytesToRead:LongInt;
                                   var nNumberOfBytesRead:LongInt; var res:boolean) of object;
     TSeekStreamEvent = procedure (Context:pointer; numbytes:LongInt;MoveMethod:LongInt; var res:LongInt) of object;
     // MoveMethod can be next:
     // FILE_BEGIN = 0;
     // FILE_CURRENT = 1;
     // FILE_END = 2;
     TGetStreamSizeEvent = procedure (Context:pointer; var res: longint) of object;
     TPosUpdateEvent = procedure (Pos,Len:longint) of object;

  TMPEGPlayer = class(TComponent)
  private
    DLLHandle    : THandle;
    FDLLPath     : string;
    FStreamName  : String;
    FOutFilename : string;
    FOutputDevice: integer;
    FStartPos    : integer;
    FEndPos      : integer;
    FOpened      : boolean;
    FPlayStarted : boolean;
    FPaused      : boolean;
    FPlayStopped : boolean;
    FAutoPlay    : boolean;
    FPriority    : integer;
    FSeekable    : boolean;
    FResource    : boolean;
    FUseTimer    : boolean;
    FTimerFreq   : integer;
    FPlayCount   : integer;
    PosUpdateTimer : TTimer;
    FOnPosUpdate : TPosUpdateEvent;
    FOnPlayEnd   : TNotifyEvent;
    FOpenEvent   : TOpenStreamEvent;
    FCloseEvent  : TCloseStreamEvent;
    FRestartEvent: TRestartStreamEvent;
    FGetSizeEvent: TGetStreamSizeEvent;
    FSeekEvent   : TSeekStreamEvent;
    FReadEvent   : TReadStreamEvent;
    FStreamLength : longint;

    {Dll Prodecures}
    DllInit            : MPCMProc;
    DllDeInit          : MPInitProc;
    DllOpen            : MPSISProc;
    DllPause           : MPDProc;
    DllStop            : MPCMProc;
    DllPlay            : MPPProc;
    DLLRestart         : MPCMProc;
    DllSetPriority     : MPSVProc;
    DllSetOutputDevice : MPOFNProc;
    DllClose           : MPCMProc;
    DllGetFrequency    : MPInitProc;
    DllGetBitRate      : MPInitProc;
    DllGetLayer        : MPInitProc;
    DllGetPlayerMode   : MPInitProc;
    DllGetCurrentPos   : MPInitProc;
    DllGetLength       : MPInitProc;
    DllResetPlayerMode : MPCMProc;
    DllSeek            : MPSVProc;
    DLLLastError       : MPInitProc;

    LE:integer;
    function LastError:integer;
    function GetLoaded:boolean;

    procedure SetOutFilename(value:string);

    procedure SetOutputDevice(value:TOutputDevice);
    function GetOutputDevice:TOutputDevice;

    procedure SetTimerFreq(value:integer);

  protected

    function GetPosition:integer;
    function GetPlayMode:integer;
    function GetFrequency:integer;
    function GetBitrate:integer;
    function GetLayer:integer;
    function GetLength:integer;
    procedure SetStreamName(value:string);
    procedure Seek(value:integer);
    function GetPlayStopped:boolean;
    procedure Pause(value:boolean);
    function  GetPriority:TPlayPriority;
    procedure SetPriority(P:TPlayPriority);
    procedure UpdateTimer(Sender: TObject); virtual;

  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Init;
    procedure Play;
    procedure Restart;
    procedure Stop;
    procedure Open;
    procedure Close;
    procedure Deinit;
    property Paused : boolean read FPaused write Pause;
    property CurrentPosition : integer read GetPosition write Seek;
    property Mode : integer read GetPlayMode;
    property Frequency : integer read GetFrequency;
    property Bitrate : integer read GetBitrate;
    property Layer : integer read GetLayer;
    property PlayStopped : boolean read GetPlayStopped;
    property Length : longint read FStreamLength;
    property DLLLoaded : boolean read GetLoaded;

  published
    property Seekable : boolean read FSeekable write FSeekable;
    property FromStream : boolean read FResource write FResource;
    property PlayerPriority : TPlayPriority read GetPriority write SetPriority;
    property UseTimer : boolean read FUseTimer write FUseTimer;
    property TimerFreq : integer read FTimerFreq write SetTimerFreq;
    property AutoPlay : boolean read FAutoPlay write FAutoPlay;
    property StreamName : String read FStreamName write SetStreamName;
    property OutputDevice: TOutputDevice read GetOutputDevice write SetOutputDevice;
    property OutFilename: string read FOutFilename write SetOutFilename;
    property PathToDLL : String read FDLLPath write FDLLPath;
    property StartPos : integer read FStartPos write FStartPos;
    property EndPos : integer read FEndPos write FEndPos;
    property PlayedXTimes : integer read FPlayCount;

    property OnOpenStream : TOpenStreamEvent read FOpenEvent write FOpenEvent;
    property OnCloseStream: TCloseStreamEvent read FCloseEvent  write FCloseEvent;
    property OnRestartStream: TRestartStreamEvent read FRestartEvent  write FRestartEvent;
    property OnGetStreamSize: TGetStreamSizeEvent read FGetSizeEvent write FGetSizeEvent;
    property OnSeekStream : TSeekStreamEvent read FSeekEvent write FSeekEvent;
    property OnReadStream : TReadStreamEvent read FReadEvent write FReadEvent;

    property OnPosUpdate:TPosUpdateEvent read FOnPosUpdate write FOnPosUpdate;
    property OnPlayEnd : TNotifyEvent read FOnPlayEnd write FOnPlayEnd;
  end;

procedure Register;

implementation

Constructor TMPEGError.CreateErr;
begin
  inherited Create(Mess);
  ErrCode:=Err;
end;

procedure CBCS (obj:TMPegPlayer; var cant_seek:boolean; var res:pointer); stdcall;
begin
  if Assigned(Obj.OnOpenStream) then Obj.OnOpenStream(cant_seek, res) else
     res:=nil;
end;

procedure CBClS (obj:TMPegPlayer; handle :pointer); stdcall;
begin
  if Assigned(Obj.OnCloseStream) then Obj.OnCloseStream(handle);
end;

procedure CBRSS (obj:TMPegPlayer; handle :pointer; var res : boolean); stdcall;
begin
  if Assigned(Obj.OnRestartStream) then Obj.OnRestartStream(handle, res)
  else res:=false;
end;

procedure CBRS (obj:TMPegPlayer; handle:pointer;
                   var read_buffer;
                   nNumberOfBytesToRead:longint;
                   var nNumberOfBytesRead:longInt; var res:boolean); stdcall;
begin
  if Assigned(Obj.OnReadStream) then Obj.OnReadStream(handle,read_buffer,nNumberOfBytesToRead,nNumberOfBytesRead,res) else
  res:=false;
end;

procedure CBRSP (obj:TMPegPlayer; handle:pointer;
                        NumBytes,MoveMethod:LongInt; var res:LongInt); stdcall;
begin
  if Assigned(Obj.OnSeekStream) then Obj.OnSeekStream(handle,NumBytes,MoveMethod, res) else
     res:=-1;
end;

procedure CBGS (obj:TMPegPlayer; handle:pointer; var res:longint); stdcall;
begin
  if Assigned (Obj.OnGetStreamSize) then Obj.OnGetStreamSize(handle,res) else res:=-1;
end;

function TMPEGPlayer.LastError;
begin
  if (@DLLLastError<>nil) then
    result:=DLLLastError else
    result:=0;
end;

function TMPEGPlayer.GetLoaded;
begin
  result:=DLLHandle<>0;
end;

constructor TMPEGPlayer.Create;
begin
  inherited Create(AOwner);
  FPlayStopped := false;
  FPlayStarted := false;
end;

destructor TMPEGPlayer.Destroy;
begin
  PosUpdateTimer.free;
  inherited Destroy;
end;

procedure TMPEGPlayer.UpdateTimer(Sender: TObject);
var
  l:longint;
begin
  if not(FOpened) or not(FPlayStarted) then
  begin
    PosUpdateTimer.Enabled := false;
    exit;
  end;
  l := CurrentPosition;
  if l>FStreamLength then l := 0;
  if assigned(FOnPosUpdate) then FOnPosUpdate(l,FStreamLength);
  if FPlayStopped then
  begin
    PosUpdateTimer.Enabled := false;
    FPlayStarted := false;
    if assigned(FOnPlayEnd) then
    begin
      FPlayStopped := false;
      FOnPlayEnd(Self);
    end;
  end;
end;

procedure TMPEGPlayer.Init;
var s:string;

begin
  s:=FDLLPath;
  if (FDLLPath<>'') and (FDLLPath[system.Length(FDLLPath)]<>'\')
  and (FDLLPath[system.Length(FDLLPath)]<>':') then s:=s+'\';
    s:=s+'mpegdll.dll'#0;
  DLLHandle:=LoadLibrary(@S[1]);
  if DLLHandle=0 then Raise TMPEGError.Create('Can''t load MPEG library');
  @DllInit            :=GetProcAddress(DLLHandle,'init');
  @DllDeInit          := GetProcAddress(DLLHandle,'deinit');
  @DllOpen            := GetProcAddress(DLLHandle,'Open');
  @DllPause           := GetProcAddress(DLLHandle,'Pause');
  @DllRestart         := GetProcAddress(DLLHandle,'Restart');
  @DllStop            := GetProcAddress(DLLHandle,'Stop');
  @DllSetPriority     := GetProcAddress(DLLHandle,'SetPriority');
  @DllSetOutputDevice := GetProcAddress(DLLHandle,'SetOutputDevice');
  @DllPlay            := GetProcAddress(DLLHandle,'Play');
  @DllClose           := GetProcAddress(DLLHandle,'Close');
  @DllGetFrequency    := GetProcAddress(DLLHandle,'GetFrequency');
  @DllGetBitRate      := GetProcAddress(DLLHandle,'GetBitrate');
  @DllGetLayer        := GetProcAddress(DLLHandle,'GetLayer');
  @DllGetPlayerMode   := GetProcAddress(DLLHandle,'GetPlayerMode');
  @DllGetCurrentPos   := GetProcAddress(DLLHandle,'GetCurrentPos');
  @DllGetLength       := GetProcAddress(DLLHandle,'GetLength');
  @DllResetPlayerMode := GetProcAddress(DLLHandle,'ResetPlayerMode');
  @DllSeek            := GetProcAddress(DLLHandle,'Seek');
  @DLLLastError       := GetProcAddress(DLLHandle,'LastError');

  if (@DllInit=nil)
  or (@DllDeInit=nil)
  or (@DllOpen=nil)