Delphi开发基于DCOM的聊天室

  分布式COM(以下简称DCOM)的出现给我们轻松的创建分布式应用提供了机会;我们可以完全不去理会低级别的Windows Sockets(DCOM通过MS-RPC让客户与对象进行通信,幸运的是要开发COM应用,开发者几乎可以不去理会MS-RPC)而开发出功能强大、偶合性低(功能模块相对独立,
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  很好的发挥了OO的思想)、易于部署的分布式计算系统。
  本文我们打算使用DCOM来开发一个局域网聊天室,不仅是作为技术上的研究,实际上我相信这应该也是一个有用的工具。首先我们要对这个聊天室的功能有一个大致的了解:
  1、至少这个聊天室应该答应多个局域网用户进行聊天。
  2、应该能够有多个话题的子聊天室,用户可以选择进入某个聊天室进行聊天。
  3、客户端应该尽量简单(不用配置DCOM),并需要一个服务器端治理所有的交互行为,治理聊天室的数目和相关配置,并做好系统监测和日志记录等。
  4、对聊天室功能进行扩展(如静静话功能,表情符号等)。根据以上的功能描述,在仔细分析问题以后我们设计出下面的草图:
  
Delphi开发基于DCOM的聊天室

  这篇文章中我们要大致实现这个程序的一个基本的核心,包括IChatManager、TChatRoomManager、TchatRoom,完成一个最基本功能的服务器端,并做一个简单的客户端进行检测。我们的重点是服务器端,因为它将实现聊天室的大部分功能,客户端只是一个十分小巧简单的程序。
  由于篇幅关系,我们只列出重要的部分的代码,完整的程序请给我发email。首先来看看我们的IchatManager接口是什么样子:
  
  IChatManager = interface(IDispatch)
  ['{E7CD7F0D-447F-497A-8C7B-1D80E748B67F}']
  PRocedure SpeakTo(const content: WideString; destid: Integer); safecall;
  //客户向指定的房间说话,destid为房间号
  function ReadFrom(sourceid: Integer): IStrings; safecall;
  //客户从指定的房间读取谈话内容,sourceid为房间号
  function ReadReady(id: Integer): Byte; safecall;
  //客户检测指定的房间是否已经可以读取谈话内容
  procedure ConnectRoom(const UserName: WideString; RoomID: Integer); safecall;
  //客户登陆指定房间
  procedure DisconnectRoom(const UserName: WideString; RoomID: Integer); safecall;
  //客户退出指定房间
  function TestClearBufferTag(RoomID: Integer): Integer; safecall;
  //客户测试指定房间的缓冲区的清空与否状况
  end;
  再来看看接口的实现类TChatManager部分:
  type
  TChatManager = class(TAutoObject, IChatManager)
  protected
  function ReadFrom(sourceid: Integer): IStrings; safecall;
  //在这里我们使用Delphi扩展的复杂类型TStings,为了让COM支持这种
  //类型,delphi提供了IStrings接口
  procedure SpeakTo(const content: WideString; destid: Integer); safecall;
  function ReadReady(id: Integer): Byte; safecall;
  //用来提供给客户端查询指定的房间是否可读,既指定房间缓冲区是否为空
  procedure ConnectRoom(const UserName: WideString; RoomID: Integer);
  safecall;
  procedure DisconnectRoom(const UserName: WideString; RoomID: Integer);
  safecall;
  function TestClearBufferTag(RoomID: Integer): Integer; safecall;
  end;
  实现部分:
  
  
  function TChatManager.ReadFrom(sourceid: Integer): IStrings;
  var
  TempRoom:TChatRoom;
  begin
  TempRoom:=ChatRoomManager.FindRoomByID(sourceid);
  while TempRoom.Locked do
  begin
  //do nothing只是等待解锁
  end;
  GetOleStrings(TempRoom.OneRead,Result);
  end;
  procedure TChatManager.SpeakTo(const content: WideString; destid: Integer);
  var
  TempRoom:TChatRoom;
  begin
  TempRoom:=ChatRoomManager.FindRoomByID(destid);
  while TempRoom.Locked do
  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);
  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的局域网聊天室的核心部分就基本完成了,并且所有的测试都比较顺利,这里需要补充说明一下聊天室服务器的一个难点:就是需要开发者非常谨慎的处理同步,虽然我也进行了一定的同步处理,但在客户端人数众多的情况下仍然可能发生死锁或其它活锁的情况,这个程序还需要更进一步的测试、甚至进行一定的重构。