熱點推薦：
您现在的位置： 電腦知識網 >> 編程 >> Delphi編程 >> 正文

Delphi開發基於DCOM的聊天室

2022-06-13   來源: Delphi編程 
    分布式COM（以下簡稱DCOM）的出現給我們輕松的創建分布式應用提供了機會我們可以完全不去理會低級別的Windows Sockets（DCOM通過MSRPC讓客戶與對象進行通信幸運的是要開發COM應用開發者幾乎可以不去理會MSRPC）而開發出功能強大偶合性低（功能模塊相對獨立很好的發揮了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的局域網聊天室的核心部分就基本完成了並且所有的測試都比較順利這裡需要補充說明一下聊天室服務器的一個難點就是需要開發者非常謹慎的處理同步雖然我也進行了一定的同步處理但在客戶端人數眾多的情況下仍然可能發生死鎖或其它活鎖的情況這個程序還需要更進一步的測試甚至進行一定的重構


From:http://tw.wingwit.com/Article/program/Delphi/201311/24839.html
    《Delphi開發基於DCOM的聊天室》本文是由Delphi編程免費提供，內容來源於互聯網,本文歸原作者所有。
  • 上一篇文章：

  • 下一篇文章：
    • 相關文章
    主板 CPU 硬盤 內存 顯卡 聲卡 顯示器 光驅 死機
    推薦文章
    Copyright © 2005-2022 電腦知識網 Computer Knowledge   All rights reserved.