Delphi开发基于DCOM的聊天室

　　比较关键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.