知识大全 Delphi开发基于DCOM的聊天室

Posted 2022-07-14 知

篇首语：智慧并不产生于学历,而是来自对于知识的终生不懈的追求。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全 Delphi开发基于DCOM的聊天室相关的知识，希望对你有一定的参考价值。

Delphi开发基于DCOM的聊天室 以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容，让我们赶快一起来看一下吧！

分布式（以下简称D）的出现给我们轻松的创建分布式应用提供了机会我们可以完全不去理会低级别的Windows Sockets（D通过MS RPC让客户与对象进行通信幸运的是要开发应用开发者几乎可以不去理会MS RPC）而开发出功能强大偶合性低（功能模块相对独立很好的发挥了OO的思想）易于部署的分布式计算系统

　　本文我们打算使用D来开发一个局域网聊天室不仅是作为技术上的研究实际上我相信这应该也是一个有用的工具首先我们要对这个聊天室的功能有一个大致的了解

　　至少这个聊天室应该允许多个局域网用户进行聊天　　　　应该能够有多个话题的子聊天室用户可以选择进入某个聊天室进行聊天

　　客户端应该尽量简单（不用配置D）并需要一个服务器端管理所有的交互行为管理聊天室的数目和相关配置并做好系统监测和日志记录等

　　对聊天室功能进行扩展（如悄悄话功能表情符号等）根据以上的功能描述在仔细分析问题以后我们设计出下面的草图

　　这篇文章中我们要大致实现这个程序的一个基本的核心包括IChatManager TChatRoomManager TchatRoom 完成一个最基本功能的服务器端并做一个简单的客户端进行检测我们的重点是服务器端因为它将实现聊天室的大部分功能客户端只是一个十分小巧简单的程序

　　由于篇幅关系我们只列出重要的部分的代码完整的程序请给我发email 首先来看看我们的IchatManager接口是什么样子

IChatManager = interface(IDispatch)

[ E CD F D F A C B D E B F ]

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 为了让支持这种

//类型 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:= else Result:= ;

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[ ] 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:= ;

FConnectCount:= ;

FClearBufferTag:= ;

FLocked:=false;

FRoomName:=RoomName;

FRoomID:=RoomID;

end;

procedure TChatRoom ClearBuffer;

var

i:integer;

begin

///在这里可以检测一个标志判断是否需要服务器记录每一次聊天内容

for i:= to do

FBuffer[i]:= ;

FBufferLength:= ;

FClearBufferTag:= FClearBufferTag;

end;

procedure TChatRoom OneSpeak(content:string);

begin

FLocked:=true;

inc(FBufferLength);

if FBufferLength> 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:= to FBufferLength do

FStrings Add(FBuffer[i]);

result:=FStrings;

FLocked:=false;

end;

function TChatRoom GetCanRead: boolean;

begin

result:=false;

if FBufferLength> 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:= ;

//这里将从配置文件中读出有几个聊天室

RoomNames:=TStringList Create;

RoomNames Add( TestRoom );//这句将被最终的从配置文件读取替换掉

setlength(ChatRoom RoomCount);

for i:= to RoomCount do

ChatRoom[i]:=TChatRoom Create(RoomNames[i ] i);

end;

function TChatRoomManager FindRoomByID(id:integer): TChatRoom;

//该函数由IChatManager接口调用由于最终版本的接口将会提供给客户

//端得到房间列表的功能所以客户端知道自己房间的id

begin

result:=ChatRoom[id];

end;

initialization

ChatRoomManager:=TChatRoomManager Create;

end

　　在服务器端的主要核心部分完成以后我们配置好服务器端的D配置就可以开发一个简单的客户端进行测试了（虽然客户端尽可能的简单我们不用配置D但我们仍需要拷贝服务器端的类型库文件 tlb到客户端并注册后才能开发和使用客户端当然这些都可以通过安装程序来完成）

　　在客户端我们只列出两个相对重要的函数其余的都省略请想我来信获得全部的程序

procedure TForm Button Click(Sender: TObject);

//点击button 后将edit的内容说出去

begin

Server SpeakTo(edit Text );

end;

procedure TForm Timer Timer(Sender: TObject);

//每隔一段时间向服务器请求谈话内容我设置了为秒

var

TempStrings:TStrings;

i:integer;

begin

if Server ReadReady( )= then

begin

TempStrings:=TStringList Create;

SetOleStrings(TempStrings Server ReadFrom( ));

if FReadStartPos> then

if (FClearBufferTag= Server TestClearBufferTag( )) then

begin

FReadStartPos:= ;

FClearBufferTag:=Server TestClearBufferTag( );

end;

for i:=FReadStartPos to TempStrings Count do

Memo Lines Add(TempStrings[i]);

FReadStartPos:=TempStrings Count;

end;

cha138/Article/program/Delphi/201311/24839