在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、播放

时间： 2024-11-06 14:53:45

在Delphi下使用迅雷APlayer组件进行免注册开发的相关文章

DELPHI下的SOCK编程

本文是写给公司新来的程序员的,算是一点培训的教材.本文不会涉及太多的编程细节,只是简单讲解在DELPHI下进行Winsock编程最好了解的知识. 题外话:我认为学习编程就如同学习外语一样,最好的方式是你先学会如何去运用它,然后才是了解它的语言特性.语法之类的东西.不过很可惜,我们以前的外语教育使用了相反的过程.软件编程也是一样,在很多人的大学阶段,你更多的是学习那些理论知识,学习“语法”,这里,我丝毫没有贬低理论知识重要性的意思.理论知识和实践是相辅相成的,但一个恰当的学习方式,很多时候可以让学

DELPHI下API简述（1800个API）

DELPHI下API简述 http://zero.cnbct.org/show.asp?id=144 auxGetDevCaps API 获取附属设备容量 auxGetNumDevs API 返回附属设备数量 auxGetVolume API 获取当前卷设置 auxOutMessage API 向输出设备发送消息 auxSetVolume API 设置附属设备卷 AbortDoc API 终止一项打印作业 AbortPath API 终止或取消DC中的一切路径 AbortPrinter API

DELPHI控件：DBLookupComboBOX组件的使用方法

在许多数据表中,数据是以代码方式存放的,如在班级编码数据表tB03(表5．5)中,系部字段TB0309采用编码方式存放,系部真实名称则存放在系部编码表TB06.使用代码的好处是,用户可在编码表TB06中改变TB0602字段的系部名称,而不会影响使用该编码的其他数据表(如TB03)的运行6其缺点是当用户输人数据编码时,必须查询编码所表示的含义,如"OO"代表"基础部"."1 O"表示"机械系"等,这给数据录入带来很大的麻烦.最好

深入Delphi下的DLL编程

深入Delphi下的DLL编程 作者:岑心 引 言 相信有些计算机知识的朋友都应该听说过“DLL”.尤其是那些使用过windows操作系统的人,都应该有过多次重装系统的“悲惨”经历——无论再怎样小心,没有驱动损坏,没有病毒侵扰,仍然在使用(安装)了一段时间软件后,发现windows系统越来越庞大,操作越来越慢,还不时的出现曾经能使用的软件无法使用的情况,导致最终不得不重装系统.这种情况常常是由于dll文件的大量安装和冲突造成的.这一方面说明DLL的不足,另一方面也说明DLL的重要地位,以至我们无

DELPHI下的SOCK编程(转)

DELPHI下的SOCK编程      本文是写给公司新来的程序员的,算是一点培训的教材.本文不会涉及太多的编程细节,只是简单讲解在DELPHI下进行Winsock编程最好了解的知识. 题外话:我认为学习编程就如同学习外语一样,最好的方式是你先学会如何去运用它,然后才是了解它的语言特性.语法之类的东西.不过很可惜,我们以前的外语教育使用了相反的过程.软件编程也是一样,在很多人的大学阶段,你更多的是学习那些理论知识,学习“语法”,这里,我丝毫没有贬低理论知识重要性的意思.理论知识和实践是相辅相成的

Elite Container DELPHI下的一个轻量级IoC对象容器

一.简介: Elite Container是DELPHI下的一个轻量级IoC对象容器(IoC:Inverse of Control,反转控制).它是参考了Java中的Spring框架(主要是配置文件的写法),并结合DELPHI的特点来构建的.相比Spring的对象容器,它提供的功能更为精简常用(如对象延迟创建.对象属性自动注入等),降低了学习的难度,并且提供了很多扩展点,你只需简单地写一个插件实现类,并在配置文件中进行简单配置,就可以让Elite Container拥有你的自定义功能! Elit

Delphi下的RTTI函数大全

http://ljz9425.blog.163.com/blog/static/369148572008111635253858/ Delphi下的RTTI(下) 2008-12-16 15:52:53|  分类: Delphi |字号 订阅目 录===============================================================================⊙ GetTypeData 函数⊙ GetPropInfo 函数⊙ FindPropInfo

Delphi下IOCP开源框架：DIOCP 成功应用案例分享

首先说明,该项目不是本人的项目,本文转自盒子. 该项目使用的DIOCP版本为1.0,目前diocp为3.5 以下是盒子的原文 ------------------------------------------------------------------------------ DIOCP是Delphi下进行IOCP服务端通讯开发的一个非常好的开源框架,稳定.高效并且使用起来十分简单.     自己两个多月之前因为需要使用Delphi开发一个TCP服务端,当时也是到处爬文,希望找到一个稳定且

Delphi在Android下实现BroadcastReceiver功能（举例在Delphi下获取USB外设拔插消息）

在Android里,用java通过实现BroadcastReceiver接口,就可以获得Intent消息.可是Delphi程序不能直接实现JBroadcastReceiver,如何能够实现类似Java的BroadcastReceiver功能呢? 幸运的是Delphi提供了TJFMXBroadcastReceiver类实现了BroadcastReceiver,我们便可以以此达到目的. 下面的程序片段举例,实现如何在Delphi下获取USB外设拔插的消息. uses System.SysUtils,