通过Dcom编程实现聊天功能,这样为什么不行??? 高手请进(150分),高手都到哪里去了。 (150分)

  • 主题发起人 主题发起人 yeath
  • 开始时间 开始时间
Y

yeath

Unregistered / Unconfirmed
GUEST, unregistred user!
远程数据模块代码如下(Unit2):
type
TEasyDcomServer = class(TRemoteDataModule, IEasyDcomServer)
DSP_A: TDataSetProvider;
private
CallBackTemp:OleVariant;
{ Private declarations }
protected
class procedure UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
override;
procedure Connect(vClient: OleVariant);
safecall;
public
procedure SendMsg(sMsg:WideString);
{ Public declarations }
end;

implementation
uses Unit1, ComCtrls;
{$R *.DFM}
class procedure TEasyDcomServer.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 TEasyDcomServer.Connect(vClient: OleVariant);
begin
Form1.mdata := self;
CallBackTemp := vClient;
end;

procedure TEasyDcomServer.SendMsg(sMsg: WideString);
begin
CallBackTemp.OnText(sMsg);
end;

initialization
TComponentFactory.Create(ComServer, TEasyDcomServer,
Class_EasyDcomServer, ciMultiInstance, tmApartment);
end.
 
中间层主窗体代码如下(先只要实现一个用户的功能):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,MConnect,Project1_TLB,Unit2, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
btn_Send: TButton;
Label2: TLabel;
Button2: TButton;
Edit1: TEdit;
ListView1: TListView;
procedure btn_SendClick(Sender: TObject);
private
{ Private declarations }
public
mdata:TEasyDcomServer;    //用于保存远程数据模块
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn_SendClick(Sender: TObject);   //发送按钮代码 
begin
                      
mdata.SendMsg('this is test');        //调用远程数据模块的发送功能。
end;

end.
 
客户端代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBClient, MConnect, Grids, DBGrids, ExtCtrls, DBCtrls,
StdCtrls, SConnect, ObjBrkr,Project1_TLB,comobj,ActiveX;
type
TEventHandle = class(TAutoIntfObject,ICallbackEvents)
procedure OnText(const sMsg: WideString);
safecall;
end;

TForm1 = class(TForm)
ClientDataSet1: TClientDataSet;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DataSource1: TDataSource;
Button1: TButton;
SocketConnection1: TSocketConnection;
Button2: TButton;
btn_connect: TButton;
procedure FormCreate(Sender: TObject);
procedure btn_connectClick(Sender: TObject);
private
{ Private declarations }
public
FCallBack:TEventHandle;
MyCallBackConnect : TDispatchConnection;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TEventHandle.OnText(const sMsg: WideString);
begin
                 //显示收到的信息。。。
showmessage(sMsg);
end;

procedure TForm1.FormCreate(Sender: TObject);
var                 //连接中间层服务器。。。
TypeLib:ITypeLib;
begin
OleCheck(LoadRegTypeLib(LIBID_Project1,1,0,0,TypeLib));
FCallBack := TEventHandle.Create(TypeLib,ICallbackEvents);
MyCallBackConnect := SocketConnection1;
MyCallBackConnect.Connected := True;
end;

procedure TForm1.btn_connectClick(Sender: TObject);
begin
              //通过Connect传递回调接口。
MyCallBackConnect.AppServer.Connect(FCallBack As IDispatch);
end;

end.
 
当我按中间层主窗体上的发送按钮时出现“应用程序调用一个已为另一线程整理的界面”的错误
信息,这是什么原因。高后帮忙。。。。
 
MyCallBackConnect.AppServer.Connect(FCallBack As IDispatch);
虽然效率高, 但很难应用(个人观点)
可能在中间层都没有传出来,你有没有试过,你在
CallBackTemp.OnText(sMsg);
加一句 showmessage('alskdjflkasdjf');
试试看,应该是前面。
 
我在CallBackTemp.Ontext(sMsg)前加了showmessage('sadkfjsd'),按发送能显示"sadkfjsd"
关键是一调用CallBackTemp.OnText(sMsg)就出现“应用程序调用一个已为另一线程整理的界面”
这个错误。  
 
高手都到哪里去了????   怎么都没人回答。。。。
 
忘了问一下, 你的客户端是IE的组件页面吗?
如果是请更换你的风格
procedure TEventHandle.OnText(const sMsg: WideString);
begin
                 //显示收到的信息。。。
Messagebox(0,sMsg,'提示',Mb_OK);
end;
 
to shuszj:还是没用,你有Email?我把程序发给你怎么样????   顺便把QQ留下吧。
 
