如何使程序在运行时自动注册ActiveX控件

【 tulaoshi.com - 编程语言 】

　　编写Delphi应用程序时，经常会遇到一些ActiveX控件[注：扩展名为OCX的控件或DLL的类型库],它们为应用程序的开发提供了简单的操作途径。然而，这些程序在发布的同时，面临ActiveX控件注册问题。解决途径：一、用安装程序制作打包文件，往往会给增加程序本身的大小，系统重装时，则必须重新安装它；二、用程序本身进行代码编写函数的形式处理它。
　　使用方法分为两种：
　　一、直接把可视化的ActiveX控件放到程序中；
　　二、运行时根据需要实时建立。
　　如果是直接使用，则应用程序在初始化的过程中会自动寻找、创建所需的ActiveX控件，如果控件没有注册，初始化程序会产生一个异常，捕捉并处理这个异常。
　　在程序Form中加入一个新的方法：
　　unit UAutoRegActiveX;

　　interface

　　uses
　　  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　　  Dialogs, ComObj; //加入ComObj单元

　　type
　　  TAutoRegActiveXFrm = class(TForm)
　　    procedure FormCreate(Sender: TObject);
　　  private
　　    { Private declarations }
　　  public
　　    { Public declarations }
　　  protected
　　    { Public declarations }
　　    procedure CheckException(Sender: TObject; EAbort: Exception);
　　  end;

　　var
　　  AutoRegActiveXFrm: TAutoRegActiveXFrm;

　　implementation

　　{$R *.dfm}

　　{-------------------------------------------------
　　标准ActiveX控件中，有两个函数DLLRegisterServer 、DLLUnRegisterServer可调用，
　　其中函数用于注册控件，用于卸载控件。我们可用LoadLibrary装载DLL/OCX文件，用
　　GetProcAddress获取DLLRegisterServer和DLLUnRegisterServer两个函数的指针，然
　　后再直接运行这两个函数即可实现注册和卸载ActiveX控件的操作，从而代替Windows
　　系统的RegSvr32.exe实现ActiveX控件的注册和卸载。
　　--------------------------------------------------}
　　{-------------------------------------------------
　　参数说明：
　　sOleFileName 一个DLL或OCX文件名;
　　OleAction 表示注册操作类型：1表示注册，0表示卸载
　　返回值:True表示操作执行成功，False表示操作执行失败
　　--------------------------------------------------}
　　function OLERegister(sOleFileName: String; OleAction: Byte):Boolean;
　　const
　　  RegisterOle = 1; //注册
　　  UnRegisterOle = 0; //卸载
　　type
　　  TOleRegisterFunction = function: HResult; //注册或卸载函数原型
　　var
　　  hLibraryHandle: THandle; //由LoadLibray返回的DLL或OCX句柄
　　  hFunctionAddress: TFarProc; //DLL或OCX中的函数句柄，由GetProAddress返回
　　  RegFunction: TOleRegisterFunction; //注册或卸载函数指针
　　begin
　　  Result := False;
　　  //打开文件，返回DLL或OCX句柄
　　  hLibraryhandle := LoadLibrary(PChar(SOleFileName));
　　  if (hLibraryHandle 0) then //DLLakg OCX句柄正确
　　  try
　　    //返回注册或卸载函数指针
　　    if (OleAction = RegisterOle) then  //返回注册函数指针
　　      hFunctionAddress := GetProcAddress(hLibraryhandle,PChar('DLLRegisterServer'))
　　    else //返回卸载函数指针
　　      hFunctionAddress := GetProcAddress(hLibraryhandle,PChar('DLLUnRegisterServer'));
　　    if (hFunctionAddress nil) then //判断注册或卸载函数是否存在
　　    begin
　　      RegFunction := TOleRegisterFunction(hFunctionAddress); //获取操作函数的指针
　　      if RegFunction =0 then  //执行注册或卸载操作，返回值=0表示执行成功
　　        Result := True;
　　    end;
　　  finally
　　    FreeLibrary(hLibraryHandle); //关闭已打开的文件
　　  end;
　　end;

　　{ TAutoRegActiveXFrm }

　　procedure TAutoRegActiveXFrm.CheckException(Sender: TObject;
　　  EAbort: Exception);
　　begin
　　  if EAbort is EOleSysError then
　　  begin
　　    if HResult(EOleSysError(EAbort).ErrorCode) = REGDB_E_CLASSNOTREG then
　　      OleRegister('D:Flash.ocx',1);
　　  end
　　  else
　　    Application.ShowException(EAbort);
　　end;
　　//将CheckException方法赋值给系统Application变量，在主Form的OnCreate事件中。
　　procedure TAutoRegActiveXFrm.FormCreate(Sender: TObject);
　　var
　　  DemoOcx: Variant; //变量声明
　　begin
　　  Application.OnException := CheckException;
　　  //是否产生类名称字符串错误
　　  try
　　    DemoOcx := CreateOleObject('Demo.Demo');
　　  except
　　    on EAbort:EOleSysError do
　　    if HResult(EAbort.ErrorCode) = CO_E_CLASSSTRING then
　　    begin
　　      if OleRegister('D:Flash.ocx',1) then
　　        DemoOcx := CreateOleObject('Demo.Demo')
　　      else
　　      begin
　　        Application.MessageBox('控件注册失败，程序将无法正常运行',PChar('注册控件'),MB_OK+MB_ICONERROR);
　　        Application.Terminate;
　　      end;
　　    end;
　　  end;
　　end;

　　end.