首页  编辑  

DCOM调用 VS 回调机制例程

Tags: /超级猛料/Friends.网友专栏/ihihonline(小小)/   Date Created:

前边帖的没有完整的说明，这次将会有详细的说明以供各位参考

{=======================DCOM调用 VS 回调机制例程=======================

作者：小小；

创建日期：2002-10-24 01:49(凌晨，呵呵)

调试工具：Delphi6 VS Windows 2000;

参考文献：大脑，呵呵:)

信息反馈：dprogram@nxrs.net

交    流www.nxrs.net/bbs

=========================================================================}

unit ClientM;  /////////客户端窗体；

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls,ComObj,Server_TLB,MConnect, DB, DBClient, SConnect,ActiveX,

 ComServ;

type

 TClientCallBack = 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);

 private

   FClientCallBack : TClientCallBack;

   /////////这一句是接口正真的实例化；

   { Private declarations }

 public

   MyDCOMConnection : TDispatchConnection;

   //////注意这一句：TDispatchConnection 是如下定义的：

   //////TDispatchConnection = class(TCustomRemoteServer)

   { Public declarations }

 end;

var

 Form2: TForm2;

 ClientVar : IDCOMServerSL1;

 //////////////////////////////////////////////////////////////////////////////

 //////定义一个接口，是TypeLib中声明的哦；uses Server_TLB,(User TypeLib)

 //////////////////////////////////////////////////////////////////////////////

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);

begin

 ClientVar := CoDCOMServerSL1.Create;

 if ClientVar.GetInfo(Edit1.Text,Edit2.Text) then

 begin

   Application.MessageBox('恭喜您，登录成功！','操作提示',MB_OK + MB_ICONINFORMATION);

 end else

 begin

   Application.MessageBox('对不起，登录失败！','操作提示',MB_OK + MB_ICONINFORMATION);

 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);

var

 TypeLib : ITypeLib;

begin

 MyDCOMConnection := SocketConnection1;

 MyDCOMConnection.Connected := True;

 OLECheck(LoadRegTypeLib(LIBID_Server,0,0,1,TypeLib));

 MyDCOMConnection.AppServer.GetInfos(FClientCallBack as IDispatch);

 {/////////////////////////////////////////////////////////////////////////////

 //////MyDCOMConnection := SocketConnection1;是回调的关键，你要用它来代替TSocketConnection,操作还是类实例之间，你明白吗？

 //////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);

begin

 ShowMessage(InfoName);

 ShowMessage(InfoPass);

 {/////////////////////////////////////////////////////////////////////////////

 /////我不知道你是否知道RDM中是如果引用接口的，这和它是一样的；

 //////////////////////////////////////////////////////////////////////////////}

end;

end.

{=======================DCOM调用 VS 回调机制例程=======================

作者：小小；

创建日期：2002-10-24 01:49(凌晨，呵呵)

调试工具：Delphi6 VS Windows 2000;

参考文献：大脑，呵呵:)

信息反馈：dprogram@nxrs.net

交    www.nxrs.net/bbs

=========================================================================}

unit ServerRDM; ////////远程数据模块，是回调机制用的，于DCOM无关；

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

 Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,

 DBClient, Server_TLB, StdVcl;

type

 TDCOMBackCall = class(TRemoteDataModule, IDCOMBackCall)

 private

   BackCallSL : OleVariant;

   { Private declarations }

 protected

   class 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, ProgID: string);

begin

 if Register then

 begin

   inherited UpdateRegistry(Register, ClassID, ProgID);

   EnableSocketTransport(ClassID);

   EnableWebTransport(ClassID);

 end else

 begin

   DisableSocketTransport(ClassID);

   DisableWebTransport(ClassID);

   inherited UpdateRegistry(Register, ClassID, ProgID);

 end;

end;

procedure TDCOMBackCall.GetInfos(var Infos: OleVariant);

begin

 BackCallSl := Infos;

 BackCallSl.SetInfo('a','b');

 {////////////////////////////////////////////////

 ///////BackCallSl := Infos;(还记得这个参数传过来的是什么吗？呵呵，看前边去；)

 /////回调，可以由任意事件进行激发

 /////////////////////////////////////////////////  }

end;

initialization

 TComponentFactory.Create(ComServer, TDCOMBackCall,

   Class_DCOMBackCall, ciMultiInstance, tmApartment);

end.

]{=======================DCOM调用 VS 回调机制例程=======================

作者：小小；

创建日期：2002-10-24 01:49(凌晨，呵呵)

调试工具：Delphi6 VS Windows 2000;

参考文献：大脑，呵呵:)

