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表示執行成功 /tResult := 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 /tDemoOcx := CreateOleObject(''Demo.Demo'') else begin /tApplication.MessageBox(''控件注冊失敗，程序將無法正常運行'',PChar(''注冊控件''),MB_OK+MB_IConERROR); /tApplication.Terminate; end; end; end; end;
