frmserver.frm

大量优秀的vb编程

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmServer 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "聊天程序_服务器"
   ClientHeight    =   5436
   ClientLeft      =   48
   ClientTop       =   324
   ClientWidth     =   8340
   Icon            =   "frmserver.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5436
   ScaleWidth      =   8340
   Begin VB.CommandButton Command2 
      Caption         =   "退出程序"
      Height          =   372
      Left            =   3720
      TabIndex        =   9
      Top             =   4920
      Width           =   972
   End
   Begin VB.CommandButton Command1 
      Caption         =   "断开连接"
      Height          =   372
      Left            =   2160
      TabIndex        =   8
      Top             =   4920
      Width           =   972
   End
   Begin VB.Frame Frame1 
      Height          =   660
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   8052
      Begin VB.TextBox TxtSend 
         Height          =   420
         Left            =   915
         TabIndex        =   6
         Top             =   165
         Width           =   6972
      End
      Begin VB.Label Label4 
         Alignment       =   2  'Center
         Caption         =   "发送"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.4
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Left            =   105
         TabIndex        =   7
         Top             =   225
         Width           =   810
      End
   End
   Begin VB.ListBox lstClient 
      BackColor       =   &H00E0E0E0&
      ForeColor       =   &H00000000&
      Height          =   3468
      Left            =   5820
      TabIndex        =   0
      Top             =   1212
      Width           =   2355
   End
   Begin MSWinsockLib.Winsock tcpServer 
      Index           =   0
      Left            =   3000
      Top             =   3240
      _ExtentX        =   593
      _ExtentY        =   593
      _Version        =   393216
   End
   Begin RichTextLib.RichTextBox rtbSave 
      Height          =   3516
      Left            =   36
      TabIndex        =   1
      Top             =   1200
      Width           =   5808
      _ExtentX        =   10245
      _ExtentY        =   6202
      _Version        =   393217
      BackColor       =   16777215
      ScrollBars      =   3
      TextRTF         =   $"frmserver.frx":0442
   End
   Begin VB.Label Label3 
      Caption         =   "服务器端口"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   336
      Left            =   3276
      TabIndex        =   4
      Top             =   852
      Width           =   2076
   End
   Begin VB.Label Label2 
      Caption         =   "连接的客户端"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Left            =   5796
      TabIndex        =   3
      Top             =   840
      Width           =   1500
   End
   Begin VB.Label Label1 
      Caption         =   "服务器地址"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Left            =   72
      TabIndex        =   2
      Top             =   876
      Width           =   3240
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Num As Integer
Dim flag As Boolean
'Dim member(1 To 10) As Integer
Dim NumOnline As Integer
Dim clientName(1 To 5)
Private Sub Command1_Click()
For i = 1 To Num
    tcpServer(i).Close
    
    Next i

End Sub


Private Sub Command2_Click()
    End
End Sub

Private Sub Form_Load()
Num = 0
NumOnline = 0
tcpServer(0).LocalPort = 2000
tcpServer(0).Listen
Label1.Caption = Label1.Caption + CStr(tcpServer(0).LocalIP)
Label3.Caption = Label3.Caption + CStr(tcpServer(0).LocalPort)


End Sub



Private Sub tcpServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'For i = 1 To Num
'If tcpServer.State <> sckClosed Then tcpServer.Close
'tcpServer(Num - 1).Accept requestID
'Next i
If Index = 0 Then
    Num = Num + 1
    NumOnline = NumOnline + 1
    Load tcpServer(Num)
  'member(Num) = 1
     tcpServer(Num).LocalPort = 0
    tcpServer(Num).Accept requestID
  
    
    End If

End Sub

Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sData As String
Dim sName As String

   tcpServer(Index).GetData sData
    'rtbSave.Text = sData
   rtbSave.SelStart = Len(rtbSave.Text)
 
    sName = Left(sData, 1)
    If sName = "C" Then
    
    'rtbSave.SelLength = Len(rtbSave.Text)

    lstClient.AddItem sData + CStr(Now())
    tcpServer(Index).SendData "C_OK"
    ElseIf sName = "Q" Then
    tcpServer(Index).SendData "Q_OK."
    lstClient.AddItem sData + CStr(Now())
    'lstClient.RemoveItem -1
  '  member(Index) = 0
    
    tcpServer(Index).Close
    NumOnline = NumOnline - 1
    rtbSave.SelStart = Len(rtbSave.Text)
       rtbSave.Text = rtbSave.Text + sData

    
        End If
    'rtbSave.SelStart = Len(rtbSave.Text)
 rtbSave.SelStart = Len(rtbSave.Text)
    rtbSave.Text = rtbSave.Text + Chr(10) + sData + CStr(Now())
  
    rtbSave.SelStart = Len(rtbSave.Text)
    
End Sub




Private Sub TxtSend_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    For i = 1 To Num
       ' If member(i) = 0 Then
        '    Exit Sub
        'Else
         If tcpServer(i).State = sckClosed Then
            Exit For
        Else
            tcpServer(i).SendData "服务器：" & TxtSend.Text
            'rtbSave.Text = rtbSave.Text + TxtSend.Text
        End If
        Next i
        rtbSave.SelStart = Len(rtbSave.Text)
 rtbSave.Text = rtbSave.Text + Chr(10) + "服务器：" & TxtSend.Text & CStr(Now())
TxtSend.Text = ""
End If

End Sub