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;
