文笔不行,直接上源码:

主窗口:

unit Unit1;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Winapi.ActiveX

  , System.Win.ComObj, EventSink;

type

  TForm1 = class(TForm)

    pnlCom: TPanel;

    Panel2: TPanel;

    Panel3: TPanel;

    btnGo: TButton;

    edt1: TEdit;

    LblStatus: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure btnGoClick(Sender: TObject);

  private

    { Private declarations }

    EventSink: TEventSink;

    ActiveXCon: Variant;

    function InitAtl: Boolean;

    procedure EventSinkInvoke(Sender: TObject; DispID: Integer;

       const IID: TGUID; LocaleID: Integer; Flags: Word;

       Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer);

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

const

  CLASS_MsRdpClient: TGUID = '{7CACBD7B-0D99-468F-AC33-22E495C0AFE5}';//'{791FA017-2DE3-492E-ACC5-53C67A2B94D0}';

type

  PIUnknown=^IUnknown;

  TAtlAxAttachControl = function(Control:IUnknown; hwind:hwnd;ppUnkContainer:PIUnknown): HRESULT; stdcall;

  //--此处参考mstscax.dll的接口文件，如果没有，在 Component->Import Component->Import a Type Library

  //--导入：Microsoft Terminal Services Active Client 1.0 Type Library 1.0

  IMsTscAxEvents = dispinterface

    ['{336D5562-EFA8-482E-8CB3-C5C0FC7A7DB6}']

    {

    procedure OnConnecting; dispid 1;

    procedure OnConnected; dispid 2;

    procedure OnLoginComplete; dispid 3;

    procedure OnDisconnected(discReason: Integer); dispid 4;

    procedure OnEnterFullScreenMode; dispid 5;

    procedure OnLeaveFullScreenMode; dispid 6;

    procedure OnChannelReceivedData(const chanName: WideString; const data: WideString); dispid 7;

    procedure OnRequestGoFullScreen; dispid 8;

    procedure OnRequestLeaveFullScreen; dispid 9;

    procedure OnFatalError(errorCode: Integer); dispid 10;

    procedure OnWarning(warningCode: Integer); dispid 11;

    procedure OnRemoteDesktopSizeChange(width: Integer; height: Integer); dispid 12;

    procedure OnIdleTimeoutNotification; dispid 13;

    procedure OnRequestContainerMinimize; dispid 14;

    function OnConfirmClose: WordBool; dispid 15;

    function OnReceivedTSPublicKey(const publicKey: WideString): WordBool; dispid 16;

    function OnAutoReconnecting(disconnectReason: Integer; attemptCount: Integer): AutoReconnectContinueState; dispid 17;

    procedure OnAuthenticationWarningDisplayed; dispid 18;

    procedure OnAuthenticationWarningDismissed; dispid 19;

    }

  end;

implementation

{$R *.dfm}

{ TForm1 }

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

var

  Factory: IClassFactory;

  DllGetClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall;

  hr: HRESULT;

begin

  DllGetClassObject := GetProcAddress(DllHandle, 'DllGetClassObject');

  if Assigned(DllGetClassObject) then

  begin

    hr := DllGetClassObject(CLSID, IClassFactory, Factory);

    if hr = S_OK then

    try

      hr := Factory.CreateInstance(nil, IUnknown, Result);

      if hr <> S_OK then begin

        ShowMessage('Error');

      end;

    except

      ShowMessage(IntToStr(GetLastError));

    end;

  end;

end;

procedure TForm1.btnGoClick(Sender: TObject);

begin

  ActiveXCon.Navigate(edt1.Text);

end;

procedure TForm1.EventSinkInvoke(Sender: TObject; DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word;

  Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer);

