用VB实现聊天讨论室和点对点会话

在一个单位内部或通过广域协议（如X.25）互联的行业内部都有几十或上万台计算机互联，用Intranet虽然可以建立聊天室，但实现点对点实时对话却比较困难。本人用Winsock和VB自制了一套聊天室和对话系统，特拿来供同行们参考。

一·Winsock的主要属性、事件和方法

Winsock是不可见控件，控件文件名是MSWINSCK.OCX，全称为Mcirosoftwinsockcontrol，使用时要将此控件调入工具箱。

1·属性：①Protocol=0//使用TCP协议；

②RemoteHost//准备连接远程机的IP地址

③RemotePort//连接远程机的IP端口号（1024—65535之间）

④LocalPort//本地机监听IP端口号必须与呼叫机端口号相同

2·方法：①connect//申请连接远程机

②listen//设置监听

③accept//建立实际连接

④senddata//发送数据

⑤getdata//接收数据

⑥close//关闭连接

3·事件：①connectionrequest//一方请求连接时另一方产生

②connect//一方机接受连接时另一方产生

③close//一方机关闭连接时另一方产生

④dataArrival//一方发送数据另一方产生

⑤error//请求连接失败时产生

二·制作方法

⑴在一工程中添加两个表单form1（模拟客户端）、form2（模拟服务器端）。

form1中装入控件：

控件名

主要属性

用途

VB.Formform1

caption=”雷萌聊天室”

controlbox=0‘False

模拟客户机表单

VB.Textboxtext1

multiline=-1‘True

scrollbars=3‘Bath

用于输入发往聊天室的信息

VB.Textboxtext2

locked=-1‘True

multiline=-1‘True

scrollbars=3‘Bath

显示从聊天室发来的信息

boboxcombo1

text=”10.84.234.11”‘任定默认地址

放入常用的地址

mandbuttoncomm1

caption=”退出”

最小化form1

mandbuttoncomm2

caption=”连接”

请求与输入的地址连接

mandbuttonsend

caption=”发送”

发送Text1中的内容

VB.Labellabel1

caption=“请在此输入发表的信息”

Text1的框标

VB.Labellabel2

caption=“聊天室或对方的信息”

Text2的框标

VB.Labellabel3

caption=”等待连接”

显示连接状态信息

VB.Labellabel4

caption=”聊天室或对方地址”

用于指示Combo1

VB.Labellabel5

caption=”操作:选地址连接,连接成功看到聊天室内容后再输信息发送”

操作说明

VB.Timertimer1

interval=6000;enabled=false

防止连接超时

MSWinsocklib.winsocka

用于数据传输

form2中装入控件：

控件名

主要属性

用途

VB.Formform2

caption=”接收信息”

controlbox=0‘False

模拟客户机表单

mandbuttoncommand1

caption=”返回”

隐含Form2窗口

mandbuttoncommand2

caption=”对话”

点对点会话时用此直接启动Form1

VB.Textboxtext1

locked=-1‘True

multiline=-1‘True

scrollbars=3‘Bath

存放聊天或对话内容

VB.Labellabel1

caption=”接收的信息”

Text1的框标

MSWinsocklib.Winsocka

用于监听

MSWinsocklib.Winsockb

用于传送聊天信息

⑵在Form1的各控件事件中加入如下代码:

DimflagAsBoolean注释：连接状态变量

PrivateSuba_Connect()

flag=True

EndSub

PrivateSuba_DataArrival(ByValbytesTotalAsLong)

DimiAsString

a.GetDatai

Label3.Caption="连接成功！"

Comm2.MousePointer=0

Form1.MousePointer=0

Timer1.Enabled=False

Ifi=Chr(0)Then

Text2.Text="你是今天第一个进入本聊天室的客户。"+Chr(13)+Chr(10)

Else

Text2.Text=Text2.Text+i

EndIf

Text2.SelStart=Len(Text2.Text)

Send.MousePointer=0

Combo1.Enabled=False

Comm2.Caption="断开连接"

Text1.SetFocus

EndSub

PrivateSuba_Error(ByValNumberAsInteger,DescriptionAsString,ByValScodeAsLong,ByValSourceAsString,ByValHelpFileAsString,ByValHelpContextAsLong,CancelDisplayAsBoolean)

flag=False

Timer1.Enabled=False

Comm2.MousePointer=0

Form1.MousePointer=0

MsgBox"网络连接失败！"

