Delphi開(kāi)發(fā)基于DCOM的聊天室

2019-11-17 05:10:11

字體：大中小

供稿：網(wǎng)友

　　分布式COM（以下簡(jiǎn)稱DCOM）的出現(xiàn)給我們輕松的創(chuàng)建分布式應(yīng)用提供了機(jī)會(huì)；我們可以完全不去理會(huì)低級(jí)別的Windows Sockets（DCOM通過(guò)MS-RPC讓客戶與對(duì)象進(jìn)行通信，幸運(yùn)的是要開(kāi)發(fā)COM應(yīng)用，開(kāi)發(fā)者幾乎可以不去理會(huì)MS-RPC）而開(kāi)發(fā)出功能強(qiáng)大、偶合性低（功能模塊相對(duì)獨(dú)立，

很好的發(fā)揮了OO的思想）、易于部署的分布式計(jì)算系統(tǒng)。

　　本文我們打算使用DCOM來(lái)開(kāi)發(fā)一個(gè)局域網(wǎng)聊天室，不僅是作為技術(shù)上的研究，實(shí)際上我相信這應(yīng)該也是一個(gè)有用的工具。首先我們要對(duì)這個(gè)聊天室的功能有一個(gè)大致的了解：

　　1、至少這個(gè)聊天室應(yīng)該答應(yīng)多個(gè)局域網(wǎng)用戶進(jìn)行聊天。
　　
　　2、應(yīng)該能夠有多個(gè)話題的子聊天室，用戶可以選擇進(jìn)入某個(gè)聊天室進(jìn)行聊天。

　　3、客戶端應(yīng)該盡量簡(jiǎn)單（不用配置DCOM），并需要一個(gè)服務(wù)器端治理所有的交互行為，治理聊天室的數(shù)目和相關(guān)配置，并做好系統(tǒng)監(jiān)測(cè)和日志記錄等。

　　4、對(duì)聊天室功能進(jìn)行擴(kuò)展（如靜靜話功能，表情符號(hào)等）。根據(jù)以上的功能描述，在仔細(xì)分析問(wèn)題以后我們?cè)O(shè)計(jì)出下面的草圖：

Delphi開(kāi)發(fā)基于DCOM的聊天室（圖一）

　　這篇文章中我們要大致實(shí)現(xiàn)這個(gè)程序的一個(gè)基本的核心，包括IChatManager、TChatRoomManager、TchatRoom，完成一個(gè)最基本功能的服務(wù)器端，并做一個(gè)簡(jiǎn)單的客戶端進(jìn)行檢測(cè)。我們的重點(diǎn)是服務(wù)器端，因?yàn)樗鼘?shí)現(xiàn)聊天室的大部分功能，客戶端只是一個(gè)十分小巧簡(jiǎn)單的程序。

　　由于篇幅關(guān)系，我們只列出重要的部分的代碼，完整的程序請(qǐng)給我發(fā)email。首先來(lái)看看我們的IchatManager接口是什么樣子：

IChatManager = interface(IDispatch)

['{E7CD7F0D-447F-497A-8C7B-1D80E748B67F}']

PRocedure SpeakTo(const content: WideString; destid: Integer); safecall;

//客戶向指定的房間說(shuō)話，destid為房間號(hào)

function ReadFrom(sourceid: Integer): IStrings; safecall;

//客戶從指定的房間讀取談話內(nèi)容，sourceid為房間號(hào)

function ReadReady(id: Integer): Byte; safecall;

//客戶檢測(cè)指定的房間是否已經(jīng)可以讀取談話內(nèi)容

procedure ConnectRoom(const UserName: WideString; RoomID: Integer); safecall;

//客戶登陸指定房間

procedure DisconnectRoom(const UserName: WideString; RoomID: Integer); safecall;

//客戶退出指定房間

function TestClearBufferTag(RoomID: Integer): Integer; safecall;

//客戶測(cè)試指定房間的緩沖區(qū)的清空與否狀況

end;

再來(lái)看看接口的實(shí)現(xiàn)類TChatManager部分：

type

TChatManager = class(TAutoObject, IChatManager)

protected

function ReadFrom(sourceid: Integer): IStrings; safecall;

//在這里我們使用Delphi擴(kuò)展的復(fù)雜類型TStings，為了讓COM支持這種

//類型，delphi提供了IStrings接口

procedure SpeakTo(const content: WideString; destid: Integer); safecall;

function ReadReady(id: Integer): Byte; safecall;

//用來(lái)提供給客戶端查詢指定的房間是否可讀，既指定房間緩沖區(qū)是否為空

procedure ConnectRoom(const UserName: WideString; RoomID: Integer);

safecall;

procedure DisconnectRoom(const UserName: WideString; RoomID: Integer);

safecall;

function TestClearBufferTag(RoomID: Integer): Integer; safecall;

end;

　　實(shí)現(xiàn)部分：

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);

