在一个单位内部或通过广域协议（如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
　　显示从聊天室发来的信息
　　
　　VB.Comboboxcombo1
　　text=”10.84.234.11”‘任定默认地址
　　放入常用的地址
　　
　　VB.Commandbuttoncomm1
　　caption=”退出”
　　最小化form1
　　
　　VB.Commandbuttoncomm2
　　caption=”连接”
　　请求与输入的地址连接
　　
　　VB.Commandbuttonsend
　　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
　　模拟客户机表单
　　
　　VB.Commandbuttoncommand1
　　caption=”返回”
　　隐含Form2窗口
　　
　　VB.Commandbuttoncommand2
　　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
　　
　　IfimaxnThen
　　
　　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空白处从内存中撤出系统。根据同样的原理可以制作电子邮件系统。->