仔细看了你写的程序, 好像应用层的接口函数都是人为定义的,
TEventHandle = class(TAutoIntfObject,ICallbackEvents)
在定义回调时最好是 TCallbackEvents = class(TAutoIntfObject,ICallbackEvents)
你可能少看这部分
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-10-23 10:29:16 from Type Library described below.
// ************************************************************************ //
// Type Lib: E:/练习/Midas/CallBack/200210230825/Server.tlb (1)
// LIBID: {C258D1BD-F961-4DC9-AA0F-EC5B7EE90A2A}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v1.0 Midas, (C:/WINNT/System32/midas.dll)
// (2) v2.0 stdole, (C:/WINNT/System32/STDOLE2.TLB)
// (3) v4.0 StdVCL, (C:/WINNT/System32/stdvcl40.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 = '{C258D1BD-F961-4DC9-AA0F-EC5B7EE90A2A}';
IID_ICallBack_SL: TGUID = '{0B0E5E7F-AC4D-4D84-9932-FE840A39949E}';
CLASS_CallBack_SL: TGUID = '{D7EE5F9F-E6C3-4B05-82F2-38885DC628DB}';
IID_ISL: TGUID = '{A58FF6EF-BB4C-4979-BBCA-741E9A80476C}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
ICallBack_SL = interface;
ICallBack_SLDisp = dispinterface;
ISL = interface;
ISLDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
CallBack_SL = ICallBack_SL;

// *********************************************************************//
// Interface: ICallBack_SL
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {0B0E5E7F-AC4D-4D84-9932-FE840A39949E}
// *********************************************************************//
ICallBack_SL = interface(IDispatch)
['{0B0E5E7F-AC4D-4D84-9932-FE840A39949E}']
procedure FromUser(var UserName: OleVariant);
safecall;
end;

// *********************************************************************//
// DispIntf: ICallBack_SLDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {0B0E5E7F-AC4D-4D84-9932-FE840A39949E}
// *********************************************************************//
ICallBack_SLDisp = dispinterface
['{0B0E5E7F-AC4D-4D84-9932-FE840A39949E}']
procedure FromUser(var UserName: OleVariant);
dispid 1;
end;

// *********************************************************************//
// Interface: ISL
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A58FF6EF-BB4C-4979-BBCA-741E9A80476C}
// *********************************************************************//
ISL = interface(IDispatch)
['{A58FF6EF-BB4C-4979-BBCA-741E9A80476C}']
procedure UserFrom;
safecall;
end;

// *********************************************************************//
// DispIntf: ISLDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A58FF6EF-BB4C-4979-BBCA-741E9A80476C}
// *********************************************************************//
ISLDisp = dispinterface
['{A58FF6EF-BB4C-4979-BBCA-741E9A80476C}']
procedure UserFrom;
dispid 1;
end;

// *********************************************************************//
// The Class CoCallBack_SL provides a Create and CreateRemote method to
// create instances of the default interface ICallBack_SL exposed by
// the CoClass CallBack_SL. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoCallBack_SL = class
class function Create: ICallBack_SL;
class function CreateRemote(const MachineName: string): ICallBack_SL;
end;

implementation
uses ComObj;
class function CoCallBack_SL.Create: ICallBack_SL;
begin
Result := CreateComObject(CLASS_CallBack_SL) as ICallBack_SL;
end;

class function CoCallBack_SL.CreateRemote(const MachineName: string): ICallBack_SL;
begin
Result := CreateRemoteComObject(MachineName, CLASS_CallBack_SL) as ICallBack_SL;
end;
 
我觉得可行的,
 
不是,我没有把Project1_TLB.pas的代码贴出来,我在远程数据模块的Connect方法里增加CallBackTemp.OnText('adsfkjsdf')
这一句,能回调成功,但是在应用层主Form里,执行
mdata.SendMsg('this is test'); 就出错。
 
关键是出现“应用程序调用一个已为另一线程整理的界面”这个错误,到底是什么原因???
搞也搞不清楚,快帮帮我吧。
 
分不够再加。。。。。
 
>>CallBackTemp.OnText('adsfkjsdf')
>>这一句,能回调成功
procedure OnText(const sMsg: WideString);
safecall;
改成 :procedure OnText(var sMsg: WideString);
safecall;
or procedure OnText(sMsg: WideString);
safecall;
or procedure OnText(sMsg: OleVariant);
safecall;
 
to shuszj:我把代码发给你吧,把你的QQ告诉我。  OK???
 
呵呵,不知,我就是用Tcp或Udp聊天没用过DCOM
 
我主要是想试验Com的回调接口,并不是要实现聊天。
单聊天程序,我就用udp或tcp/ip了。
 
不会不行吧!主要是我也没试过,我这里QQ是犯法的:)
E:shuszj@163.com
你发过来,我试试。
 
后退
顶部