//客戶端通過(guò)接口登陸到指定的房間，沒(méi)有完全實(shí)現(xiàn)

var

TempRoom:TChatRoom;

begin

TempRoom:=ChatRoomManager.FindRoomByID(RoomID);

TempRoom.LoginRoom(UserName);

end;

procedure TChatManager.DisconnectRoom(const UserName: WideString;

RoomID: Integer);

//客戶端通過(guò)接口離開(kāi)指定的房間，沒(méi)有完全實(shí)現(xiàn)

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;//同步鎖，用來(lái)處理多人同時(shí)發(fā)出對(duì)話的情況

FConnectCount:integer;//當(dāng)前房間的人數(shù)

FClearBufferTag:integer;

//每清空一次buffer此值便跳變一次，此脈沖被客戶端檢測(cè)

protected

procedure ClearBuffer;//清空緩沖區(qū)

function GetCanRead:boolean;

public

constrUCtor Create(RoomName:string;RoomID:integer);

procedure OneSpeak(content:string);//將一條聊天內(nèi)容加入緩沖區(qū)

procedure LoginRoom(UserName:string);//參看實(shí)現(xiàn)部分注釋

procedure LeaveRoom(UserName:string);//參看實(shí)現(xiàn)部分注釋

function OneRead:Tstrings;//從緩沖區(qū)中讀出記錄

property Locked:boolean read FLocked; //readonly;//供IChatManager檢測(cè)

property CanRead:boolean read GetCanRead;//判定緩沖區(qū)是否為空，否則是不可讀的

property ClearBufferTag:integer read FClearBufferTag;

end;

TchatRoom的實(shí)現(xiàn)：

{ 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

///在這里可以檢測(cè)一個(gè)標(biāo)志，判定是否需要服務(wù)器記錄每一次聊天內(nèi)容

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);

//用戶登陸聊天室事件，這里沒(méi)有完全實(shí)現(xiàn)

begin

inc(FConnectCount);

end;

procedure TChatRoom.LeaveRoom(UserName: string);

//用戶離開(kāi)聊天室事件，這里沒(méi)有完全實(shí)現(xiàn)

begin

Dec(FConnectCount);

end;

服務(wù)器端的最后一個(gè)比較重要的部分TchatRoomManager：

type

TChatRoomManager=class

private

ChatRoom:array of TChatRoom;

public

constructor Create;

function FindRoomByID(id:integer):TChatRoom;

end;

實(shí)現(xiàn)部分：

{ TChatRoomManager }

constructor TChatRoomManager.Create;

var

i,RoomCount:integer;

RoomNames:TStrings;//RoomName是配置文件中的聊天室名稱

begin

RoomCount:=1;

//這里將從配置文件中讀出有幾個(gè)聊天室

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;

//該函數(shù)由IChatManager接口調(diào)用，由于最終版本的接口將會(huì)提供給客戶

//端得到房間列表的功能，所以客戶端知道自己房間的id

begin

result:=ChatRoom[id];

end;

initialization

ChatRoomManager:=TChatRoomManager.Create;

end.

　　在服務(wù)器端的主要核心部分完成以后，我們配置好服務(wù)器端的DCOM配置，就可以開(kāi)發(fā)一個(gè)簡(jiǎn)單的客戶端進(jìn)行測(cè)試了：（雖然客戶端盡可能的簡(jiǎn)單，我們不用配置DCOM但我們?nèi)孕枰截惙?wù)器端的類型庫(kù)文件.tlb到客戶端并注冊(cè)后才能開(kāi)發(fā)和使用客戶端，當(dāng)然，這些都可以通過(guò)安裝程序來(lái)完成）

　　在客戶端我們只列出兩個(gè)相對(duì)重要的函數(shù)，其余的都省略，請(qǐng)想我來(lái)信獲得全部的程序：

procedure TForm1.Button1Click(Sender: TObject);

//點(diǎn)擊button1后將edit的內(nèi)容“說(shuō)”出去

begin

Server.SpeakTo(edit1.Text,1);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

//每隔一段時(shí)間向服務(wù)器請(qǐng)求談話內(nèi)容，我設(shè)置了為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;

　　一個(gè)基于DCOM的局域網(wǎng)聊天室的核心部分就基本完成了，并且所有的測(cè)試都比較順利，這里需要補(bǔ)充說(shuō)明一下聊天室服務(wù)器的一個(gè)難點(diǎn)：就是需要開(kāi)發(fā)者非常謹(jǐn)慎的處理同步，雖然我也進(jìn)行了一定的同步處理，但在客戶端人數(shù)眾多的情況下仍然可能發(fā)生死鎖或其它活鎖的情況，這個(gè)程序還需要更進(jìn)一步的測(cè)試、甚至進(jìn)行一定的重構(gòu)。

上一篇：使用Delphi心得兩則

下一篇：Delphi中建表