Delphi 怎么不注册 dll 就调用 com

一.方法

lich (2003-10-30 22:16:00) 
前言:
如果你的程序中使用了 COM对象或者 OCX控件,
发布程序的时候必须带上相关的 DLL文件或者 OCX文件,
同时还需要注册到系统中,
如果我想让我的程序 Copy & Run, 不需要安装,(现在流行绿色软件嘛)
那么使用下面的方法可以调用未注册的 COM对象或者 OCX控件

我仅仅提供简单的方法,大家共同研究,经验共享

如果COM对象没有在注册表中注册,那么按照下面的方法创建它

function CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown;
var
  Factory: IClassFactory;
  DllGetClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
begin
  DllGetClassObject := GetProcAddress(DllHandle, 'DllGetClassObject');
  if Assigned(DllGetClassObject) then
  begin
    DllGetClassObject(CLSID, IClassFactory, Factory);
    Factory.CreateInstance(nil, IUnknown, Result);
  end;
end;

二.例子

下面是用上面的函数从ocx 文件中创建对象的例子
此处创建了一个 MSCOMM32 的串口控件,
调用了此控件的 AboutBox 的对话框,

不管此ocx 文件是否已经注册到系统中,下面的程序都会正常执行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
  { Private declarations }
  public
    ocxhdl: THandle;
    comm: Variant;
end;

const
  CLASS_MSComm: TGUID = '{648A5600-2C6E-101B-82B6-000000000014}';

var
Form1: TForm1;

function CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown;

implementation

{$R *.dfm}

function CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown;
var
  Factory: IClassFactory;
  DllGetClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
begin
  DllGetClassObject := GetProcAddress(DllHandle, 'DllGetClassObject');
  if Assigned(DllGetClassObject) then
  begin
    DllGetClassObject(CLSID, IClassFactory, Factory);
    Factory.CreateInstance(nil, IUnknown, Result);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ocxhdl := LoadLibrary('mscomm32.ocx');
  if ocxhdl < 32 then
  ShowMessage('error');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  comm := CreateComObjectFromDll(CLASS_MSComm, ocxhdl) as IDispatch;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  comm.AboutBox;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  comm := Null;
end;

end.


已标记关键词 清除标记
相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页