分享
 
 
 

开发一个基于DCOM的局域网聊天室(三)

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

(接上文)

完善和修补:

基于修正通过测试所发现的bug,和功能的完善,我们有对客户端进行了一定的改动,主要体现在:

·对客户端进行更好的异常处理,以防止由于服务器异常中断而导致客户端仍不端请求服务器所造成的死锁。

·增加了说话对象和悄悄话功能(在客户端实现)

·增加了登录窗体,可以登陆到指定的房间并对服务器进行配置(参看下面服务器的改进)

另外在服务器端我们也做了部分的改进,主要完成了上次没有实现的功能,主要体现在:

·完成了服务器端任意配置并开放多个话题房间的功能(一个TchatRoom的实例对应着一个话题房间)

·在服务器端的每个房间维护一份登录进房间的人员列表,供客户端调用

·完善了服务器端的UI,并在服务器端实现为每个用户的登录和登出进行向客户系统公告的功能,并在服务器端限制登录的人数和进行重名判断

我们来看看主要的改进部分的代码变化情况,首先是服务器端的接口:

IChatManager = interface(IDispatch)

['{E7CD7F0D-447F-497A-8C7B-1D80E748B67F}']

……

function GetRoomList: IStrings; safecall;//客户端获得服务器端的房间列表

function RoomCanLogin(RoomID: Integer; const UserName: WideString): Integer; safecall;

//客户端接收到一个返回值用以判断服务器是否允许客户登录

//返回值的表示:1:可以登陆 2:用户重名 3:人数过多

function RoomUserList(RoomID: Integer): IStrings; safecall;

//供客户端获得在一个房间内的人员列表,由TchatRoom维护这个列表

//每登录和离开一个user便更新列表

end;

其中RoomCanLogin需要的实现比较重要,其余的两个接口只是返回有服务器维护的两个列表而已。

//RoomCanLogin方法对应于TchatRoom类内的实现

function TChatRoom.CanLogin(UserName:string): integer;

var

i:integer;

begin

result:=1;

if FRoomUserList.Count>50 then //最多允许一个房间有50个人

begin

result:=3;

exit;

end;

for i:=0 to FRoomUserList.Count-1 do

//遍历由TchatRoom维护的人员列表以判断是否有重名用户

begin

if FRoomUserList[i]=UserName then

result:=2;

break;

end;

end;

再来看看,上次没有实现的多话题房间维护:

//请对比上篇文章的同名实现

constructor TChatRoomManager.Create;

var

i:integer;

begin

FRoomList:=TStringList.Create;

try

FRoomList.LoadFromFile(ExtractFilePath(application.ExeName)+'ChatRoomList.ini');

except

on E:Exception do

begin

application.MessageBox(Pchar('配置文件错误,错误代码:'+E.Message),'DComChatPro',MB_ICONWARNING);

application.Terminate;

end;

end;

FRoomList.Delete(0);

FRoomCount:=FRoomList.Count;

//这里将从配置文件中读出有几个聊天室

setlength(ChatRoom,FRoomCount);

for i:=1 to FRoomCount do

ChatRoom[i]:=TChatRoom.Create(FRoomList[i-1],i);

//创建房间的每一个实例

end;

客户端的Timer.OnTimer的重要改进(悄悄话和说话对象的功能都在这里实现):

//请对比上篇文章的同名实现

procedure TClientMainForm.Timer1Timer(Sender: TObject);

var

TempStrings:TStrings;

i:integer;

ToStartPos,ToEndPos:integer;

FromWho,ToWho,TempName:string;

begin

try

if ChatServer.Server.ReadReady(RoomID)=1 then

begin

TempStrings:=TStringList.Create;

SetOleStrings(TempStrings,ChatServer.Server.ReadFrom(RoomID));

if FReadStartPos>19 then

if (FClearBufferTag=0-ChatServer.Server.TestClearBufferTag(RoomID)) then

begin

FReadStartPos:=0;

FClearBufferTag:=ChatServer.Server.TestClearBufferTag(RoomID);

end;

for i:=FReadStartPos to TempStrings.Count-1 do

begin

if RightStr(TempStrings[i],11)='SecretSpeak' then

//可以看到实现悄悄话无非是在说话内容的最后加了一个特殊的标示SecretSpeak

begin

//这一段程序从字符串中解析出说话的对象

ToStartPos:=pos(' 悄悄的对 ',TempStrings[i]);

FromWho:=Copy(TempStrings[i],1,ToStartPos-1);//谁说的

ToStartPos:=ToStartPos+10;

ToEndPos:=pos(' 说:',TempStrings[i]);

ToWho:=Copy(TempStrings[i],ToStartPos,ToEndPos-ToStartPos);//说给谁

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

if (ToWho='所有人') or (ToWho=UserName) or (FromWho=UserName) then

//是自己说的,或自己应该看到的,或是说给所有人的悄悄话都有权看到

begin

Memo1.Lines.Add(Copy(TempStrings[i],1,length(TempStrings[i])-11));

Memo1.Lines.Add('');

end;

end

else //不该看到的内容

begin

Memo1.Lines.Add(TempStrings[i]);

Memo1.Lines.Add('');

end;

end;

FReadStartPos:=TempStrings.Count;

end;

//刷新在线人员列表

Listbox1.Clear;

SetOleStrings(ListBox1.Items,ChatServer.Server.RoomUserList(RoomID));

//刷新说话对象列表

TempName:=SpeakToCBx.Text;

SpeakToCBx.Clear;

SpeakToCBx.Items.Assign(ListBox1.Items);

SpeakToCBx.Items.Insert(0,'所有人');

for i:=0 to SpeakToCBx.Items.Count-1 do

begin

if SpeakToCBx.Items[i]=TempName then Break;

end;

if i>SpeakToCBx.Items.Count-1 then i:=0;

SpeakToCBx.ItemIndex:=i;

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

except //异常处理

on E:Exception do

begin

Timer1.Enabled:=false;

application.MessageBox

(pchar('通信中断或服务器故障,点确定后将关闭程序,请稍后重启动。详细中断原因:'+E.Message),'DCOMChatClient',MB_ICONWARNING);

application.Terminate;

end;

end;

end;

当然上面的程序所分析的字符串(说给谁,谁说的,是否是悄悄话)都是在speak时产生的,这相当的简单:

//客户端的speak

procedure TClientMainForm.Button1Click(Sender: TObject);

var

content:string;

begin

if Edit1.Text='' then

begin

application.MessageBox('不能发空消息。','DCOMChatClient',MB_ICONINFORMATION);

exit;

end;

if length(edit1.Text)>100 then

begin

application.MessageBox('说话内容过长。','DCOMChatClient',MB_ICONINFORMATION);

exit;

end;

if CheckBox1.Checked then

Content:=UserName+' 悄悄的对 '+SpeakToCBx.Text+' 说:'+edit1.Text+'SecretSpeak'

//可以看到悄悄话功能和说话对象的功能只是在字符串上的简单处理罢了

else

Content:=UserName+' 对 '+SpeakToCBx.Text+' 说:'+edit1.Text;

ChatServer.Server.SpeakTo(Content,RoomID);

edit1.Clear;

end;

至此这个程序已经基本完善了,我们可以打包发布它,以免去最终用户配置DCOM的麻烦。

(全文完)

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有