文笔不行,直接上源码:

主窗口:

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. Android GsmCellLocation.getCellLocation返回NULL

    Android GsmCellLocation.getCellLocation返回NULL 1.首先 获取服务 telephonyManager =(TelephonyManager)getSyste ...

  2. GO-time.after 用法

    初学GO,time包里sleep是最常用,今天突然看到一个time.after,特记录time.after用法笔记如下: 首先是time包里的定义 // After waits for the dur ...

  3. XPATH语法(二)

    节点(node) 在 XPath 中,有七种类型的节点:元素.属性.文本.命名空间.处理指令.注释以及文档(根)节点.XML 文档是被作为节点树来对待的.树的根被称为文档节点或者根节点. 以下面这xm ...

  4. html table标签

    table标签 table的基本样式 table表格的美化 table表格行合并和列合并 table的基本样式: https://blog.csdn.net/lilongsy/article/deta ...

  5. python----面向对象(2)

    反射 class ClassA: name = 'xiaoming' def __init__(self): self.y = 'y' #先执行 __setattr__ 在执行__getattribu ...

  6. hdu3015树状数组 poj1990的离散化版本

    都是一类题目,推导调试比较烦,想出来还是不难的 /* 给定n个点对,按一维升序排序一次,每个点的序号为Di,按二维升序排序一次,每个点的序号为Hi 求sum{w(i,j)} w(i,j)=abs(Di ...

  7. pychrame更换默认以unittest执行或取消单元测试框架执行

    选择某个测试框架运行脚本 File-> Settings -> Tools -> Python Integrated Tools -> Default test runner ...

  8. mvc中简单的异常记录

    说明:异常处理 1.1 在WebApp的Model中 添加异常处理类 继承于HandleErrorAttribute using System; using System.Collections.Ge ...

  9. oracle查询出来的时间吸附为每5min

    to_char(PACKET_TIME,'yyyy-mm-dd hh24:')||floor(to_char(PACKET_TIME,'mi')/5 )*5||':00' as start_time, ...

  10. DDD领域模型数据访问权限之权限（十二）

    实现权限的领域对象:BAS_Permission public partial class BAS_Permission:AggreateRoot { private IRepository<B ...