begin  <p>  {

&nbsp;&nbsp;&nbsp; 这里需要注明Params这个参数, 包含了事件的参数

&nbsp;&nbsp;&nbsp; 如：

&nbsp;&nbsp;&nbsp; Params.rgvarg[0] 代表第一个参数

&nbsp;&nbsp;&nbsp; Params.rgvarg[1] 代表第二个参数

&nbsp;&nbsp;&nbsp; ......

&nbsp;&nbsp;&nbsp; Params.rgvarg[65535] 代表第65535个参数

&nbsp;&nbsp;&nbsp; 最多65535个参数

&nbsp;&nbsp;&nbsp; 具体可以参考 tagDISPPARAMS 的定义</p><p>&nbsp;&nbsp;&nbsp; 这里只列出了怎么扑获相关事件，具体功能具体实现

&nbsp; }</p>  case dispid of

    $: LblStatus.Caption := '正在连接';

    $: LblStatus.Caption := '连接成功';

    $: LblStatus.Caption := '登陆成功';

    $: LblStatus.Caption := '断开连接';

    $: LblStatus.Caption := '进入全屏模式';

    $: LblStatus.Caption := '离开全屏模式';

    $: LblStatus.Caption := '通道接收数据';

    $: LblStatus.Caption := 'OnRequestGoFullScreen';

    $: LblStatus.Caption := 'OnRequestLeaveFullScreen';

    $: LblStatus.Caption := 'OnFatalError';

    $: LblStatus.Caption := 'OnWarning';

    $: LblStatus.Caption := 'OnRemoteDesktopSizeChange';

    $: LblStatus.Caption := 'OnIdleTimeoutNotification';

    $: LblStatus.Caption := 'OnRequestContainerMinimize';

    $: LblStatus.Caption := 'OnConfirmClose';

    $: LblStatus.Caption := 'OnReceivedTSPublicKey';

    $: LblStatus.Caption := 'OnAutoReconnecting';

    $: LblStatus.Caption := 'OnAuthenticationWarningDisplayed';

    $: LblStatus.Caption := 'OnAuthenticationWarningDismissed';

  end

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  InitAtl;

end;

function TForm1.InitAtl: Boolean;

var

  hModule, hDll: THandle;

  AtlAxAttachControl: TAtlAxAttachControl;

begin

  hModule := LoadLibrary('atl.dll');

  if hModule <  then begin

    Exit(False);

  end;

  AtlAxAttachControl := TAtlAxAttachControl(GetProcAddress(hModule, 'AtlAxAttachControl'));

  EventSink := TEventSink.Create(Self);

  EventSink.OnInvoke := EventSinkInvoke;

  if not Assigned(AtlAxAttachControl) then

    Exit(False);

  try

    {--后期绑定}

//    ActiveXCon := CreateComObject(CLASS_MsRdpClient); //CreateOleObject('Shell.Explorer');  //CreateComObject(CLASS_MsRdpClient);

    {--前期绑定}

    hDll := LoadLibrary('mstscax.dll');

    ActiveXCon := CreateComObjectFromDll(CLASS_MsRdpClient, hDll) as IDispatch;

//    if Assigned(ActiveXCon) then begin

//

//    end;

    if VarIsNull(ActiveXCon) then begin

      Result := False;

      Exit;

    end;

    EventSink.Connect(ActiveXCon, IMsTscAxEvents);

    AtlAxAttachControl(ActiveXCon,pnlCom.Handle, nil);

//    ActiveXCon.GoHome;

    ActiveXCon.Server := '192.168.8.65';

    ActiveXCon.UserName := 'Va_admin';

    ActiveXCon.AdvancedSettings2.ClearTextPassword := 'Va5!1232';

    ActiveXCon.Connect;

    Result := True;

  except

    Result := False;

  end;

end;

end.

事件单元:

unit EventSink;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,

  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,

  Winapi.ActiveX;

type

  TInvokeEvent = procedure(Sender: TObject; DispID: Integer; const IID: TGUID;

    LocaleID: Integer; Flags: Word; Params: TDispParams;

    VarResult, ExcepInfo, ArgErr: Pointer) of object;

  TAbstractEventSink = class(TObject, IUnknown, IDispatch)

  private

    FDispatch: IDispatch;

    FDispIntfIID: TGUID;

    FConnection: LongInt;

    FOwner: TComponent;

  protected

    { IUnknown }

    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;

    function _AddRef: Integer; stdcall;

    function _Release: Integer; stdcall;

    { IDispatch }

    function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;

    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo)

      : HRESULT; stdcall;

    function GetIDsOfNames(const IID: TGUID; Names: Pointer;

      NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;

    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer)

      : HRESULT; stdcall;

  public

    constructor Create(AOwner: TComponent);

    destructor Destroy; override;

    procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);

    procedure Disconnect;

  end;

  TEventSink = class(TComponent)

  private

    { Private declarations }

    FSink: TAbstractEventSink;

    FOnInvoke: TInvokeEvent;

  protected

    { Protected declarations }

    procedure DoInvoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer); virtual;

  public

    { Public declarations }

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);

  published

    { Published declarations }

    property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;

  end;

implementation

uses

  ComObj;

procedure InterfaceConnect(const Source: IUnknown; const IID: TIID;

  const Sink: IUnknown; var Connection: LongInt);

