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

2019/7/21 23:41:17 人评论 次浏览 分类:学习教程

原文链接:http://www.cnblogs.com/tecsoon/archive/2009/03/04/1403059.html

 编写Delphi应用程序时,经常会遇到一些ActiveX控件[注:扩展名为OCX的控件或DLL的类型库],它们为应用程序的开发提供了简单的操作途径。然而,这些程序在发布的同时,面临ActiveX控件注册问题。

  解决途径:一、用安装程序制作打包文件,往往会给增加程序本身的大小,系统重装时,则必须重新安装它;二、用程序本身进行代码编写函数的形式处理它。

  使用方法分为两种:

  一、直接把可视化的ActiveX控件放到程序中;

  二、运行时根据需要实时建立。

  如果是直接使用,则应用程序在初始化的过程中会自动寻找、创建所需的ActiveX控件,如果控件没有注册,初始化程序会产生一个异常,捕捉并处理这个异常。

  在程序Form中加入一个新的方法:

unitUAutoRegActiveX;
interface
uses
 Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,ComObj;//加入ComObj单元
type
 TAutoRegActiveXFrm=class(TForm)
  procedureFormCreate(Sender:TObject);
 private
  {Privatedeclarations}
 public
  {Publicdeclarations}
 protected
  {Publicdeclarations}
  procedureCheckException(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表示操作执行失败

  --------------------------------------------------}

functionOLERegister(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//DLLakgOCX句柄正确
 try
  //返回注册或卸载函数指针
  if(OleAction=RegisterOle)then //返回注册函数指针
   hFunctionAddress:=GetProcAddress(hLibraryhandle,PChar('DLLRegisterServer'))
  else//返回卸载函数指针
   hFunctionAddress:=GetProcAddress(hLibraryhandle,PChar('DLLUnRegisterServer'));
  if(hFunctionAddress<>nil)then//判断注册或卸载函数是否存在
  begin
   RegFunction:=TOleRegisterFunction(hFunctionAddress);//获取操作函数的指针
   ifRegFunction>=0then //执行注册或卸载操作,返回值>=0表示执行成功
    Result:=True;
  end;
 finally
  FreeLibrary(hLibraryHandle);//关闭已打开的文件
 end;
end;
{TAutoRegActiveXFrm}
procedureTAutoRegActiveXFrm.CheckException(Sender:TObject;
 EAbort:Exception);
begin
 ifEAbortisEOleSysErrorthen
 begin
  ifHResult(EOleSysError(EAbort).ErrorCode)=REGDB_E_CLASSNOTREGthen
   OleRegister('D:Flash.ocx',1);
 end
 else
  Application.ShowException(EAbort);
end;
//将CheckException方法赋值给系统Application变量,在主Form的OnCreate事件中。
procedureTAutoRegActiveXFrm.FormCreate(Sender:TObject);
var
 DemoOcx:Variant;//变量声明
begin
 Application.OnException:=CheckException;
 //是否产生类名称字符串错误
 try
  DemoOcx:=CreateOleObject('Demo.Demo');
 except
  onEAbort:EOleSysErrordo
  ifHResult(EAbort.ErrorCode)=CO_E_CLASSSTRINGthen
  begin
   ifOleRegister('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.

 

转载于:https://www.cnblogs.com/tecsoon/archive/2009/03/04/1403059.html

相关资讯

    暂无相关的资讯...

共有访客发表了评论 网友评论

验证码: 看不清楚?
    -->