I
import
Unregistered / Unconfirmed
GUEST, unregistred user!
前边帖的没有完整的说明，这次将会有详细的说明以供各位参考 {=======================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:/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}
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.
作者：小小；
创建日期：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:/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}
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.