运行时自动注册ActiveX控件

来自交大bbs
发信人: maomaony (毛毛), 信区: Visual
标  题: 运行时自动注册ActiveX控件
发信站: 交通大学思源BBS (Mon Mar  6 19:44:42 2000), 转信
让Delphi应用程序在运行时自动注册ActiveX控件
Flier@stu.ccnu.edu.cn
在使用Delphi或VB等可视化编程语言制作程序时，常常会用到大量的ActiveX控件（后缀
为OCX的控件或后缀为DLL的类型库），他们为应用程序的开发提供了简便的途径。但是
这些ActiveX控件在应用程序发布后，在用户的计算机上必须进行注册。用现有的安装程
序制作软件虽然可以很好地解决这个问题，但这样做的代价往往太大，一个安装程序本
身就有几十甚至几百KB，造成程序发行版本臃肿不堪。而且每次系统重装时都必须重新
安装一遍，如果直接把安装后程序复制到其它机器上也无法直接运行。
其实我们可以通过在程序中加入特殊的处理代码很简单地解决这个问题。
一般我们使用一个ActiveX的方法分为两种：一种是直接把可视化的ActiveX控件放到程
序中；另一种是在运行时根据需要实时建立。
如果是直接使用，则应用程序在初始化的过程中会自动寻找、创建所需的ActiveX控件，
如果控件没有注册，初始化程序会产生一个异常，我们只需要捕捉这个异常并处理之即
可。
在程序主Form中加入一个新的方法(Delphi 5中可以直接使用ApplicationEvents)
TfrmMain = class(TForm)
…
protected
procedure MyException(Sender: TObject; E: Exception);
…
procedure TfrmMain.MyException(Sender: TObject; E: Exception);
begin
…
if E is EOleSysError then
begin
   if HRESULT(EOLESysError(E).ErrorCode) = REGDB_E_CLASSNOTREG then
     RegisterOcx；
end
else
   Application.ShowException(E);
…
end;
并将此方法赋值给系统Application变量，在主Form的OnCreate事件里加入一行
procedure TfrmMain.FormCreate(Sender: TObject);
begin
…
Application.OnException := MyException;
…
end;
Application是一个系统自动建立的变量，他管理着整个应用程序，他的OnException属
性所指向的方法可以替换缺省的异常处理。我们在这里建立了自己的异常处理方法，其
中对异常类的检测“if E is EOleSysError then”确认是否是对ActiveX控件操作产生
的异常， 代码“if HRESULT(EOLESysError(E).ErrorCode) = REGDB_E_CLASSNOTREG t
hen” 再进一步检测看看ActiveX控件是否是因为没有注册而出现错误，如果是，则注册
之。RegisterOcx是一个自定义的方法，我们等一会再讨论他。这里的EOLESysError.Er
rorCode是一个HRESULT类型属性，他保存着对ActiveX控件操作发生错误的错误代码，详
细信息请查阅帮助或MSDN资料。
如果是在运行时动态建立ActiveX控件，则直接处理建立时的异常即可，如
…
try
   DemoOcx := CreateOleObject(‘Demo.Demo’);
except
   on E:EOleSysError do
   if HRESULT(E.ErrorCode) = CO_E_CLASSSTRING then
   begin
     if RegisterOcx then
       DemoOcx := CreateOleObject(‘Demo.Demo’);
     else
     begin
       MessageDlg('控件注册失败，程序无法正常使用!', mtError, [mbAbort], 0)
;
       Application.Terminate;
     end;
   end
   else
     raise;
…
注意这里我是使用的按名字(ProgramID)创建的方法，因此Delphi首先调用了一次CLSID
FromProgID函数，把ProgramID转换成相应的ClassID，所以这里产生的异常不是类未注
册（REGDB_E_CLASSNOTREG），而是类名称字符串错误（CO_E_CLASSSTRING）。如果要使
用别的创建方法，可以按这个思路改变检测ErrorCode的不同值……
至此我们已经可以捕捉到所有的因为类未注册而产生的异常，然后我们来处理他：
…
const
OCX_FILENAME = ‘demo.ocx’;
…
function TfrmMain.RegisterOcx: Boolean;
var
SystemDir: string;
function RegisterIt(const FileName: string): Boolean;
var
   si: TStartupInfo;
   pi: TProcessInformation;
begin
   FillChar(si, SizeOf(si), 0);
   with si do
   begin
     cb          := SizeOf(si);
     wShowWindow := SW_HIDE;
     dwFlags     := STARTF_USESHOWWINDOW;
   end;
   Result := CreateProcess(PChar(SystemDir + 'RegSvr32.exe'),
                           PChar(' /s "' + FileName + '"'),
                           nil, nil, False, 0, nil, nil, si, pi);
end;
begin
SystemDir   := NormalDir(GetSystemDir);
if FileExists(OCX_FILENAME) then
   Result := RegisterIt(NormalDir(ExtractFilePath(ParamStr(0))) + OCX_FILEN
AME)
else if FileExists(SystemDir + OCX_FILENAME) then
   Result := RegisterIt(SystemDir + OCX_FILENAME)
else
with dlgOpenOCX do
begin
   InitialDir := SystemDir;
   FileName   := OCX_FILENAME;
   if Execute then
     Result := RegisterIt(FileName)
   else
     Result := False;
end;
end;
首先取得系统目录(/windows/system)的路径到SystemDir变量（这里用到了NormalDir和
GetSystemDir两个函数是从RXLib控件包里摘抄下来的，见后面附带的代码），然后检测
在当前目录，系统目录下是否存在需要注册的控件，如果没有找到则要求用户指定其存
放的位置（dlgOpenOCX是一个TopenDialog），如果找到了或者用户指定了，则调用子函
数RegisterIt注册之。
注册ActiveX控件可以使用Windows自带的一个注册工具RegSvr32.exe，他在Windows的系
统目录里可以找到，我们给他“/s”参数让他不产生注册成功信息，而且通过修改Tsta
rtupInfo内容让其在后台运行即不显示DOS Box。（其实RegSvr32也是直接调用OCX控件
的一个DllRegisterServer函数注册控件的）。至此，整个ActiveX自动注册机制已经完
成，你可以放心地发布带有ActiveX控件的应用程序了。
所有代码在NT 4.0SP6、Delphi 4和5下调试通过
附：GetSystemDir和NormalDir函数的代码
function NormalDir(const DirName: string): string;
begin
Result := DirName;
if (Result <> '') and not (Result[Length(Result)] in [':', '\']) then
begin
   if (Length(Result) = 1) and (UpCase(Result[1]) in ['A'..'Z']) then
     Result := Result + ':\'
   else
     Result := Result + '\';
end;
end;
function GetSystemDir: string;
var
Buffer: array[0..1023] of Char;
begin
SetString(Result, Buffer, GetSystemDirectory(Buffer, SizeOf(Buffer)));
end;

调用OCX中DllRegisterServer即可。
先用LoadLibrary,后使用GetProcAddress得到DllRegisterServer地址，运行他
就可以了

//已经测试通过
type
TDllRegisterServer=function:HResult; stdcall;
procedure TForm1.Button1Click(Sender: TObject);
var
Ocx:TDllRegisterServer;
H:THandle;
begin
H:=LoadLibrary('MsComm32.Ocx');
try
   @Ocx:=GetProcAddress(H,'DllRegisterServer');
   Ocx;
finally
   FreeLibrary(H);
end;