Label3.Caption="等待连接"

Combo1.Enabled=True

Combo1.SetFocus

a.Close

Comm2.Caption="连接"

EndSub

PrivateSubComm1_Click()

a.Close注释：关闭连接

Form1.WindowState=1

EndSub

PrivateSubComm2_Click()

IfComm2.Caption="断开连接"Then

a.Close

Comm2.Caption="连接"

Label3.Caption="等待连接"

Combo1.Enabled=True

Timer1.Enabled=False

Comm2.MousePointer=0

Form1.MousePointer=0

Else

Text2.Text=""

Label3.Caption="正在连接.."

Comm2.MousePointer=11

Form1.MousePointer=11

Timer1.Enabled=True

flag=False

a.Protocol=sckTCPProtocol

a.RemoteHost=Combo1.Text

a.RemotePort=3000

a.Connect

EndIf

EndSub

PrivateSubForm_DblClick()

IfMsgBox("关闭本聊天室!确认吗？",36,"退出系统")=6Then

End

Else

Form1.WindowState=1

EndIf

EndSub

PrivateSubForm_Load()

IfApp.PrevInstanceThen

MsgBox"本系统已经加载，请看任务拦！",48,"提示"

End

EndIf

flag=False

LoadForm2‘读入form2进入监听

EndSub

PrivateSubSend_Click()

DimSAsString

OnErrorGoToffff‘防止链路中断

Send.MousePointer=11

IfRight(Text1.Text,1)<>Chr(10)Then

S=Text1.Text+Chr(13)+Chr(10)

Else

S=Text1.Text

EndIf

IfflagThen

a.SendDataS

EndIf

ExitSub

ffff:

MsgBox"连接中断!",48,"提示"

a.Close

Send.MousePointer=0

Comm2.Caption="连接"

Label3.Caption="等待连接"

Combo1.Enabled=True

Comm2.MousePointer=0

Form1.MousePointer=0

ExitSub

EndSub

PrivateSubTimer1_Timer()

flag=False

Timer1.Enabled=False

Comm2.MousePointer=0

Form1.MousePointer=0

MsgBox"网络连接失败(超时)！"

Label3.Caption="等待连接"

Combo1.Enabled=True

Combo1.SetFocus

a.Close

Comm2.Caption="连接"

EndSub

⑶在Form2的各控件事件中加入如下代码:

Constmaxn=200‘最大同时连接本机的客户数

Dimuser(maxn)AsBoolean

PrivateSubCommand1_Click()

Form2.Hide

EndSub

PrivateSubCommand2_Click()

LoadForm1

Form1.Show

EndSub

PrivateSubForm_Load()

Dimstr1AsString

Form2.Caption="雷萌通信软件"

注释：winsock控件a作为服务器程序监听

a.LocalPort=3000

a.Listen

EndSub

PrivateSuba_ConnectionRequest(ByValrequestIDAsLong)

DimiAsLong

Fori=1Tomaxn‘当一客户请求时给启动一Winsock控件标志号

IfNotuser(i)Then

user(i)=True

ExitFor

EndIf

Nexti

Ifi>maxnThen

ExitSub

EndIf

Loadb(i)‘当一客户请求时启动一Winsock控件

b(i).AcceptrequestID注释：实际建立连接

IfText1.Text=""Then注释：发送数据

b(i).SendDataChr(0)

Else

b(i).SendDataText1.Text

EndIf

Form2.Show

EndSub

PrivateSubs_Close(IndexAsInteger)

b(Index).Close注释：关闭连接

Unloadb(Index)注释：卸载一个WinSock控件

user(Index)=False

EndSub

PrivateSubb_DataArrival(IndexAsInteger,ByValbytesTotalAsLong)

DimstrAsString

DimiAsLong

b(Index).GetDatastr

Text1.Text=Text1.Text+str

Fori=1Tomaxn

Ifuser(i)Then

b(i).SendDatastr

EndIf

Nexti

EndSub

三·运行

本程序在VB6.0中编译通过，运行后最小化到任务栏上，也可以用API的Shell_Notifyicon函数做入右下角的指示器栏中常驻内存。你可以在网络中用一个固定的机器地址作为聊天讨论室，其他用户都选该机地址连接进入该室聊天或讨论。各用户也可选各自熟悉的地址进行连接对话,双击form1空白处从内存中撤出系统。根据同样的原理可以制作电子邮件系统。