程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 如何使程序在運行時自動注冊ActiveX控件

如何使程序在運行時自動注冊ActiveX控件

編輯:Delphi

  編寫Delphi應用程序時,經常會遇到一些ActiveX控件[注:擴展名為OCX的控件或DLL的類型庫],它們為應用程序的開發提供了簡單的操作途徑。然而,這些程序在發布的同時,面臨ActiveX控件注冊問題。解決途徑:一、用安裝程序制作打包文件,往往會給增加程序本身的大小,系統重裝時,則必須重新安裝它;二、用程序本身進行代碼編寫函數的形式處理它。
  使用方法分為兩種:
  一、直接把可視化的ActiveX控件放到程序中;
  二、運行時根據需要實時建立。
  如果是直接使用,則應用程序在初始化的過程中會自動尋找、創建所需的ActiveX控件,如果控件沒有注冊,初始化程序會產生一個異常,捕捉並處理這個異常。
  在程序Form中加入一個新的方法:
  unit UAutoRegActiveX;

  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}

  {-------------------------------------------------
  標准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;

  end.

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved