zoukankan      html  css  js  c++  java
  • [转载]【备忘录】Delphi 怎么不注册 dll 就调用 com

    资料来源于 DFW 离线包:
    =====================================================================
    一.方法
    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.

  • 相关阅读:
    CentOS 7.4 安装python3及虚拟环境
    【抓包工具之Fiddler】增加IP列;session高亮
    【抓包工具之Fiddler】导出jmeter脚本
    Python2.7 Centos安装
    Centos 轻松升级 GCC 不改变系统环境
    GraphLab 安装 出错 "Cannot uninstall 'boto'" "Cannot uninstall 'certifi'"
    Centos6 使用 gbdt lightgbm "libc.so.6: version `GLIBC_2.14' not found" "Segment Fault"
    Linux 安装 gbdt xgboost lightgbm
    Sudo Permission Denied
    Linux Load Average高但磁盘IO和CPU占用率不高的可能原因
  • 原文地址:https://www.cnblogs.com/luckForever/p/7255277.html
Copyright © 2011-2022 走看看