frmserver_chat.frm

串口程序

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmServer_Chat 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "利用Winsock控件基于TCP的局域网多站点通信程序（服务器端）"
   ClientHeight    =   6450
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6240
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6450
   ScaleWidth      =   6240
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame2 
      Caption         =   "通信记录"
      Height          =   3135
      Left            =   480
      TabIndex        =   1
      Top             =   2640
      Width           =   5175
      Begin VB.TextBox Text_GetData 
         Height          =   2775
         Left            =   240
         MultiLine       =   -1  'True
         TabIndex        =   3
         Top             =   240
         Width           =   4695
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "连接状态信息"
      Height          =   2415
      Left            =   480
      TabIndex        =   0
      Top             =   120
      Width           =   5175
      Begin VB.ListBox List_ConnectInformation 
         Height          =   1680
         ItemData        =   "frmServer_Chat.frx":0000
         Left            =   240
         List            =   "frmServer_Chat.frx":0002
         TabIndex        =   2
         Top             =   600
         Width           =   4695
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "连接端口"
         Height          =   180
         Left            =   3960
         TabIndex        =   6
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "客户机IP"
         Height          =   180
         Left            =   1920
         TabIndex        =   5
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "序号"
         Height          =   180
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   360
      End
   End
   Begin MSWinsockLib.Winsock TcpServer_Chat 
      Index           =   0
      Left            =   0
      Top             =   360
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "本服务器IP："
      Height          =   180
      Left            =   480
      TabIndex        =   7
      Top             =   6000
      Width           =   1080
   End
End
Attribute VB_Name = "frmServer_Chat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Clients As Integer '可带客户机数量常量

Private Sub Form_Load()
    Dim I As Integer
    Clients = 252 '客户机数量252
    TcpServer_Chat(0).Protocol = sckTCPProtocol '使用TCP协议
    TcpServer_Chat(0).LocalPort = 1200 '服务器连接端口1200
    Label4.Caption = "本服务器IP：" & TcpServer_Chat(0).LocalIP '显示本服务器IP
    TcpServer_Chat(0).Listen '利用1200端口进行侦听
    For I = 1 To Clients '动态装载252个Winsock控件
        Load TcpServer_Chat(I)
    Next
    Text_GetData.Text = "" '清空通信记录框
End Sub

Private Sub TcpServer_Chat_Close(Index As Integer)
    RemoveList Index '移除连接状态栏中的项目
    TcpServer_Chat(Index).Close '关闭Winsock控件
    Unload TcpServer_Chat(Index) '卸载Winsock控件
    Load TcpServer_Chat(Index) '动态装载Winsock控件
End Sub

Private Sub TcpServer_Chat_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'侦听响应
Dim I As Integer
    Dim Temps As Integer
    For I = 1 To Clients
        If TcpServer_Chat(I).State = sckClosed Then
            TcpServer_Chat(I).Accept requestID
            Temps = I
            Exit For
        End If
    Next
    '添加连接状态记录
    ListReFresh Temps & "             " & TcpServer_Chat(Temps).RemoteHostIP & "             " & TcpServer_Chat(Temps).RemotePort
  End Sub
Private Sub TcpServer_Chat_DataArrival(Index As Integer, ByVal bytesTotal As Long)
 On Error Resume Next
    '转发客户机发来的信息
    Dim I As Integer
    Dim ClientData As Variant
    TcpServer_Chat(Index).GetData ClientData, vbString
    Text_GetData.Text = Text_GetData.Text & ClientData & vbCrLf
    For I = 1 To Clients
        If TcpServer_Chat(I).State = sckConnected Then
            TcpServer_Chat(I).SendData ClientData
            DoEvents
        End If
    Next
End Sub

Private Sub ListReFresh(Optional ClientDatas As String)
    '自定义的连接状态记录刷新过程
    Dim I As Integer
    If Trim(ClientDatas) <> "" Then
        List_ConnectInformation.AddItem ClientDatas
    End If
End Sub

Private Function RemoveList(ByVal Index As Integer)
'自定义的连接状态记录移出过程
Debug.Print "fdsaf"
    Dim I As Integer
    Dim Datas
    For I = 1 To List_ConnectInformation.ListCount
        List_ConnectInformation.ListIndex = I - 1
        Datas = Split(List_ConnectInformation.Text, " ")
        If Val(Datas(0)) = Index Then
            List_ConnectInformation.RemoveItem List_ConnectInformation.ListIndex
            List_ConnectInformation.Refresh
            Exit Function
        End If
    Next
End Function