TchatRoom的實現：
{ TChatRoom }<?XML:namespace prefix = o ns = "urn:schemas-microsoft-com:office:Office" />
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;