var

  CPC: IConnectionPointContainer;

  CP: IConnectionPoint;

  i: HRESULT;

begin

  Connection := ;

  if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then

    if Succeeded(CPC.FindConnectionPoint(IID, CP)) then

      i := CP.Advise(Sink, Connection);

end;

procedure InterfaceDisconnect(const Source: IUnknown; const IID: TIID;

  var Connection: LongInt);

var

  CPC: IConnectionPointContainer;

  CP: IConnectionPoint;

begin

  if Connection <>  then

    if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then

      if Succeeded(CPC.FindConnectionPoint(IID, CP)) then

        if Succeeded(CP.Unadvise(Connection)) then

          Connection := ;

end;

{ TAbstractEventSink }

function TAbstractEventSink._AddRef: Integer; stdcall;

begin

  Result := ;

end;

function TAbstractEventSink._Release: Integer; stdcall;

begin

  Result := ;

end;

constructor TAbstractEventSink.Create(AOwner: TComponent);

begin

  inherited Create;

  FOwner := AOwner;

end;

destructor TAbstractEventSink.Destroy;

var

  p: Pointer;

begin

  Disconnect;

  inherited Destroy;

end;

function TAbstractEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;

  NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;

begin

  Result := E_NOTIMPL;

end;

function TAbstractEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo)

  : HRESULT; stdcall;

begin

  Result := E_NOTIMPL;

end;

function TAbstractEventSink.GetTypeInfoCount(out Count: Integer)

  : HRESULT; stdcall;

begin

  Count := ;

  Result := S_OK;

end;

function TAbstractEventSink.Invoke(DispID: Integer; const IID: TGUID;

  LocaleID: Integer; Flags: Word; var Params;

  VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;

begin

  (FOwner as TEventSink).DoInvoke(DispID, IID, LocaleID, Flags, Params,

    VarResult, ExcepInfo, ArgErr);

  Result := S_OK;

end;

function TAbstractEventSink.QueryInterface(const IID: TGUID; out Obj)

  : HRESULT; stdcall;

begin

  // We need to return the event interface when it's asked for

  Result := E_NOINTERFACE;

  if GetInterface(IID, Obj) then

    Result := S_OK;

  if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch, Obj) then

    Result := S_OK;

end;

procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch;

  const AnAppDispIntfIID: TGUID);

begin

  FDispIntfIID := AnAppDispIntfIID;

  FDispatch := AnAppDispatch;

  // Hook the sink up to the automation server

  InterfaceConnect(FDispatch, FDispIntfIID, Self, FConnection);

end;

procedure TAbstractEventSink.Disconnect;

begin

  if Assigned(FDispatch) then

  begin

    // Unhook the sink from the automation server

    InterfaceDisconnect(FDispatch, FDispIntfIID, FConnection);

    FDispatch := nil;

    FConnection := ;

  end;

end;

{ TEventSink }

procedure TEventSink.Connect(AnAppDispatch: IDispatch;

  const AnAppDispIntfIID: TGUID);

begin

  FSink.Connect(AnAppDispatch, AnAppDispIntfIID);

end;

constructor TEventSink.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FSink := TAbstractEventSink.Create(Self);

end;

destructor TEventSink.Destroy;

begin

  FSink.Free;

  inherited Destroy;

end;

procedure TEventSink.DoInvoke(DispID: Integer; const IID: TGUID;

  LocaleID: Integer; Flags: Word; var Params;

  VarResult, ExcepInfo, ArgErr: Pointer);

begin

  if Assigned(FOnInvoke) then

    FOnInvoke(Self, DispID, IID, LocaleID, Flags, TDispParams(Params),

      VarResult, ExcepInfo, ArgErr);

end;

end.

效果图:

