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控件中，有兩個函數(shù)DLLRegisterServer 、DLLUnRegisterServer可調(diào)用，其中函數(shù)用于注冊控件，用于卸載控件。我們可用LoadLibrary裝載DLL/OCX文件，用GetProcAddress獲取DLLRegisterServer和DLLUnRegisterServer兩個函數(shù)的指針，然后再直接運行這兩個函數(shù)即可實現(xiàn)注冊和卸載ActiveX控件的操作，從而代替Windows系統(tǒng)的RegSvr32.exe實現(xiàn)ActiveX控件的注冊和卸載。 --------------------------------------------------} {------------------------------------------------- 參數(shù)說明： sOleFileName 一個DLL或OCX文件名; OleAction 表示注冊操作類型：1表示注冊，0表示卸載 返回值:True表示操作執(zhí)行成功，F(xiàn)alse表示操作執(zhí)行失敗 --------------------------------------------------} function OLERegister(sOleFileName: String; OleAction: Byte):Boolean; const RegisterOle = 1; //注冊 UnRegisterOle = 0; //卸載 type TOleRegisterFunction = function: HResult; //注冊或卸載函數(shù)原型 var hLibraryHandle: THandle; //由LoadLibray返回的DLL或OCX句柄 hFunctionAddress: TFarProc; //DLL或OCX中的函數(shù)句柄，由GetProAddress返回 RegFunction: TOleRegisterFunction; //注冊或卸載函數(shù)指針 begin Result := False; //打開文件，返回DLL或OCX句柄 hLibraryhandle := LoadLibrary(PChar(SOleFileName)); if (hLibraryHandle > 0) then //DLLakg OCX句柄正確 try //返回注冊或卸載函數(shù)指針 if (OleAction = RegisterOle) then //返回注冊函數(shù)指針 hFunctionAddress := GetProcAddress(hLibraryhandle,PChar(''DLLRegisterServer'')) else //返回卸載函數(shù)指針 hFunctionAddress := GetProcAddress(hLibraryhandle,PChar(''DLLUnRegisterServer'')); if (hFunctionAddress <> nil) then //判斷注冊或卸載函數(shù)是否存在 begin RegFunction := TOleRegisterFunction(hFunctionAddress); //獲取操作函數(shù)的指針 if RegFunction >=0 then //執(zhí)行注冊或卸載操作，返回值>=0表示執(zhí)行成功 /tResult := True; end; finally FreeLibrary(hLibraryHandle); //關(guān)閉已打開的文件 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方法賦值給系統(tǒng)Application變量，在主Form的OnCreate事件中。 procedure TAutoRegActiveXFrm.FormCreate(Sender: TObject); var DemoOcx: Variant; //變量聲明 begin Application.OnException := CheckException; //是否產(chǎn)生類名稱字符串錯誤 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 /tDemoOcx := CreateOleObject(''Demo.Demo'') else begin /tApplication.MessageBox(''控件注冊失敗，程序?qū)o法正常運行'',PChar(''注冊控件''),MB_OK+MB_IConERROR); /tApplication.Terminate; end; end; end; end;
