VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 用VB实现聊天讨论室和点对点会话
发表评论(0)作者:汪保平, 平台:VB6.0+Win98, 阅读:9001, 日期:2000-10-03
  在一个单位内部或通过广域协议(如X.25)互联的行业内部都有几十或上万台计算机互联,用Intranet虽然可以建立聊天室,但实现点对点实时对话却比较困难。本人用Winsock和VB自制了一套聊天室和对话系统,特拿来供同行们参考。

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

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

    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.Form form1
caption=”雷萌聊天室”

controlbox=0 ‘False
模拟客户机表单

VB.Textbox text1
multiline=-1    ‘True

scrollbars=3    ‘Bath
用于输入发往聊天室的信息

VB.Textbox text2
locked=-1     ‘True

multiline=-1    ‘True

scrollbars=3    ‘Bath
显示从聊天室发来的信息

VB.Combobox combo1
text=”10.84.234.11”  ‘任定默认地址
放入常用的地址

VB.Commandbutton comm1                
caption=”退出”
最小化form1

VB.Commandbutton comm2                    
caption=”连接”
请求与输入的地址连接

VB.Commandbutton send                    
caption=”发送”
发送Text1中的内容

VB.Label label1
caption=“请在此输入发表的信息”
Text1的框标

VB.Label label2
caption=“聊天室或对方的信息”
Text2的框标

VB.Label label3
caption=”等待连接”
显示连接状态信息

VB.Label label4
caption=”聊天室或对方地址”
用于指示Combo1

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

VB.Timer timer1
interval=6000;   enabled=false
防止连接超时

MSWinsocklib.winsock a
   
用于数据传输


  

  

form2中装入控件:

    控件名
          主要属性
         用      途

VB.Form form2
caption=”接收信息”

controlbox=0 ‘False
模拟客户机表单

VB.Commandbutton                     command1
caption=”返回”
隐含Form2窗口

VB.Commandbutton                     command2
caption=”对话”
点对点会话时用此直接启动Form1

VB.Textbox text1
locked=-1     ‘True

multiline=-1    ‘True

scrollbars=3    ‘Bath
存放聊天或对话内容

VB.Label label1
caption=”接收的信息”
Text1的框标

MSWinsocklib.Winsock a
   
用于监听

MSWinsocklib.Winsock b
   
用于传送聊天信息


  

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

Dim flag As Boolean     注释:连接状态变量

  

Private Sub a_Connect()

    flag = True

End Sub

  

Private Sub a_DataArrival(ByVal bytesTotal As Long)

    Dim i As String

    a.GetData i

    Label3.Caption = "连接成功!"

    Comm2.MousePointer = 0

    Form1.MousePointer = 0

    Timer1.Enabled = False

    If i = Chr(0) Then

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

    Else

      Text2.Text = Text2.Text + i

    End If

    Text2.SelStart = Len(Text2.Text)

    Send.MousePointer = 0

    Combo1.Enabled = False

    Comm2.Caption = "断开连接"

    Text1.SetFocus

End Sub

  

Private Sub a_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

    flag = False

    Timer1.Enabled = False

    Comm2.MousePointer = 0

    Form1.MousePointer = 0

    MsgBox "网络连接失败 !"

    Label3.Caption = "等待连接"

    Combo1.Enabled = True

    Combo1.SetFocus

    a.Close

    Comm2.Caption = "连接"

End Sub

  

Private Sub Comm1_Click()

    a.Close       注释:关闭连接

    Form1.WindowState = 1

End Sub

  

Private Sub Comm2_Click()

If Comm2.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

End If

End Sub

  

Private Sub Form_DblClick()

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

End

Else

Form1.WindowState = 1

End If

End Sub

  

Private Sub Form_Load()

If App.PrevInstance Then

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

End

End If

flag = False

Load Form2    ‘读入form2进入监听

End Sub

  

Private Sub Send_Click()

    Dim S As String

    On Error GoTo ffff     ‘防止链路中断

    Send.MousePointer = 11

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

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

    Else

        S = Text1.Text

    End If

    If flag Then

        a.SendData S

    End If

    Exit Sub

ffff:

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

a.Close

Send.MousePointer = 0

Comm2.Caption = "连接"

Label3.Caption = "等待连接"

Combo1.Enabled = True

Comm2.MousePointer = 0

Form1.MousePointer = 0

Exit Sub

End Sub

  

Private Sub Timer1_Timer()

  flag = False

  Timer1.Enabled = False

  Comm2.MousePointer = 0

  Form1.MousePointer = 0

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

  Label3.Caption = "等待连接"

  Combo1.Enabled = True

  Combo1.SetFocus

  a.Close

  Comm2.Caption = "连接"

End Sub

  

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

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

Dim user(maxn) As Boolean

  

Private Sub Command1_Click()

  Form2.Hide

End Sub

  

Private Sub Command2_Click()

Load Form1

Form1.Show

End Sub

  

Private Sub Form_Load()

       Dim str1 As String

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

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

    a.LocalPort = 3000

    a.Listen

End Sub

  

Private Sub a_ConnectionRequest(ByVal requestID As Long)

    Dim i As Long

      For i = 1 To maxn  ‘当一客户请求时给启动一Winsock控件标志号

        If Not user(i) Then

            user(i) = True

            Exit For

        End If

      Next i

    If i > maxn Then

        Exit Sub

    End If

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

   b(i).Accept requestID   注释:实际建立连接

   If Text1.Text = "" Then   注释:发送数据

      b(i).SendData Chr(0)

   Else

      b(i).SendData Text1.Text

   End If

   Form2.Show

End Sub

  

Private Sub s_Close(Index As Integer)

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

   Unload b(Index)     注释:卸载 一个WinSock 控件

   user(Index) = False

End Sub

  

Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long)

   Dim str As String

   Dim i As Long

    b(Index).GetData str

    Text1.Text = Text1.Text + str

   For i = 1 To maxn

    If user(i) Then

    b(i).SendData str

    End If

   Next i

End Sub

三·运行

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