Delphi不注册COM直接使用ActiveX控件并绑定事件的更多相关文章

  1. 【VS开发】动态添加的ActiveX控件如何响应事件

    http://blog.csdn.net/xiaoqiqixiao/article/details/574542 今天在csdn上看到一朋友问如何响应动态添加的控件的事件,搜索资料,发现对于一般的应用 ...

  2. Wix中注册c#开发的Activex控件

    一.使用regasm.exe将DLL提取出TLB文件 regasm.exe "Tools.HMIBrowserDetector.dll" /tlb 二.使用wix的heat.exe ...

  3. ActiveX控件的Events事件

    http://labview360.com/article/info.asp?TID=10152&FID=165 Active X函式库 对使用LabVIEW作为开发环境的开发人员来说,如果能 ...

  4. Delphi 编写ActiveX控件（OCX控件）的知识和样例（有详细步骤）

    一.ActiveX应用情况简介: ActiveX控件也就是一般所说的OCX控件,它是 ActiveX技术的一部分.ActiveX是微软公司推出的基于组件对象模型COM的技术,包括对Windows 32 ...

  5. 【VS开发】windows注册ActiveX控件

    ActiveX控件是一个动态链接库,是作为基于COM服务器进行操作的,并且可以嵌入在包容器宿主应用程序中,ActiveX控件的前身就是OLE控件.由于ActiveX控件与开发平台无关,因此,在一种编程 ...

  6. ActiveX控件的基本操作方法以及如何在VS2010下使用控件

    在此,小编就介绍下ActiveX控件的基本操作方法以及如何在VS2010下使用控件,我们以一个程序为例, (1)      打开VS2010编译器(右键以管理员身份运行,因为ActiveX需要注册), ...

  7. ActiveX控件

    什么是ActiveX控件:一个进程内服务器,支持多种的COM接口.(可以理解为,一个COM接口是一个纯抽象基类,你实现了它,并且它支持自注册,就是一个ActiveX控件了)可以把ActiveX控件看做 ...

  8. 建立对ActiveX控件的了解

    本文来自百度百科:ActiveX控件   ActiveX是Microsoft对于一系列策略性面向对象程序技术和工具的称呼,其中主要的技术是组件对象模型(COM).在有目录和其它支持的网络中,COM变成 ...

  9. 开发ActiveX控件调用另一个ActiveX系列0——身份证识别仪驱动的问题

    程序员要从0下表开始,这篇是介绍这个系列的背景的,没有兴趣的人可以直接跳过. 为什么要开发ActiveX控件 由于工作需要,我们开发了一个网站,使用了一款身份证识别仪的网页ActiveX(OCX)插件 ...

随机推荐

  1. PHP: POST Content-Length of xxx bytes exceeds the limit of 8388608 bytes

    用户上传了 4 个附件,每个小于 5M,但是总大小超过了 15 M. 在 Nginx 日志中找到了如下错误信息,还没有到 Laravel 日志那一层. 2018/08/13 10:14:38 [err ...

  2. appium自动化测试之元素定位

    方法一 使用SDK中附带的uiautomatorviewer来定位 在SDK安装目录下的tools下有个uiautomatorviewer.bat批处理文件点击运行 运行后(注意appium desk ...

  3. Linux学习笔记：scp远程拷贝文件

    scp是secure copy的简写,用于Linux下进行远程拷贝文件的命令,类似的有cp,不过cp仅在本机上进行拷贝不能跨服务器. 命令格式: scp [参数] [原路径] [目标路径] -q 不显 ...

  4. 【APUE | 7】命令形参、函数

    命令形参 命令行参数是使用main()函数参数来处理的,其中,argc是指传入参数的个数,argv[]是一个指针数组,指向传递给程序的每个参数. 应当指出的是, argv[0]存储程序的名称,argv ...

  5. kotlin 插件更新到 1.2.41 程序出错 Please use kotlin-stdlib-jdk7 instead

    buildscript { ext.kotlin_version = '1.2.41' repositories { google() jcenter() } dependencies { class ...

  6. struts2使用拦截器完成登陆显示用户信息操作和Struts2的国际化

    其实学习框架,就是为了可以很好的很快的完成我们的需求,而学习struts2只是为了替代之前用的servlet这一层,框架使开发更加简单,所以作为一个小菜鸟,特别感谢那些超级无敌变态开发的框架供我们使用 ...

  7. vtiger二次开发

    搞了快两个星期的vtiger,慢慢的摸索到了一些东西 数据库相当的复杂,已有的模块我只是分析了下页面的加载,方法的调用 大部分时间在研究怎么添加新的功能模块,今天才知道模块可以通过输入命令的方式来添加 ...

  8. C#连接oracle连接字符串

    /// <summary> /// Oracle 的数据库连接字符串. /// </summary> private const String connString = @&q ...

  9. Codeforces 514E Darth Vader and Tree 矩阵快速幂

    Darth Vader and Tree 感觉是个很裸的矩阵快速幂, 搞个100 × 100 的矩阵, 直接转移就好啦. #include<bits/stdc++.h> #define L ...

  10. 6-8 树 uva548

    read 的方式值得学习 当不知道每一行有多少个输入的时候 getline  在弄成stringstream!一个一个处理 用built递归的方式化大为小进行建立树 dfs 遍历整个树来求最值 变量的 ...