基于修正通过测试所发现的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的麻烦。