在多层结构中如何在服务器端回调客户端的过程或函数???

Question

第一个搞定的我派50分！

Answer 1

先说明一点，回调不支持TSocketConnection只支持TDcomConnection

Answer 2

{=======================DCOM调用 VS 回调机制例程=======================作者：小小；创建日期：2002-10-24 01:49(凌晨，呵呵)调试工具：Delphi6 VS Windows 2000;参考文献：大脑，呵呵:)信息反馈：[email protected]交 流www.nxrs.net/bbs=========================================================================}unit ClientM; /////////客户端窗体；interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls,ComObj,Server_TLB,MConnect, DB, DBClient, SConnect,ActiveX,ComServ;typeTClientCallBack = Class(TAutoIntfObject , IDCOMBackCalls)procedure SetInfo(var InfoName: OleVariant; var InfoPass: OleVariant); safecall;end;////////////////////////////////////////////////////////////////////////////////////////TClientCallBack = Class(TAutoIntfObject,IDCOMBackCalls) TClientCallBack 它继承类TAutoIntfObject//////////同时又是实现了接口IDCOMBackCalls,而这个接口是需要在TypeLib中声明的；///////////接口的实现，需要知道，之后还要进行类的实例化；///////////需要实现这个接口的方法　：SetInfo(.....) SafeCall ,注意，这儿只能用SafeCall;//////////下边有接口的实例化，FClientCallBack : TClientCallBack;//////////uses ComObj;////////////////////////////////////////////////////////////////////////////////
/TForm2 = class(TForm)Button1: TButton;Label1: TLabel;Label2: TLabel;Label3: TLabel;Edit1: TEdit;Edit2: TEdit;Edit3: TEdit;SocketConnection1: TSocketConnection;procedure Button1Click(Sender: TObject);procedure FormCreate(Sender: TObject);privateFClientCallBack : TClientCallBack;/////////这一句是接口正真的实例化；{ Private declarations }publicMyDCOMConnection : TDispatchConnection;//////注意这一句：TDispatchConnection 是如下定义的：//////TDispatchConnection = class(TCustomRemoteServer){ Public declarations }end;varForm2: TForm2;ClientVar : IDCOMServerSL1;////////////////////////////////////////////////////////////////////////////////////定义一个接口，是TypeLib中声明的哦；uses Server_TLB,(User TypeLib)//////////////////////////////////////////////////////////////////////////////implementation　{$R *.dfm}procedure TForm2.Button1Click(Sender: TObject);beginClientVar := CoDCOMServerSL1.Create;if ClientVar.GetInfo(Edit1.Text,Edit2.Text) thenbeginApplication.MessageBox('恭喜您，登录成功！','操作提示',MB_OK + MB_ICONINFORMATIO
N);end elsebeginApplication.MessageBox('对不起，登录失败！','操作提示',MB_OK + MB_ICONINFORMATIO
N);end;////////////////////////////////////////////////////////////////////////////////
//////////////MyDCOMConnection.AppServer.ProcName;，也可以用这种进行回调/////////CoDCOMBackCall = class/////////class function Create: IDCOMBackCall;////////class function CreateRemote(const MachineName: string): IDCOMBackCall;////////end;////////看一看它的定义，它其实是一个类，呵呵，协同接口类；是实现一个或多个接口的类，///////有一个类生成库和一个类标识器；///////这一部分是DCOM的，和回调无关；////////////////////////////////////////////////////////////////////////////////
///////end;{ TClientCallBack }　procedure TForm2.FormCreate(Sender: TObject);varTypeLib : ITypeLib;beginMyDCOMConnection := SocketConnection1;MyDCOMConnection.Connected := True;OLECheck(LoadRegTypeLib(LIBID_Server,0,0,1,TypeLib));MyDCOMConnection.AppServer.GetInfos(FClientCallBack as IDispatch);{///////////////////////////////////////////////////////////////////////////////////MyDCOMConnection := SocketConnection1;是回调的关键，你要用它来代替TSocketC
onnection,操作还是类实例之间，你明白吗？//////MyDCOMConnection.Connected := True;还用说吗？//////OLECheck(LoadRegTypeLib(LIBID_Server,0,0,1,TypeLib));在客户端注册；//////MyDCOMConnection.AppServer.GetInfos(FClientCallBack as IDispatch);开始执行
，而且进行接口转化；//////TypeLib : ITypeLib;可以应用类型库类 Uses ActiveX;//////////////////////////////////////////////////////////////////////////////}end;{ TClientCallBack }procedure TClientCallBack.SetInfo(var InfoName, InfoPass: OleVariant);beginShowMessage(InfoName);ShowMessage(InfoPass);{//////////////////////////////////////////////////////////////////////////////////我不知道你是否知道RDM中是如果引用接口的，这和它是一样的；//////////////////////////////////////////////////////////////////////////////}end;end.{=======================DCOM调用 VS 回调机制例程=======================作者：小小；创建日期：2002-10-24 01:49(凌晨，呵呵)调试工具：Delphi6 VS Windows 2000;参考文献：大脑，呵呵:)信息反馈：[email protected]交 www.nxrs.net/bbs=========================================================================}unit ServerRDM; ////////远程数据模块，是回调机制用的，于DCOM无关；{$WARN SYMBOL_PLATFORM OFF}interfaceusesWindows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,DBClient, Server_TLB, StdVcl;typeTDCOMBackCall = class(TRemoteDataModule, IDCOMBackCall)privateBackCallSL : OleVariant;{ Private declarations }protectedclass procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string)
; override;procedure GetInfos(var Infos: OleVariant); safecall;public{ Public declarations }end;implementation{$R *.DFM}class procedure TDCOMBackCall.UpdateRegistry(Register: Boolean; const ClassID, P
rogID: string);beginif Register thenbegininherited UpdateRegistry(Register, ClassID, ProgID);EnableSocketTransport(ClassID);EnableWebTransport(ClassID);end elsebeginDisableSocketTransport(ClassID);DisableWebTransport(ClassID);inherited UpdateRegistry(Register, ClassID, ProgID);end;end;procedure TDCOMBackCall.GetInfos(var Infos: OleVariant);beginBackCallSl := Infos;BackCallSl.SetInfo('a','b');{///////////////////////////////////////////////////////BackCallSl := Infos;(还记得这个参数传过来的是什么吗？呵呵，看前边去；)/////回调，可以由任意事件进行激发///////////////////////////////////////////////// }end;initializationTComponentFactory.Create(ComServer, TDCOMBackCall,Class_DCOMBackCall, ciMultiInstance, tmApartment);end.]{=======================DCOM调用 VS 回调机制例程=======================作者：小小；创建日期：2002-10-24 01:49(凌晨，呵呵)调试工具：Delphi6 VS Windows 2000;参考文献：大脑，呵呵:)信息反馈：[email protected]交 www.nxrs.net/bbs

Answer 3

=========================================================================}unit Server_TLB;// ************************************************************************ //// WARNING// -------// The types declared in this file were generated from data read from a// Type Library. If this type library is explicitly or indirectly (via// another type library referring to this type library) re-imported, or the// 'Refresh' command of the Type Library Editor activated while editing the// Type Library, the contents of this file will be regenerated and all// manual modifications will be lost.// ************************************************************************ //// PASTLWTR : $Revision: 1.130 $// File generated on 2002-11-24 0:46:21 from Type Library described below.// ************************************************************************ //// Type Lib: D:\u32451练习200210232330.tlb (1)// LIBID: {4C13B05F-CEBC-4CEF-9B10-C0C6C5381A70}// LCID: 0// Helpfile:// DepndLst:// (1) v2.0 stdole, (C:.tlb)// (2) v4.0 StdVCL, (C:.dll)// (3) v1.0 Midas, (C:.dll)// ************************************************************************ //{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.{$WARN SYMBOL_PLATFORM OFF}{$WRITEABLECONST ON}interfaceuses ActiveX, Classes, Graphics, Midas, StdVCL, Variants, Windows;　　// *********************************************************************//// GUIDS declared in the TypeLibrary. Following prefixes are used:// Type Libraries : LIBID_xxxx// CoClasses : CLASS_xxxx// DISPInterfaces : DIID_xxxx// Non-DISP interfaces: IID_xxxx// *********************************************************************//const// TypeLibrary Major and minor versionsServerMajorVersion = 1;ServerMinorVersion = 0;LIBID_Server: TGUID = '{4C13B05F-CEBC-4CEF-9B10-C0C6C5381A70}';IID_IDCOMServerSL1: TGUID = '{3532A2E2-A14F-4C6F-BEDD-2E195668C084}';CLASS_DCOMServerSL1: TGUID = '{3D40FD5D-FFD8-4712-9C4A-2058FEA41C5C}';IID_IDCOMBackCall: TGUID = '{A9B9B314-662F-4B95-8282-7EFD3F78549E}';CLASS_DCOMBackCall: TGUID = '{B140EEA0-2115-433C-A8FB-3BD915B24FCC}';IID_IDCOMBackCalls: TGUID = '{6C16F66E-CF22-4E61-9F4F-82F5F1933154}';type// // Forward declaration of types defined in TypeLibrary// *********************************************************************//IDCOMServerSL1 = interface;IDCOMServerSL1Disp = dispinterface;IDCOMBackCall = interface;IDCOMBackCallDisp = dispinterface;IDCOMBackCalls = interface;IDCOMBackCallsDisp = dispinterface;// *********************************************************************//// Declaration of CoClasses defined in Type Library// (NOTE: Here we map each CoClass to its Default Interface)// *********************************************************************//DCOMServerSL1 = IDCOMServerSL1;DCOMBackCall = IDCOMBackCall;　// *********************************************************************//// Interface: IDCOMServerSL1// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {3532A2E2-A14F-4C6F-BEDD-2E195668C084}// *********************************************************************//IDCOMServerSL1 = interface(IDispatch)['{3532A2E2-A14F-4C6F-BEDD-2E195668C084}']function GetInfo(const UserName: WideString; const Pass: WideString): WordBool;
safecall;procedure Call; safecall;end;// *********************************************************************//// DispIntf: IDCOMServerSL1Disp// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {3532A2E2-A14F-4C6F-BEDD-2E195668C084}// *********************************************************************//IDCOMServerSL1Disp = dispinterface['{3532A2E2-A14F-4C6F-BEDD-2E195668C084}']function GetInfo(const UserName: WideString; const Pass: WideString): WordBool;
dispid 1;procedure Call; dispid 2;end;// *********************************************************************//// Interface: IDCOMBackCall// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {A9B9B314-662F-4B95-8282-7EFD3F78549E}// *********************************************************************//IDCOMBackCall = interface(IDispatch)['{A9B9B314-662F-4B95-8282-7EFD3F78549E}']procedure GetInfos(var Infos: OleVariant); safecall;end;// *********************************************************************//// DispIntf: IDCOMBackCallDisp// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {A9B9B314-662F-4B95-8282-7EFD3F78549E}// *********************************************************************//IDCOMBackCallDisp = dispinterface['{A9B9B314-662F-4B95-8282-7EFD3F78549E}']procedure GetInfos(var Infos: OleVariant); dispid 1;end;// *********************************************************************//// Interface: IDCOMBackCalls// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {6C16F66E-CF22-4E61-9F4F-82F5F1933154}// *********************************************************************//IDCOMBackCalls = interface(IDispatch)['{6C16F66E-CF22-4E61-9F4F-82F5F1933154}']procedure SetInfo(var InfoName: OleVariant; var InfoPass: OleVariant); safecall;end;// *********************************************************************//// DispIntf: IDCOMBackCallsDisp// Flags: (4416) Dual OleAutomation Dispatchable// GUID: {6C16F66E-CF22-4E61-9F4F-82F5F1933154}

