开发一个基于DCOM的局域网聊天室（三）

（接上文）
完善和修补：
基于修正通过测试所发现的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的麻烦。 (全文完)