简单的对聊程序

以下是主窗体的代码(frmMain.frm)

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain 
   Caption         =   "主窗体"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin MSWinsockLib.Winsock sckServer 
      Left            =   600
      Top             =   2040
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   1001
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出程序"
      Height          =   375
      Left            =   3000
      TabIndex        =   2
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "与他聊天"
      Height          =   375
      Left            =   3000
      TabIndex        =   1
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox txtRemoteHost 
      Height          =   375
      Left            =   600
      TabIndex        =   0
      Text            =   "localhost"
      Top             =   1200
      Width           =   2175
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdExit_Click()
    End
End Sub

'窗体加载时初始化聊天请求的监听控件
Private Sub Form_Load()
    sckServer.LocalPort = 1001
    sckServer.Listen
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If sckServer.State <> sckClosed Then sckServer.Close
End Sub
'处理新的请求
Private Sub sckServer_ConnectionRequest(ByVal requestID As Long) '接收新的连接请求
    Dim frm As frmChart
    Set frm = New frmChart
    frm.ReceiveRequest (requestID)
    frm.Show
End Sub

'处理由本机发起的聊天请求
Private Sub cmdConnect_Click() 
    Dim frm As frmChart
    Set frm = New frmChart
    frm.Connection txtRemoteHost.Text
    frm.Show
End Sub

以下是聊天窗体的代码(frmChart.frm)

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmChart 
   Caption         =   "聊天窗口"
   ClientHeight    =   5550
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6270
   LinkTopic       =   "Form1"
   ScaleHeight     =   5550
   ScaleWidth      =   6270
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送(&S)"
      Height          =   495
      Left            =   4560
      TabIndex        =   2
      Top             =   4800
      Width           =   1215
   End
   Begin VB.TextBox txtSend 
      Height          =   1935
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   2520
      Width           =   5415
   End
   Begin VB.TextBox txtOutput 
      Height          =   1935
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   480
      Width           =   5295
   End
   Begin MSWinsockLib.Winsock sckChart 
      Left            =   360
      Top             =   4560
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label labAddress 
      Caption         =   "对方地址"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   0
      Width           =   1335
   End
End
Attribute VB_Name = "frmChart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'发送信息
Private Sub cmdSend_Click()
    If Right(txtSend.Text, 2) = vbCrLf Then
        txtSend.Text = Left(txtSend.Text, Len(txtSend) - 1) '去掉最后一个回车
    End If
    sckChart.SendData txtSend.Text
    SetOutText txtSend.Text, "自己"
    txtSend.Text = "" '清空发送窗口
End Sub

'在窗体关闭时不要忘了关闭连接
Private Sub Form_Unload(Cancel As Integer)
    If sckChart.State <> sckClosed Then sckChart.Close
End Sub

'对方关闭连接时关闭聊天窗体
Private Sub sckChart_Close()
    Unload Me
End Sub

'数据到达时
Private Sub sckChart_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    sckChart.GetData strData
    Dim sender As String
    If sckChart.RemoteHost = "" Then
        sender = sckChart.RemoteHostIP
    Else
        sender = sckChart.RemoteHost
    End If
    SetOutText strData, sender
End Sub

'发起一个聊天请求
Public Sub Connection(ByVal RemoteHost As String)
    sckChart.RemoteHost = RemoteHost
    sckChart.RemotePort = 1001
    sckChart.Connect
    Me.Caption = RemoteHost
    labAddress.Caption = sckChart.RemoteHostIP
End Sub

'接收一个聊天请求
Public Sub ReceiveRequest(ByVal requestID As Long)
    sckChart.Protocol = sckTCPProtocol
    sckChart.Accept requestID
    If Len(sckChart.RemoteHost) = 0 Then
        Me.Caption = sckChart.RemoteHostIP
    Else
        Me.Caption = sckChart.RemoteHost
    End If
    labAddress.Caption = sckChart.RemoteHostIP
End Sub

'设置聊天内容输出格式
Private Sub SetOutText(ByVal strData As String, ByVal sender As String)
    If Me.txtOutput.Text <> "" Then Me.txtOutput.Text = Me.txtOutput.Text + vbCrLf
    Me.txtOutput.Text = Me.txtOutput.Text & "[" & _
        sender & "]" & Now() & vbCrLf & strData
End Sub

'使用 Ctrl + Enter 发送信息
Private Sub txtSend_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim ctrlDown As Boolean
    ctrlDown = (vbCtrlMask And Shift) > 0
    If KeyCode = vbKeyReturn And ctrlDown Then
        cmdSend_Click
    End If
End Sub