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

核心提示： TchatRoom的实现：{ TChatRoom }constructor TChatRoom.Create(RoomName:string;RoomID:integer);begin FBufferLength:=0; FConnectCount:=0; FClearBufferTag:=1; FLocked:=f

 

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);

end;

服务器端的最后一个比较重要的部分TchatRoomManager：

type

 TChatRoomManager=class

 private

  ChatRoom:array of TChatRoom;

 public

  constructor Create;

  function FindRoomByID(id:integer):TChatRoom;

 end;

实现部分：

{ TChatRoomManager }

 

constructor TChatRoomManager.Create;

var

 i,RoomCount:integer;

 RoomNames:TStrings;//RoomName是配置文件中的聊天室名称

begin

 RoomCount:=1;

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

 RoomNames:=TStringList.Create;

 RoomNames.Add('TestRoom');//这句将被最终的从配置文件读取替换掉

 setlength(ChatRoom,RoomCount);

 for i:=1 to RoomCount do

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

end;

 

function TChatRoomManager.FindRoomByID(id:integer): TChatRoom;

//该函数由IChatManager接口调用，由于最终版本的接口将会提供给客户

//端得到房间列表的功能，所以客户端知道自己房间的id

begin

 result:=ChatRoom[id];

end;

 

initialization

 ChatRoomManager:=TChatRoomManager.Create;

end.

在服务器端的主要核心部分完成以后，我们配置好服务器端的DCOM配置，就可以开发一个简单的客户端进行测试了：（虽然客户端尽可能的简单，我们不用配置DCOM但我们仍需要拷贝服务器端的类型库文件.tlb到客户端并注册后才能开发和使用客户端，当然，这些都可以通过安装程序来完成）

在客户端我们只列出两个相对重要的函数，其余的都省略，请想我来信获得全部的程序：

procedure TForm1.Button1Click(Sender: TObject);

//点击button1后将edit的内容“说”出去

begin

 Server.SpeakTo(edit1.Text,1);

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

//每隔一段时间向服务器请求谈话内容，我设置了为1.5秒

var

 TempStrings:TStrings;

 i:integer;

begin

 if Server.ReadReady(1)=1 then

 begin

  TempStrings:=TStringList.Create;

  SetOleStrings(TempStrings,Server.ReadFrom(1));

  if FReadStartPos>19 then

　 if (FClearBufferTag=0-Server.TestClearBufferTag(1)) then

　 begin

　  FReadStartPos:=0;

　  FClearBufferTag:=Server.TestClearBufferTag(1);

　 end;

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

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

  FReadStartPos:=TempStrings.Count;

 end;

end;

一个基于DCOM的局域网聊天室的核心部分就基本完成了，并且所有的测试都比较顺利，这里需要补充说明一下聊天室服务器的一个难点：就是需要开发者非常谨慎的处理同步，虽然我也进行了一定的同步处理，但在客户端人数众多的情况下仍然可能发生死锁或其它活锁的情况，这个程序还需要更进一步的测试、甚至进行一定的重构。尽请关注后文。