分布式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;
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.
|