Answer 4

// *********************************************************************//IDCOMBackCallsDisp = dispinterface['{6C16F66E-CF22-4E61-9F4F-82F5F1933154}']procedure SetInfo(var InfoName: OleVariant; var InfoPass: OleVariant); dispid 1;end;// *********************************************************************//// The Class CoDCOMServerSL1 provides a Create and CreateRemote method to// create instances of the default interface IDCOMServerSL1 exposed by// the CoClass DCOMServerSL1. The functions are intended to be used by// clients wishing to automate the CoClass objects exposed by the// server of this typelibrary.// *********************************************************************//CoDCOMServerSL1 = classclass function Create: IDCOMServerSL1;class function CreateRemote(const MachineName: string): IDCOMServerSL1;end;// *********************************************************************//// The Class CoDCOMBackCall provides a Create and CreateRemote method to// create instances of the default interface IDCOMBackCall exposed by// the CoClass DCOMBackCall. The functions are intended to be used by// clients wishing to automate the CoClass objects exposed by the// server of this typelibrary.// *********************************************************************//CoDCOMBackCall = classclass function Create: IDCOMBackCall;class function CreateRemote(const MachineName: string): IDCOMBackCall;end;implementationuses ComObj;class function CoDCOMServerSL1.Create: IDCOMServerSL1;beginResult := CreateComObject(CLASS_DCOMServerSL1) as IDCOMServerSL1;end;class function CoDCOMServerSL1.CreateRemote(const MachineName: string): IDCOMSer
verSL1;beginResult := CreateRemoteComObject(MachineName, CLASS_DCOMServerSL1) as IDCOMServer
SL1;end;class function CoDCOMBackCall.Create: IDCOMBackCall;beginResult := CreateComObject(CLASS_DCOMBackCall) as IDCOMBackCall;end;class function CoDCOMBackCall.CreateRemote(const MachineName: string): IDCOMBack
Call;beginResult := CreateRemoteComObject(MachineName, CLASS_DCOMBackCall) as IDCOMBackCal
l;end;end.{=======================DCOM调用 VS 回调机制例程=======================作者：小小；创建日期：2002-10-24 01:49(凌晨，呵呵)调试工具：Delphi6 VS Windows 2000;参考文献：大脑，呵呵:)信息反馈：[email protected]交 www.nxrs.net/bbs=========================================================================}unit SLXK;//////////DCOM，与回调无关{$WARN SYMBOL_PLATFORM OFF}interfaceusesComObj, ActiveX, Server_TLB, StdVcl;typeTDCOMServerSL1 = class(TAutoObject, IDCOMServerSL1)protectedfunction GetInfo(const UserName, Pass: WideString): WordBool; safecall;procedure Call; safecall;{ Protected declarations }end;implementationusesServerM ,ComServ;function TDCOMServerSL1.GetInfo(const UserName,Pass: WideString): WordBool;beginif ( UserName <>'Server' ) or (Pass <>'Admin') thenbeginResult := Falseend elsebeginResult := True;Form1.Label1.Caption := '客户成功登录';end;{///////////////////////////////////////////////////////////////////////////////////////这个自己分析，如果说不会，那就惨喽//////////////////////////////////////////////////////////////////////////////}end;procedure TDCOMServerSL1.Call;beginShowMessage('aa'); //// or GetInfo(UserName,Pass);end;initializationTAutoObjectFactory.Create(ComServer, TDCOMServerSL1, Class_DCOMServerSL1,ciMultiInstance, tmApartment);end.{=======================DCOM调用 VS 回调机制例程=======================作者：小小；创建日期：2002-10-24 01:49(凌晨，呵呵)调试工具：Delphi6 VS Windows 2000;参考文献：大脑，呵呵:)信息反馈：[email protected]交 www.nxrs.net/bbs=========================================================================}//////////索性将服务应用程序也贴上，没有作用的，就是用来标示客户是否可以正确连接unit ServerM;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTForm1 = class(TForm)Label1: TLabel;private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;implementation{$R *.dfm}end.