分布式COM（以下简称DCOM）的出现给我们轻松的创建分布式应用提供了机会
我们可以完全不去理会低级别的Windows Sockets（DCOM通过MS
RPC让客户与对象进行通信
幸运的是要开发COM应用
开发者几乎可以不去理会MS
RPC）而开发出功能强大
偶合性低（功能模块相对独立
很好的发挥了OO的思想）
易于部署的分布式计算系统
本文我们打算使用DCOM来开发一个局域网聊天室不仅是作为技术上的研究实际上我相信这应该也是一个有用的工具首先我们要对这个聊天室的功能有一个大致的了解
至少这个聊天室应该允许多个局域网用户进行聊天
应该能够有多个话题的子聊天室用户可以选择进入某个聊天室进行聊天
客户端应该尽量简单（不用配置DCOM）并需要一个服务器端管理所有的交互行为管理聊天室的数目和相关配置并做好系统监测和日志记录等
对聊天室功能进行扩展（如悄悄话功能表情符号等）根据以上的功能描述在仔细分析问题以后我们设计出下面的草图
这篇文章中我们要大致实现这个程序的一个基本的核心包括IChatManagerTChatRoomManagerTchatRoom完成一个最基本功能的服务器端并做一个简单的客户端进行检测我们的重点是服务器端因为它将实现聊天室的大部分功能客户端只是一个十分小巧简单的程序
由于篇幅关系我们只列出重要的部分的代码完整的程序请给我发email首先来看看我们的IchatManager接口是什么样子
IChatManager = interface(IDispatch)
[{ECDFDFACBDEBF}]
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 TChatManagerReadFrom(sourceid: Integer): IStrings;
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(sourceid);
while TempRoomLocked do
begin
//do nothing只是等待解锁
end;
GetOleStrings(TempRoomOneReadResult);
end;
procedure TChatManagerSpeakTo(const content: WideString; destid: Integer);
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(destid);
while TempRoomLocked do
begin
//do nothing只是等待解锁
end;
TempRoomOneSpeak(content);
end;
function TChatManagerReadReady(id: Integer): Byte;
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(id);
if TempRoomCanRead then result:= else Result:=;
end;
procedure TChatManagerConnectRoom(const UserName: WideString;
RoomID: Integer);
//客户端通过接口登陆到指定的房间没有完全实现
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(RoomID);
TempRoomLoginRoom(UserName);
end;
procedure TChatManagerDisconnectRoom(const UserName: WideString;
RoomID: Integer);
//客户端通过接口离开指定的房间没有完全实现
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(RoomID);
TempRoomLeaveRoom(UserName);
end;
function TChatManagerTestClearBufferTag(RoomID: Integer): Integer;
var
TempRoom:TChatRoom;
begin
TempRoom:=ChatRoomManagerFindRoomByID(RoomID);
result:=TempRoomClearBufferTag;
end;
initialization
TAutoObjectFactoryCreate(ComServer TChatManager Class_ChatManager
ciMultiInstance tmApartment);
end
比较关键TchatRoom是下面的样子
type
TChatRoom=class
private
FBuffer:array[] 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 TChatRoomCreate(RoomName:string;RoomID:integer);
begin
FBufferLength:=;
FConnectCount:=;
FClearBufferTag:=;
FLocked:=false;
FRoomName:=RoomName;
FRoomID:=RoomID;
end;
procedure TChatRoomClearBuffer;
var
i:integer;
begin
///在这里可以检测一个标志判断是否需要服务器记录每一次聊天内容
for i:= to do
FBuffer[i]:=;
FBufferLength:=;
FClearBufferTag:=FClearBufferTag;
end;
procedure TChatRoomOneSpeak(content:string);
begin
FLocked:=true;
inc(FBufferLength);
if FBufferLength> then
begin
ClearBuffer;
inc(FBufferLength);
end;
FBuffer[FBufferLength]:=content;
FLocked:=false;
end;
function TChatRoomOneRead:TStrings;
var
FStrings:TStrings;
i:integer;
begin
FLocked:=true;
FStrings:=TStringListCreate;
for i:= to FBufferLength do
FStringsAdd(FBuffer[i]);
result:=FStrings;
FLocked:=false;
end;
function TChatRoomGetCanRead: boolean;
begin
result:=false;
if FBufferLength> then result:=true;
end;
procedure TChatRoomLoginRoom(UserName:string);
//用户登陆聊天室事件这里没有完全实现
begin
inc(FConnectCount);
end;
procedure TChatRoomLeaveRoom(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 TChatRoomManagerCreate;
var
iRoomCount:integer;
RoomNames:TStrings;//RoomName是配置文件中的聊天室名称
begin
RoomCount:=;
//这里将从配置文件中读出有几个聊天室
RoomNames:=TStringListCreate;
RoomNamesAdd(TestRoom);//这句将被最终的从配置文件读取替换掉
setlength(ChatRoomRoomCount);
for i:= to RoomCount do
ChatRoom[i]:=TChatRoomCreate(RoomNames[i]i);
end;
function TChatRoomManagerFindRoomByID(id:integer): TChatRoom;
//该函数由IChatManager接口调用由于最终版本的接口将会提供给客户
//端得到房间列表的功能所以客户端知道自己房间的id
begin
result:=ChatRoom[id];
end;
initialization
ChatRoomManager:=TChatRoomManagerCreate;
end
在服务器端的主要核心部分完成以后我们配置好服务器端的DCOM配置就可以开发一个简单的客户端进行测试了（虽然客户端尽可能的简单我们不用配置DCOM但我们仍需要拷贝服务器端的类型库文件tlb到客户端并注册后才能开发和使用客户端当然这些都可以通过安装程序来完成）
在客户端我们只列出两个相对重要的函数其余的都省略请想我来信获得全部的程序
procedure TFormButtonClick(Sender: TObject);
//点击button后将edit的内容说出去
begin
ServerSpeakTo(editText);
end;
procedure TFormTimerTimer(Sender: TObject);
//每隔一段时间向服务器请求谈话内容我设置了为秒
var
TempStrings:TStrings;
i:integer;
begin
if ServerReadReady()= then
begin
TempStrings:=TStringListCreate;
SetOleStrings(TempStringsServerReadFrom());
if FReadStartPos> then
if (FClearBufferTag=ServerTestClearBufferTag()) then
begin
FReadStartPos:=;
FClearBufferTag:=ServerTestClearBufferTag();
end;
for i:=FReadStartPos to TempStringsCount do
MemoLinesAdd(TempStrings[i]);
FReadStartPos:=TempStringsCount;
end;
end;
一个基于DCOM的局域网聊天室的核心部分就基本完成了并且所有的测试都比较顺利这里需要补充说明一下聊天室服务器的一个难点就是需要开发者非常谨慎的处理同步虽然我也进行了一定的同步处理但在客户端人数众多的情况下仍然可能发生死锁或其它活锁的情况这个程序还需要更进一步的测试甚至进行一定的重构
