服务器.frm

网络棋牌游戏（可作为本科生课程设计使用）

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "聊天室服务器"
   ClientHeight    =   5895
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7410
   LinkTopic       =   "Form1"
   ScaleHeight     =   5895
   ScaleWidth      =   7410
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      BackColor       =   &H80000009&
      ForeColor       =   &H80000007&
      Height          =   4815
      Left            =   2040
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Top             =   480
      Width           =   5055
   End
   Begin VB.ListBox List2 
      Height          =   4740
      Left            =   240
      MultiSelect     =   2  'Extended
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Index           =   0
      Left            =   1680
      Top             =   5400
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label2 
      Caption         =   "现在人数:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "聊天内容:"
      Height          =   255
      Left            =   1920
      TabIndex        =   1
      Top             =   240
      Width           =   2535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit   '强制变量显式定义,既是定义变量名时一定要用Dim来声明
  Dim num As Integer
  Dim max As Integer
  Dim ind As Integer
  Dim winso As Integer
  
  Private Type activeuser
    clientname As String
    clientconnected As Boolean
    havaname As Boolean
  End Type
  
  Dim user(200) As activeuser
  Dim intmax As Integer
  
  Dim name1 As String
    
Private Sub Form_Load()
  num = 0
  ind = 0
  max = 200
  winso = 1
  
  Dim i As Integer
  For i = 1 To max
   Load Winsock1(i)
  Next
    
  Winsock1(0).LocalPort = 3128
  Winsock1(0).Listen
  
End Sub
    
Private Sub Form_Unload(Cancel As Integer)
  
  Dim i As Long
  For i = 0 To max
    Winsock1(i).Close
  Next
  
  Dim j As Integer
  For j = 1 To max
    Unload Winsock1(j)
  Next

End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  
  If winso < max Then
    Winsock1(winso).Accept requestID
    Text1.Text = Text1.Text + "接受某一客户端连接请求  本地端口 =" + Str(Winsock1(winso).LocalPort) + "  远程端口 =   " + Str(Winsock1(winso).RemotePort) + vbNewLine
    num = num + 1
    user(winso).clientconnected = True
    user(winso).havaname = False
    Label2.Caption = "现在人数: " + Str(num)
    winso = winso + 1
  End If

End Sub


Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
 
 Dim mydata     As String
 Dim length As Integer
 Dim dex As Integer
 Dim strdata As String
 Dim ch As String
 Dim hh As String
 Winsock1(Index).GetData mydata, vbString
 length = Len(mydata)
 
 ch = Mid(mydata, 1, 1)
 hh = Mid(mydata, 2, 1)
 strdata = Mid(mydata, 2, length - 1)
 
 
 Select Case ch
    Case "1"    '接收客户端传送他的名字
       ind = ind + 1
       user(Index).clientname = Str(ind) + strdata
       user(Index).havaname = True
       List2.AddItem user(Index).clientname
       Dim i As Integer
       For i = 0 To ind - 2  '给第一次上线的客户发送上线的客户名单
         Winsock1(Index).sendData Chr(3) + List2.List(i)
         DoEvents     'DoEvents表示转让控制权,把控制权交给操作系统,连续发送消息的时候必须让操作系统发送一条处理一条之后再继续发,
       Next           '不然会发生错误
       sendData Chr(3) + user(Index).clientname  '发送名字给各个客户端
       Text1.Text = Text1.Text + Mid(user(Index).clientname, 3, Len(user(Index).clientname) - 1) & "来了" + vbNewLine
       sendData user(Index).clientname & " 来了"
    Case "2"      '接收并且转发客户端传送的聊天内容
       Text1.Text = Text1.Text + Mid(user(Index).clientname, 3, Len(user(Index).clientname) - 1) + "说 : " + vbNewLine + strdata + vbNewLine
       sendData user(Index).clientname + "说 : " + vbNewLine + strdata
    Case "3"      '接收客户端离线的请求,并且转发给其他客户端
        user(Index).clientconnected = False
        If user(Index).havaname = True Then
           sendData user(Index).clientname + "走了"
           Text1.Text = Text1.Text + Mid(user(Index).clientname, 3, Len(user(Index).clientname) - 1) + "走了" + vbNewLine
        End If
        Winsock1(Index).Close
        
    Case Chr(2)    '转发客户端的悄悄话
        strdata = Mid(mydata, 3, length - 1)
        dex = CInt(hh)
        If user(dex).clientconnected = True Then
           Winsock1(dex).sendData user(Index).clientname + "悄悄对你说: " + vbNewLine + strdata + vbNewLine
           DoEvents
           Winsock1(Index).sendData "  你悄悄地对" + Mid(user(dex).clientname, 3, Len(user(dex).clientname) - 1) + "说: " + vbNewLine + strdata + vbNewLine
        Else
           Winsock1(Index).sendData user(dex).clientname + "已经走了"
           'MsgBox Mid(user(dex).clientname, 3, Len(user(dex).clientname) - 1) + "已经走了", vbInformation, "提示"
        End If
 End Select
 Form1.SetFocus   '响应提示
 Text1.SelStart = Len(Text1.Text)  'textbox控制它的滚动条一直都在最下面

End Sub

Private Sub sendData(sData As String)  '给所有用户转发消息的过程函数
  
  Dim i As Integer
  For i = 1 To num
    If user(i).clientconnected = True Then
      Winsock1(i).sendData sData
      DoEvents
    End If
  Next

End Sub