interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComObj; //加入ComObj單元

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}

{-------------------------------------------------
標(biāo)準(zhǔn)ActiveX控件中，有兩個(gè)函數(shù)DLLRegisterServer 、DLLUnRegisterServer可調(diào)用，
其中函數(shù)用于注冊(cè)控件，用于卸載控件。我們可用LoadLibrary裝載DLL/OCX文件，用
GetProcAddress獲取DLLRegisterServer和DLLUnRegisterServer兩個(gè)函數(shù)的指針，然
后再直接運(yùn)行這兩個(gè)函數(shù)即可實(shí)現(xiàn)注冊(cè)和卸載ActiveX控件的操作，從而代替Windows
系統(tǒng)的RegSvr32.exe實(shí)現(xiàn)ActiveX控件的注冊(cè)和卸載。
--------------------------------------------------}
{-------------------------------------------------
參數(shù)說(shuō)明：
sOleFileName 一個(gè)DLL或OCX文件名;
OleAction 表示注冊(cè)操作類(lèi)型：1表示注冊(cè)，0表示卸載
返回值:True表示操作執(zhí)行成功，F(xiàn)alse表示操作執(zhí)行失敗
--------------------------------------------------}
function OLERegister(sOleFileName: String; OleAction: Byte):Boolean;
const
  RegisterOle = 1; //注冊(cè)
  UnRegisterOle = 0; //卸載
type
  TOleRegisterFunction = function: HResult; //注冊(cè)或卸載函數(shù)原型
var
  hLibraryHandle: THandle; //由LoadLibray返回的DLL或OCX句柄
  hFunctionAddress: TFarProc; //DLL或OCX中的函數(shù)句柄，由GetProAddress返回
  RegFunction: TOleRegisterFunction; //注冊(cè)或卸載函數(shù)指針
begin
  Result := False;
  //打開(kāi)文件，返回DLL或OCX句柄
  hLibraryhandle := LoadLibrary(PChar(SOleFileName));
  if (hLibraryHandle > 0) then //DLLakg OCX句柄正確
  try
    //返回注冊(cè)或卸載函數(shù)指針
    if (OleAction = RegisterOle) then  //返回注冊(cè)函數(shù)指針
      hFunctionAddress := GetProcAddress(hLibraryhandle,PChar('DLLRegisterServer'))
    else //返回卸載函數(shù)指針
      hFunctionAddress := GetProcAddress(hLibraryhandle,PChar('DLLUnRegisterServer'));
    if (hFunctionAddress <> nil) then //判斷注冊(cè)或卸載函數(shù)是否存在
    begin
      RegFunction := TOleRegisterFunction(hFunctionAddress); //獲取操作函數(shù)的指針
      if RegFunction >=0 then  //執(zhí)行注冊(cè)或卸載操作，返回值>=0表示執(zhí)行成功
        Result := True;
    end;
  finally
    FreeLibrary(hLibraryHandle); //關(guān)閉已打開(kāi)的文件
  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)生類(lèi)名稱(chēng)字符串錯(cuò)誤
  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('控件注冊(cè)失敗，程序?qū)o(wú)法正常運(yùn)行',PChar('注冊(cè)控件'),MB_OK+MB_ICONERROR);
        Application.Terminate;
      end;
    end;
  end;
end;

end.