网站导航免费论文 原创论文 论文搜索 原创论文 网学软件 学术大家 资料中心 会员中心 问题解答 原创论文 论文素材 设计下载 最新论文 下载排行 论文上传 在线投稿 联系我们
返回网学首页
网学联系
最新论文 推荐专题 热门论文 素材专题
当前位置: 网学 > 编程文档 > DELPHI > 正文
Delphi开发基于DCOM的聊天室
来源:Http://myeducs.cn 联系QQ:点击这里给我发消息 作者: 用户投稿 来源: 网络 发布时间: 12/10/12
下载{$ArticleTitle}原创论文样式
o

begin

//do nothing只是等待解锁

end;

TempRoom.OneSpeak(content);

end;

function TChatManager.ReadReady(id: Integer): Byte;

var

TempRoom:TChatRoom;

begin

TempRoom:=ChatRoomManager.FindRoomByID(id);

if TempRoom.CanRead then result:=1 else Result:=0;

end;

procedure TChatManager.ConnectRoom(const UserName: WideString;

RoomID: Integer);

//客户端通过接口登陆到指定的房间,没有完全实现

var

TempRoom:TChatRoom;

begin

TempRoom:=ChatRoomManager.FindRoomByID(RoomID);

TempRoom.LoginRoom(UserName);

end;

procedure TChatManager.DisconnectRoom(const UserName: WideString;

RoomID: Integer);

//客户端通过接口离开指定的房间,没有完全实现

var

TempRoom:TChatRoom;

begin

TempRoom:=ChatRoomManager.FindRoomByID(RoomID);

TempRoom.LeaveRoom(UserName);

end;

function TChatManager.TestClearBufferTag(RoomID: Integer): Integer;

var

TempRoom:TChatRoom;

begin

TempRoom:=ChatRoomManager.FindRoomByID(RoomID);

result:=TempRoom.ClearBufferTag;

end;

initialization

TAutoObjectFactory.Create(ComServer, TChatManager, Class_ChatManager,

ciMultiInstance, tmApartment);

end.


  比较关键TchatRoom是下面的样子:

type

TChatRoom=class

private

FBuffer:array[1..20] of string;

FBufferLength:integer;

FRoomName:string;

FRoomID:integer;

FLocked:boolean;//同步锁,用来处理多人同时发出对话的情况

FConnectCount:integer;//当前房间的人数

FClearBufferTag:integer;

//每清空一次buffer此值便跳变一次,此脉冲被客户端检测

protected

procedure ClearBuffer;//清空缓冲区

function GetCanRead:boolean;

public

constructor Create(RoomName:string;RoomID:integer);

procedure OneSpeak(content:string);//将一条聊天内容加入缓冲区

procedure LoginRoom(UserName:string);//参看实现部分注释

procedure LeaveRoom(UserName:string);//参看实现部分注释

function OneRead:Tstrings;//从缓冲区中读出记录

property Locked:boolean read FLocked; //readonly;//供IChatManager检测

property CanRead:boolean read GetCanRead;//判断缓冲区是否为空,否则是不可读的

property ClearBufferTag:integer read FClearBufferTag;

end;

TchatRoom的实现:

{ TChatRoom }

constructor TChatRoom.Create(RoomName:string;RoomID:integer);

begin

FBufferLength:=0;

FConnectCount:=0;

FClearBufferTag:=1;

FLocked:=false;

FRoomName:=RoomName;

FRoomID:=RoomID;

end;

procedure TChatRoom.ClearBuffer;

var

i:integer;

begin

///在这里可以检测一个标志,判断是否需要服务器记录每一次聊天内容

for i:=1 to 20 do

FBuffer[i]:='''';

FBufferLength:=0;

FClearBufferTag:=0-FClearBufferTag;

end;

procedure TChatRoom.OneSpeak(content:string);

begin

FLocked:=true;

inc(FBufferLength);

if FBufferLength>20 then

begin

ClearBuffer;

inc(FBufferLength);

end;

FBuffer[FBufferLength]:=content;

FLocked:=false;

end;

function TChatRoom.OneRead:TStrings;

var

FStrings:TStrings;

i:integer;

begin

FLocked:=true;

FStrings:=TStringList.Create;

for i:=1 to FBufferLength do

FStrings.Add(FBuffer[i]);

result:=FStrings;

FLocked:=false;

end;

function TChatRoom.GetCanRead: boolean;

begin

result:=false;

if FBufferLength>0 then result:=true;

end;

procedure TChatRoom.LoginRoom(UserName:string);

//用户登陆聊天室事件,这里没有完全实现

begin

inc(FConnectCount);

end;

procedure TChatRoom.LeaveRoom(UserName: string);

//用户离开聊天室事件,这里没有完全实现

begin

Dec(FConnectCount
  • 上一篇资讯: 隐藏我的电脑中驱动器
  • 网学推荐

    免费论文

    原创论文

    浏览:
    设为首页 | 加入收藏 | 论文首页 | 论文专题 | 设计下载 | 网学软件 | 论文模板 | 论文资源 | 程序设计 | 关于网学 | 站内搜索 | 网学留言 | 友情链接 | 资料中心
    版权所有 QQ:3710167 邮箱:3710167@qq.com 网学网 [Myeducs.cn] 您电脑的分辨率是 像素
    Copyright 2008-2015 myeducs.Cn www.myeducs.Cn All Rights Reserved
    湘ICP备09003080号