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

　编写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.