frmmain.frm

一个用WinSock的VB聊天程序.

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "聊吧"
   ClientHeight    =   4695
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   7620
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4695
   ScaleWidth      =   7620
   StartUpPosition =   2  '屏幕中心
   Begin MSWinsockLib.Winsock winsockMain 
      Left            =   0
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.ListBox lstCommon 
      Enabled         =   0   'False
      Height          =   3480
      ItemData        =   "frmMain.frx":0442
      Left            =   5520
      List            =   "frmMain.frx":046A
      TabIndex        =   3
      Top             =   480
      Width           =   2055
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送"
      Enabled         =   0   'False
      Height          =   375
      Left            =   5760
      TabIndex        =   2
      Top             =   4200
      Width           =   1695
   End
   Begin VB.TextBox txtMsg 
      Enabled         =   0   'False
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   4200
      Width           =   5655
   End
   Begin VB.TextBox txtInfo 
      Height          =   3855
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   120
      Width           =   5415
   End
   Begin VB.Label Label1 
      Caption         =   "常用语:"
      Height          =   255
      Left            =   5520
      TabIndex        =   4
      Top             =   120
      Width           =   2055
   End
   Begin VB.Menu mnuCreate 
      Caption         =   "建立主机"
   End
   Begin VB.Menu mnuConnect 
      Caption         =   "连接"
   End
   Begin VB.Menu mnuClose 
      Caption         =   "断开连接"
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "关于"
   End
   Begin VB.Menu mnuExit 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim User As String
Dim Buffer As String
Dim tcpConnected As Boolean

'//////////////  初始化
Private Sub Form_Load()
User = InputBox("请输入您的网名:", "注册")
tcpConnected = False
out "★欢迎" + User + "使用聊吧★"
out "★请建立主机或连接别的主机★"
Me.Caption = "聊吧" + "【" + User + "】"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    winsockMain.Close
End Sub

'//////////////  功能函数集
Private Sub lstCommon_Click()
txtMsg = lstCommon.Text
End Sub
Private Sub out(st As String)
txtInfo = st + Chr(13) + Chr(10) + txtInfo
End Sub
Private Sub lstCommon_DblClick()
cmdSend_Click
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show vbModal
End Sub
Private Sub mnuClose_Click()
skClose
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub txtInfo_Change()

End Sub

Private Sub txtMsg_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    cmdSend_Click
End If
End Sub

'//////////////  断开连接
Private Sub skClose()
winsockMain.Close
tcpConnected = False
txtMsg.Enabled = False
lstCommon.Enabled = False
cmdSend.Enabled = False
out "★连接已断开★"
End Sub

'//////////////发送数据
Private Sub cmdSend_Click()
If winsockMain.State <> sckClosed Then
    On Error GoTo erHandler4
    winsockMain.SendData User + ":" + txtMsg
    out User + ":" + txtMsg
    txtMsg = ""
Else
    out "【系统提示】对方已断开连接。"
    skClose
End If
Exit Sub
erHandler4:
out "【系统提示】数据发送错误，可能是对方已断开连接"
skClose
End Sub

'//////////////接收数据
Private Sub winsockMain_DataArrival(ByVal bytesTotal As Long)
winsockMain.GetData Buffer
out Buffer
End Sub

'/////////////客户端程序
Private Sub mnuConnect_Click()
If tcpConnected = False Then
    Ip = InputBox("请输入对方IP地址：", "连接", winsockMain.LocalIP)
    If Ip <> "" Then
        winsockMain.RemoteHost = Ip
        winsockMain.RemotePort = 1001
        On Error GoTo erHandler1
        winsockMain.Connect
        out "★正在连接，请稍候...★"
        tcpConnected = True
    End If
Else
    out "【系统提示】连接已经建立，请先断开连接！"
End If
Exit Sub
erHandler1:
out "【系统提示】连接发生错误!"
skClose
End Sub
Private Sub winsockMain_Connect()
out "★已经连接上主机，可以聊天了！★"
tcpConnected = True
txtMsg.Enabled = True
lstCommon.Enabled = True
cmdSend.Enabled = True
End Sub

'//////////////////主机端程序
Private Sub mnuCreate_Click()
If tcpConnected = False Then
    winsockMain.LocalPort = 1001
    On Error GoTo erHandler2
    winsockMain.Listen
    out "★正在等待连接，请稍候...★"
    tcpConnected = True
Else
    out "【系统提示】连接已经建立，请先断开连接！"
End If
Exit Sub
erHandler2:
out "【系统提示】连接发生错误!"
skClose
End Sub
Private Sub winsockMain_ConnectionRequest(ByVal requestID As Long)
out "★连接请求:来自" + winsockMain.RemoteHostIP + "★"
On Error GoTo erHandler3
If winsockMain.State <> sckClosed Then winsockMain.Close
winsockMain.Accept requestID
out "★连接已经建立★"
tcpConnected = True
txtMsg.Enabled = True
lstCommon.Enabled = True
cmdSend.Enabled = True
Exit Sub
erHandler3:
out "【系统提示】主机处理连接请求时发生错误!"
skClose
End Sub

'/////////////////错误处理
Private Sub winsockMain_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)
out "【系统提示】连接发生错误!"
skClose
End Sub