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

难度：★★★☆☆

先行知识：Delphi / 接口 / OLE&COM&DCOM / Win32

首先祝大家新春快乐，猴年万事如意！

在前面的几篇文章中我们已经探讨了不少基于微软COM的相关技术，而分布式COM（以下简称DCOM）的出现给我们轻松的创建分布式应用提供了机会；我们可以完全不去理会低级别的Windows Sockets（DCOM通过MS-RPC让客户与对象进行通信，幸运的是要开发COM应用，开发者几乎可以不去理会MS-RPC）而开发出功能强大、偶合性低（功能模块相对独立，很好的发挥了OO的思想）、易于部署的分布式计算系统。

在这次的文章中，我们就打算使用DCOM来开发一个局域网聊天室，不仅是作为技术上的研究，实际上我相信这应该也是一个有用的工具。首先我们要对这个聊天室的功能有一个大致的了解：1、至少这个聊天室应该允许多个局域网用户进行聊天。（有点废话。。。）2、应该能够有多个话题的子聊天室，用户可以选择进入某个聊天室进行聊天。3、客户端应该尽量简单（不用配置DCOM），并需要一个服务器端管理所有的交互行为，管理聊天室的数目和相关配置，并做好系统监测和日志记录等。4、对聊天室功能进行扩展（如悄悄话功能，表情符号等）。根据以上的功能描述，在仔细分析问题以后我们设计出下面的草图：

这篇文章中我们要大致实现这个程序的一个基本的核心，包括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;
（接后文）