信息反馈：dprogram@nxrs.net

交    www.nxrs.net/bbs

=========================================================================}

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:\练习\Midas\DCOM\200210232330\Server.tlb (1)

// LIBID: {4C13B05F-CEBC-4CEF-9B10-C0C6C5381A70}

// LCID: 0

// Helpfile:

// DepndLst:

//   (1) v2.0 stdole, (C:\WINNT\System32\stdole2.tlb)

//   (2) v4.0 StdVCL, (C:\WINNT\System32\stdvcl40.dll)

//   (3) v1.0 Midas, (C:\WINNT\System32\midas.dll)

// ************************************************************************ //

{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.

{$WARN SYMBOL_PLATFORM OFF}

{$WRITEABLECONST ON}

interface

uses 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 versions

 ServerMajorVersion = 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}

// *********************************************************************//

 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 = class

   class 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 = class

   class function Create: IDCOMBackCall;

   class function CreateRemote(const MachineName: string): IDCOMBackCall;

 end;

implementation

uses ComObj;

class function CoDCOMServerSL1.Create: IDCOMServerSL1;

begin

 Result := CreateComObject(CLASS_DCOMServerSL1) as IDCOMServerSL1;

end;

class function CoDCOMServerSL1.CreateRemote(const MachineName: string): IDCOMServerSL1;

begin

 Result := CreateRemoteComObject(MachineName, CLASS_DCOMServerSL1) as IDCOMServerSL1;

end;

class function CoDCOMBackCall.Create: IDCOMBackCall;

begin

 Result := CreateComObject(CLASS_DCOMBackCall) as IDCOMBackCall;

end;

class function CoDCOMBackCall.CreateRemote(const MachineName: string): IDCOMBackCall;

begin

 Result := CreateRemoteComObject(MachineName, CLASS_DCOMBackCall) as IDCOMBackCall;

end;

end.

{=======================DCOM调用 VS 回调机制例程=======================

作者：小小；

创建日期：2002-10-24 01:49(凌晨，呵呵)

调试工具：Delphi6 VS Windows 2000;

参考文献：大脑，呵呵:)

信息反馈：dprogram@nxrs.net

交    www.nxrs.net/bbs

=========================================================================}

unit SLXK;//////////DCOM，与回调无关

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

 ComObj, ActiveX, Server_TLB, StdVcl;

type

 TDCOMServerSL1 = class(TAutoObject, IDCOMServerSL1)

 protected

   function GetInfo(const UserName, Pass: WideString): WordBool; safecall;

   procedure Call; safecall;

   { Protected declarations }

 end;

implementation

uses

 ServerM ,ComServ;

function TDCOMServerSL1.GetInfo(const UserName,

 Pass: WideString): WordBool;

begin

 if ( UserName <>'Server' ) or (Pass <>'Admin') then

 begin

   Result := False

 end else

 begin

   Result := True;

   Form1.Label1.Caption := '客户成功登录';

 end;

 {//////////////////////////////////////////////////////////////////////////////

 /////////这个自己分析，如果说不会，那就惨喽

 //////////////////////////////////////////////////////////////////////////////}

end;

procedure TDCOMServerSL1.Call;

begin

 ShowMessage('aa'); //// or GetInfo(UserName,Pass);

end;

initialization

 TAutoObjectFactory.Create(ComServer, TDCOMServerSL1, Class_DCOMServerSL1,

   ciMultiInstance, tmApartment);

end.

{=======================DCOM调用 VS 回调机制例程=======================

作者：小小；

创建日期：2002-10-24 01:49(凌晨，呵呵)

调试工具：Delphi6 VS Windows 2000;

参考文献：大脑，呵呵:)

信息反馈：dprogram@nxrs.net

交    www.nxrs.net/bbs

=========================================================================}

//////////索性将服务应用程序也贴上，没有作用的，就是用来标示客户是否可以正确连接

unit ServerM;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls;

type

 TForm1 = class(TForm)

   Label1: TLabel;

 private

   { Private declarations }

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

end.