Delphi不注册COM直接使用ActiveX控件并绑定事件.docx
《Delphi不注册COM直接使用ActiveX控件并绑定事件.docx》由会员分享，可在线阅读，更多相关《Delphi不注册COM直接使用ActiveX控件并绑定事件.docx（4页珍藏版）》请在冰豆网上搜索。
Delphi不注册COM直接使用ActiveX控件并绑定事件
Delphi不注册COM直接使用ActiveX控件并绑定事件
文笔不行,直接上源码:
主窗口:
[delphi]viewplaincopyunitUnit1;interfaceusesWinapi.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;typeTForm1=class（TForm）pnlCom:
TPanel;Panel2:
TPanel;Panel3:
TPanel;btnGo:
TButton;edt1:
TEdit;LblStatus:
TLabel;procedureFormCreate（Sender:
TObject）;procedurebtnGoClick（Sender:
TObject）;private{Privatedeclarations}EventSink:
TEventSink;ActiveXCon:
Variant;functionInitAtl:
Boolean;procedureEventSinkInvoke（Sender:
TObject;DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;Params:
tagDISPPARAMS;VarResult,ExcepInfo,ArgErr:
Pointer）;public{Publicdeclarations}end;varForm1:
TForm1;constCLASS_MsRdpClient:
TGUID='{7CACBD7B-0D99-468F-AC33-22E495C0AFE5}';//'{791FA017-2DE3-492E-ACC5-53C67A2B94D0}';typePIUnknown=^IUnknown;TAtlAxAttachControl=function（Control:
IUnknown;hwind:
hwnd;ppUnkContainer:
PIUnknown）:
HRESULT;stdcall;//--此处参考mstscax.dll的接口文件，如果没有，在Component->ImportComponent->ImportaTypeLibrary//--导入：
MicrosoftTerminalServicesActiveClient1.0TypeLibrary1.0IMsTscAxEvents=dispinterface['{336D5562-EFA8-482E-8CB3-C5C0FC7A7DB6}']{procedureOnConnecting;dispid1;procedureOnConnected;dispid2;procedureOnLoginComplete;dispid3;procedureOnDisconnected（discReason:
Integer）;dispid4;procedureOnEnterFullScreenMode;dispid5;procedureOnLeaveFullScreenMode;dispid6;procedureOnChannelReceivedData（constchanName:
WideString;constdata:
WideString）;dispid7;procedureOnRequestGoFullScreen;dispid8;procedureOnRequestLeaveFullScreen;dispid9;procedureOnFatalError（errorCode:
Integer）;dispid10;procedureOnWarning（warningCode:
Integer）;dispid11;procedureOnRemoteDesktopSizeChange（width:
Integer;height:
Integer）;dispid12;procedureOnIdleTimeoutNotification;dispid13;procedureOnRequestContainerMinimize;dispid14;functionOnConfirmClose:
WordBool;dispid15;functionOnReceivedTSPublicKey（constpublicKey:
WideString）:
WordBool;dispid16;functionOnAutoReconnecting（disconnectReason:
Integer;attemptCount:
Integer）:
AutoReconnectContinueState;dispid17;procedureOnAuthenticationWarningDisplayed;dispid18;procedureOnAuthenticationWarningDismissed;dispid19;}end;implementation{$R*.dfm}{TForm1}functionCreateComObjectFromDll（CLSID:
TGUID;DllHandle:
THandle）:
IUnknown;varFactory:
IClassFactory;DllGetClassObject:
function（constCLSID,IID:
TGUID;varObj）:
HResult;stdcall;hr:
HRESULT;beginDllGetClassObject:
=GetProcAddress（DllHandle,'DllGetClassObject'）;ifAssigned（DllGetClassObject）thenbeginhr:
=DllGetClassObject（CLSID,IClassFactory,Factory）;ifhr=S_OKthentryhr:
=Factory.CreateInstance（nil,IUnknown,Result）;ifhr<>S_OKthenbeginShowMessage（'Error'）;end;exceptShowMessage（IntToStr（GetLastError））;end;end;end;procedureTForm1.btnGoClick（Sender:
TObject）;beginActiveXCon.Navigate（edt1.Text）;end;procedureTForm1.EventSinkInvoke（Sender:
TObject;DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;Params:
tagDISPPARAMS;VarResult,ExcepInfo,ArgErr:
Pointer）;begin<p>{这里需要注明Params这个参数,包含了事件的参数如：
Params.rgvarg[0]代表第一个参数Params.rgvarg[1]代表第二个参数......Params.rgvarg[65535]代表第65535个参数最多65535个参数具体可以参考tagDISPPARAMS的定义</p><p>这里只列出了怎么扑获相关事件，具体功能具体实现}</p>casedispidof$00000001:
LblStatus.Caption:
='正在连接';$00000002:
LblStatus.Caption:
='连接成功';$00000003:
LblStatus.Caption:
='登陆成功';$00000004:
LblStatus.Caption:
='断开连接';$00000005:
LblStatus.Caption:
='进入全屏模式';$00000006:
LblStatus.Caption:
='离开全屏模式';$00000007:
LblStatus.Caption:
='通道接收数据';$00000008:
LblStatus.Caption:
='OnRequestGoFullScreen';$00000009:
LblStatus.Caption:
='OnRequestLeaveFullScreen';$00000010:
LblStatus.Caption:
='OnFatalError';$00000011:
LblStatus.Caption:
='OnWarning';$00000012:
LblStatus.Caption:
='OnRemoteDesktopSizeChange';$00000013:
LblStatus.Caption:
='OnIdleTimeoutNotification';$00000014:
LblStatus.Caption:
='OnRequestContainerMinimize';$00000015:
LblStatus.Caption:
='OnConfirmClose';$00000016:
LblStatus.Caption:
='OnReceivedTSPublicKey';$00000017:
LblStatus.Caption:
='OnAutoReconnecting';$00000018:
LblStatus.Caption:
='OnAuthenticationWarningDisplayed';$00000019:
LblStatus.Caption:
='OnAuthenticationWarningDismissed';endend;procedureTForm1.FormCreate（Sender:
TObject）;beginInitAtl;end;functionTForm1.InitAtl:
Boolean;varhModule,hDll:
THandle;AtlAxAttachControl:
TAtlAxAttachControl;beginhModule:
=LoadLibrary（'atl.dll'）;ifhModule<32thenbeginExit（False）;end;AtlAxAttachControl:
=TAtlAxAttachControl（GetProcAddress（hModule,'AtlAxAttachControl'））;EventSink:
=TEventSink.Create（Self）;EventSink.OnInvoke:
=EventSinkInvoke;ifnotAssigned（AtlAxAttachControl）thenExit（False）;try{--后期绑定}//ActiveXCon:
=CreateComObject（CLASS_MsRdpClient）;//CreateOleObject（'Shell.Explorer'）;//CreateComObject（CLASS_MsRdpClient）;{--前期绑定}hDll:
=LoadLibrary（'mstscax.dll'）;ActiveXCon:
=CreateComObjectFromDll（CLASS_MsRdpClient,hDll）asIDispatch;//ifAssigned（ActiveXCon）thenbegin////end;ifVarIsNull（ActiveXCon）thenbeginResult:
=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;exceptResult:
=False;end;end;end.
事件单元:
[delphi]viewplaincopyunitEventSink;interfaceusesWinapi.Windows,Winapi.Messages,System.SysUtils,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Winapi.ActiveX;typeTInvokeEvent=procedure（Sender:
TObject;DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;Params:
TDispParams;VarResult,ExcepInfo,ArgErr:
Pointer）ofobject;TAbstractEventSink=class（TObject,IUnknown,IDispatch）privateFDispatch:
IDispatch;FDispIntfIID:
TGUID;FConnection:
LongInt;FOwner:
TComponent;protected{IUnknown}functionQueryInterface（constIID:
TGUID;outObj）:
HRESULT;stdcall;function_AddRef:
Integer;stdcall;function_Release:
Integer;stdcall;{IDispatch}functionGetTypeInfoCount（outCount:
Integer）:
HRESULT;stdcall;functionGetTypeInfo（Index,LocaleID:
Integer;outTypeInfo）:
HRESULT;stdcall;functionGetIDsOfNames（constIID:
TGUID;Names:
Pointer;NameCount,LocaleID:
Integer;DispIDs:
Pointer）:
HRESULT;stdcall;functionInvoke（DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;varParams;VarResult,ExcepInfo,ArgErr:
Pointer）:
HRESULT;stdcall;publicconstructorCreate（AOwner:
TComponent）;destructorDestroy;override;procedureConnect（AnAppDispatch:
IDispatch;constAnAppDispIntfIID:
TGUID）;procedureDisconnect;end;TEventSink=class（TComponent）private{Privatedeclarations}FSink:
TAbstractEventSink;FOnInvoke:
TInvokeEvent;protected{Protecteddeclarations}procedureDoInvoke（DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;varParams;VarResult,ExcepInfo,ArgErr:
Pointer）;virtual;public{Publicdeclarations}constructorCreate（AOwner:
TComponent）;override;destructorDestroy;override;procedureConnect（AnAppDispatch:
IDispatch;constAnAppDispIntfIID:
TGUID）;published{Publisheddeclarations}propertyOnInvoke:
TInvokeEventreadFOnInvokewriteFOnInvoke;end;implementationusesComObj;procedureInterfaceConnect（constSource:
IUnknown;constIID:
TIID;constSink:
IUnknown;varConnection:
LongInt）;varCPC:
IConnectionPointContainer;CP:
IConnectionPoint;i:
HRESULT;beginConnection:
=0;ifSucceeded（Source.QueryInterface（IConnectionPointContainer,CPC））thenifSucceeded（CPC.FindConnectionPoint（IID,CP））theni:
=CP.Advise（Sink,Connection）;end;procedureInterfaceDisconnect（constSource:
IUnknown;constIID:
TIID;varConnection:
LongInt）;varCPC:
IConnectionPointContainer;CP:
IConnectionPoint;beginifConnection<>0thenifSucceeded（Source.QueryInterface（IConnectionPointContainer,CPC））thenifSucceeded（CPC.FindConnectionPoint（IID,CP））thenifSucceeded（CP.Unadvise（Connection））thenConnection:
=0;end;{TAbstractEventSink}functionTAbstractEventSink._AddRef:
Integer;stdcall;beginResult:
=2;end;functionTAbstractEventSink._Release:
Integer;stdcall;beginResult:
=1;end;constructorTAbstractEventSink.Create（AOwner:
TComponent）;begininheritedCreate;FOwner:
=AOwner;end;destructorTAbstractEventSink.Destroy;varp:
Pointer;beginDisconnect;inheritedDestroy;end;functionTAbstractEventSink.GetIDsOfNames（constIID:
TGUID;Names:
Pointer;NameCount,LocaleID:
Integer;DispIDs:
Pointer）:
HRESULT;stdcall;beginResult:
=E_NOTIMPL;end;functionTAbstractEventSink.GetTypeInfo（Index,LocaleID:
Integer;outTypeInfo）:
HRESULT;stdcall;beginResult:
=E_NOTIMPL;end;functionTAbstractEventSink.GetTypeInfoCount（outCount:
Integer）:
HRESULT;stdcall;beginCount:
=0;Result:
=S_OK;end;functionTAbstractEventSink.Invoke（DispID:
Integer;constIID:
TGUID;LocaleID:
Integer;Flags:
Word;varParams;VarResult,ExcepInfo,ArgErr:
Pointer）:
HRESULT;stdcall;begin（FOwnerasTEventSink）.DoInvoke（DispID,IID,LocaleID,Flags,Params,VarResult,ExcepInfo,ArgErr）;Result:
=S_OK;end;functionTAbstractEventSink.QueryInterface（constIID:
TGUID;outObj）:
HRESULT;stdcall;begin//Weneedtoreturntheeventinterfacewhenit'saskedforResult:
=E_NOINTERFACE;ifGetInterface（IID,Obj）thenResult:
=S_OK;ifIsEqualGUID（IID,FDispIntfIID）andGetInterface（IDispatch,Obj）thenResult:
=S_OK;end;procedureTAbstractEventSink.Connect（AnAppDispatch:
IDispatch;constAnAppDispIntfIID:
TGUID）;beginFDispIntfIID:
=AnAppDispIntfIID;FDispatch:
升级会员 