Delphi開發基於DCOM的聊天室

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

在服務器端的主要核心部分完成以後，我們配置好服務器端的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;

一個基於DCOM的局域網聊天室的核心部分就基本完成了，並且所有的測試都比較順利，這裡需要補充說明一下聊天室服務器的一個難點：就是需要開發者非常謹慎的處理同步，雖然我也進行了一定的同步處理，但在客戶端人數眾多的情況下仍然可能發生死鎖或其它活鎖的情況，這個程序還需要更進一步的測試、甚至進行一定的重構。