在Delphi下使用迅雷APlayer组件进行免注册开发
Posted Delphi力量
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了在Delphi下使用迅雷APlayer组件进行免注册开发相关的知识,希望对你有一定的参考价值。
之前都是用的delphi下的dspack进行的视频开发,这个组件其实很好用,就是找解码器麻烦点,而且还得在客户的计算机上使用RegSvr32.exe也注册解码器,要不有可能播放不了。
结果在查找合适的解码器过程中,无意搜索到了迅雷的APlayer组件。
迅雷APlayer这个组件提供了一个完整的解码器合集(核心的流媒体播放技术也是DirectShow和dspack一样一样的),下载APlayer的解码器合集并注册到系统后,确实在dspack也用的挺好,不过看了APlayer的介绍后发现人家做的更好,虽然是个ActiveX,但是给出的c++示例表示无需显式注册即可使用(就是不需要用Regsvr32.exe预先注册APlayer组件到目标计算机上),而且也无需预先注册解码器(也是Regsvr32)到操作系统,只要指定解码器路径,APlayer可以自行搜索此路径查找合适的解码器,简直太好了,本来就怕发布到客户计算机上后由于解码器问题导致播放不正常(其实开发测试阶段已经出现过了),这么个好东西赶快试试。
第一次使用先按照Delphi下的传统方式来,在开发环境中引入APlayer组件,这个就是个ActiveX控件,添加到组件面板上,建个工程拖到窗体上,响应几个事件,轻轻松松视频就开始播放了,呵呵,也不用关心解码器文件缺不缺了,APlayer组件会查找并指示出来缺少的文件,真是太智能了,省心,好用。
接下来晋级操作,怎么不注册APlayer.dll就能直接创建ActiveX组件在自己的程序里面呢?看APlayer的示例工程定义了两个函数(BOOL CreateAPlayerFromFile(void)、HRESULT CreateInstanceFromFile(const TCHAR * pcszPath, REFCLSID rclsid, REFIID riid, IUnknown * pUnkOuter, LPVOID * ppv)),直接通过APlayer.dll就创建了ActiveX组件,不过那个示例工程是C++的,咱们不熟,对照着改了下,没搞定,于是求助万能的网络搜索引擎,目标:Delphi不注册COM直接使用ActiveX控件并绑定事件,呵呵,感谢前辈们,果然有啊,原文章链接:http://blog.csdn.net/love3s/article/details/7411757
照着来吧,按照这位前辈的话,文笔不好直接上代码吧:
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtnrs, System.Win.ComObj, EventSink, Winapi.ActiveX, Vcl.ExtCtrls, Vcl.StdCtrls; const CLASS_Player: TGUID = \'{A9332148-C691-4B9D-91FC-B9C461DBE9DD}\'; type PIUnknown = ^IUnknown; TAtlAxAttachControl = function(Control: IUnknown; hwind: hwnd; ppUnkContainer: PIUnknown): HRESULT; stdcall; _IPlayerEvents = dispinterface [\'{31D6469C-1DA7-47C0-91F9-38F0C39F9B89}\'] { function OnMessage(nMessage: Integer; wParam: Integer; lParam: Integer): HResult; dispid 1; function OnStateChanged(nOldState: Integer; nNewState: Integer): HResult; dispid 2; function OnOpenSucceeded: HResult; dispid 3; function OnSeekCompleted(nPosition: Integer): HResult; dispid 4; function OnBuffer(nPercent: Integer): HResult; dispid 5; function OnVideoSizeChanged: HResult; dispid 6; function OnDownloadCodec(const strCodecPath: WideString): HResult; dispid 7; function OnEvent(nEventCode: Integer; nEventParam: Integer): HResult; dispid 8; } end; TfrmMain = class(TForm) pnlCom: TPanel; btnOpen: TButton; dlgOpen1: TOpenDialog; btnPath: TButton; procedure FormCreate(Sender: TObject); procedure btnOpenClick(Sender: TObject); procedure btnPathClick(Sender: TObject); private { Private declarations } APlayer: Variant; APlayerCreateSuccess: Boolean; EventSink: TEventSink; function InitAPlayer: Boolean; function CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown; procedure EventSinkInvoke(Sender: TObject; DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer); public { Public declarations } end; var frmMain: TfrmMain; implementation {$R *.dfm} { TForm1 } procedure TfrmMain.btnOpenClick(Sender: TObject); begin if not APlayerCreateSuccess then Exit; if dlgOpen1.Execute(Handle) then begin APlayer.Open(dlgOpen1.FileName); end; end; procedure TfrmMain.btnPathClick(Sender: TObject); begin if not APlayerCreateSuccess then Exit; ShowMessage(APlayer.GetConfig(2)); end; function TfrmMain.CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown; var Factory: IClassFactory; DllGetClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall; hr: HRESULT; begin DllGetClassObject := GetProcAddress(DllHandle, \'DllGetClassObject\'); if Assigned(DllGetClassObject) then begin hr := DllGetClassObject(CLSID, IClassFactory, Factory); if hr = S_OK then try hr := Factory.CreateInstance(nil, IUnknown, Result); if hr <> S_OK then begin MessageBox(Handle, \'创建APlayer实例失败!\', \'错误\', MB_OK + MB_ICONERROR); end; except MessageBox(Handle, PChar(\'创建APlayer实例失败!错误代码:\' + IntToStr(GetLastError)), \'错误\', MB_OK + MB_ICONERROR); end; end; end; procedure TfrmMain.EventSinkInvoke(Sender: TObject; DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer); var ov: OleVariant; begin { 这里需要注明Params这个参数, 包含了事件的参数 如: Params.rgvarg[0] 代表第一个参数 Params.rgvarg[1] 代表第二个参数 ...... Params.rgvarg[65535] 代表第65535个参数 最多65535个参数 具体可以参考 tagDISPPARAMS 的定义 } case dispid of // function OnMessage(nMessage: Integer; wParam: Integer; lParam: Integer): HResult; dispid 1; $00000001: begin end; // function OnStateChanged(nOldState: Integer; nNewState: Integer): HResult; dispid 2; $00000002: begin end; // function OnOpenSucceeded: HResult; dispid 3; $00000003: begin end; // function OnSeekCompleted(nPosition: Integer): HResult; dispid 4; $00000004: begin end; // function OnBuffer(nPercent: Integer): HResult; dispid 5; $00000005: begin end; // function OnVideoSizeChanged: HResult; dispid 6; $00000006: begin end; // function OnDownloadCodec(const strCodecPath: WideString): HResult; dispid 7; $00000007: begin ov := OleVariant(Params.rgvarg[0]); MessageBox(Handle, PChar(\'缺少解码器文件:\' + VarToStr(ov)), \'错误\', MB_OK + MB_ICONERROR); end; // function OnEvent(nEventCode: Integer; nEventParam: Integer): HResult; dispid 8; $00000008: begin end; end end; procedure TfrmMain.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown := DebugHook <> 0; APlayerCreateSuccess := InitAPlayer; end; function TfrmMain.InitAPlayer: Boolean; var hModule, hDll: THandle; AtlAxAttachControl: TAtlAxAttachControl; begin hModule := LoadLibrary(\'atl.dll\'); if hModule < 32 then begin Exit(False); end; AtlAxAttachControl := TAtlAxAttachControl(GetProcAddress(hModule, \'AtlAxAttachControl\')); EventSink := TEventSink.Create(Self); EventSink.OnInvoke := EventSinkInvoke; if not Assigned(AtlAxAttachControl) then Exit(False); try hDll := LoadLibrary(\'APlayer.dll\'); APlayer := CreateComObjectFromDll(CLASS_Player, hDll) as IDispatch; if VarIsNull(APlayer) then begin Exit(False); end; EventSink.Connect(APlayer, _IPlayerEvents); AtlAxAttachControl(APlayer, pnlCom.Handle, nil); Result := True; except Result := False; end; end; end.
接下来EventSink单元代码(绑定ActiveX控件事件用的):
unit EventSink; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.ActiveX; type TInvokeEvent = procedure(Sender: TObject; DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object; TAbstractEventSink = class(TObject, IUnknown, IDispatch) private FDispatch: IDispatch; FDispIntfIID: TGUID; FConnection: LongInt; FOwner: TComponent; protected { IUnknown } function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; { IDispatch } function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo) : HRESULT; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer) : HRESULT; stdcall; public constructor Create(AOwner: TComponent); destructor Destroy; override; procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID); procedure Disconnect; end; TEventSink = class(TComponent) private { Private declarations } FSink: TAbstractEventSink; FOnInvoke: TInvokeEvent; protected { Protected declarations } procedure DoInvoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer); virtual; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID); published { Published declarations } property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke; end; implementation uses ComObj; procedure InterfaceConnect(const Source: IUnknown; const IID: TIID; const Sink: IUnknown; var Connection: LongInt); var CPC: IConnectionPointContainer; CP: IConnectionPoint; i: HRESULT; begin Connection := 0; if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then if Succeeded(CPC.FindConnectionPoint(IID, CP)) then i := CP.Advise(Sink, Connection); end; procedure InterfaceDisconnect(const Source: IUnknown; const IID: TIID; var Connection: LongInt); var CPC: IConnectionPointContainer; CP: IConnectionPoint; begin if Connection <> 0 then if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then if Succeeded(CPC.FindConnectionPoint(IID, CP)) then if Succeeded(CP.Unadvise(Connection)) then Connection := 0; end; { TAbstractEventSink } function TAbstractEventSink._AddRef: Integer; stdcall; begin Result := 2; end; function TAbstractEventSink._Release: Integer; stdcall; begin Result := 1; end; constructor TAbstractEventSink.Create(AOwner: TComponent); begin inherited Create; FOwner := AOwner; end; destructor TAbstractEventSink.Destroy; var p: Pointer; begin Disconnect; inherited Destroy; end; function TAbstractEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall; begin Result := E_NOTIMPL; end; function TAbstractEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo) : HRESULT; stdcall; begin Result := E_NOTIMPL; end; function TAbstractEventSink.GetTypeInfoCount(out Count: Integer) : HRESULT; stdcall; begin Count := 0; Result := S_OK; end; function TAbstractEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall; begin (FOwner as TEventSink).DoInvoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr); Result := S_OK; end; function TAbstractEventSink.QueryInterface(const IID: TGUID; out Obj) : HRESULT; stdcall; begin // We need to return the event interface when it\'s asked for Result := E_NOINTERFACE; if GetInterface(IID, Obj) then Result := S_OK; if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch, Obj) then Result := S_OK; end; procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID); begin FDispIntfIID := AnAppDispIntfIID; FDispatch := AnAppDispatch; // Hook the sink up to the automation server InterfaceConnect(FDispatch, FDispIntfIID, Self, FConnection); end; procedure TAbstractEventSink.Disconnect; begin if Assigned(FDispatch) then begin // Unhook the sink from the automation server InterfaceDisconnect(FDispatch, FDispIntfIID, FConnection); FDispatch := nil; FConnection := 0; end; end; { TEventSink } procedure TEventSink.Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID); begin FSink.Connect(AnAppDispatch, AnAppDispIntfIID); end; constructor TEventSink.Create(AOwner: TComponent); begin inherited Create(AOwner); FSink := TAbstractEventSink.Create(Self); end; destructor TEventSink.Destroy; begin FSink.Free; inherited Destroy; end; procedure TEventSink.DoInvoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer); begin if Assigned(FOnInvoke) then FOnInvoke(Self, DispID, IID, LocaleID, Flags, TDispParams(Params), VarResult, ExcepInfo, ArgErr); end; end.
循着前辈的脚步果然很容易并顺利的解决了问题,我在APlayer论坛看有人问怎么在Delphi下也可以免注册使用APlayer组件呢,呵呵,现在有答案了!而且我们掌握了一个重要的Delphi技能“Delphi不注册COM直接使用ActiveX控件并绑定事件”,开心!特此记录。
后附程序执行的截图:
1、程序设计界面,只是放置了两个按钮、一个OpenDialog、一个Panel(作为APlayer组件的容器)。
2、程序运行后,可以看到APlayer组件成功创建到了Panel上,读取APlayer的解码器路径,和APlayer.dll在同一目录下,如果用的注册ActiveX的方式并拖拽到窗体上进行开发的,自己试试就会发现解码器路径固定在“C:\\Users\\Public\\Thunder Network\\APlayer”且无法修改。如果解码器路径固定了会导致在客户端计算机部署时更复杂些,不如在本地目录方便,况且还得在客户计算机上注册APlayer组件,忒麻烦了。呵呵,免注册真好!
3、播放
以上是关于在Delphi下使用迅雷APlayer组件进行免注册开发的主要内容,如果未能解决你的问题,请参考以下文章