Delphi不注册COM直接使用ActiveX控件并绑定事件.docx
- 文档编号:5979323
- 上传时间:2023-01-02
- 格式:DOCX
- 页数:4
- 大小:16.99KB
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:
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Delphi 注册 COM 直接 使用 ActiveX 控件 绑定 事件