frmserver.frm

关于WINSOCK控件基本编程的例程,提供电子邮件例程

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "聊天室－服务器"
   ClientHeight    =   6315
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5505
   LinkTopic       =   "Form1"
   ScaleHeight     =   6315
   ScaleWidth      =   5505
   StartUpPosition =   3  '窗口缺省
   Begin MSWinsockLib.Winsock SckServer 
      Index           =   0
      Left            =   3720
      Top             =   5880
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock scklisten 
      Left            =   1680
      Top             =   5880
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   2001
   End
   Begin VB.CommandButton Command3 
      Caption         =   "发送信息"
      Height          =   735
      Left            =   3360
      TabIndex        =   3
      Top             =   5040
      Width           =   2055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "踢出聊天室"
      Height          =   615
      Left            =   3360
      TabIndex        =   2
      Top             =   2760
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查看IP"
      Height          =   615
      Left            =   3360
      TabIndex        =   1
      Top             =   360
      Width           =   2055
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   5535
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   9763
      View            =   2
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FlatScrollBar   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483641
      BackColor       =   -2147483628
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Function FindOpenWinsock()
'此函数用来为新用户提供新的控件
    Static LocalPorts As Integer
    For X = 0 To SckServer.UBound
        If SckServer(X).State = 0 Then
            '如果状态为0，即关闭，我们可以使用它
            FindOpenWinsock = X
            '跳出函数，当然也跳出了循环
            Exit Function
        End If
    Next X
    '没有可用的，就装载一个最新的
    Load SckServer(SckServer.UBound + 1)
    '加一保证所用的端口互不相同
    LocalPorts = LocalPorts + 1
    SckServer(SckServer.UBound).LocalPort = SckServer(wsArray.UBound).LocalPort + LocalPorts
    '返回新的序号值，即新装载控件的序号
    FindOpenWinsock = SckServer.UBound
End Function

Private Sub Command1_Click()
On Error GoTo 0
    For i = 0 To ListView1.ListItems.Count - 1
        If ListView1.ListItems(i).Selected = True Then
            '通过用户名获得它所使用WINSOCK控件的Index，然后显示其IP
            MsgBox SckServer(NameInfo(ListView1.ListItems(i))).RemoteHostIP, vbOKOnly, "IP"
        End If
        Exit For
    Next i
End Sub

Private Sub Command2_Click()
    '服务器断开，中断服务
    For i = 0 To ListView1.ListItems.Count - 1
        If ListView1.ListItems(i).Selected = True Then
            SckServer(NameInfo(ListView1.ListItems(i))).Close
            ListView1.ListItems.Remove (NameInfo(ListView1.ListItems(i)))
        End If
        Exit For
    Next i
End Sub

Private Sub Command3_Click()
    Dim SerInfo As String
    For i = 0 To ListView1.ListItems.Count - 1
        If ListView1.ListItems(i).Selected = True Then
            SerInfo = InputBox("请输入消息内容", "serinfo")
            '发送消息到客户端
            '规定"~si~"为服务器消息标志
            SckServer(NameInfo(ListView1.ListItems(i))).SendData "~si~|" & LenInfo(SerInfo) & SerInfo
        End If
        Exit For
    Next i
End Sub

Private Sub Form_Load()
    '开始监听
    scklisten.Listen
End Sub

Private Sub scklisten_ConnectionRequest(ByVal requestID As Long)
    Index = FindOpenWinsock
    '由新装载的控件接受客户的连接请求
    SckServer(Index).Accept requestID
    UserIndex = UserIndex + 1
End Sub

Private Sub SckServer_Close(Index As Integer)
    UserIndex = UserIndex - 1
End Sub

Private Sub SckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim Len1, Len2, Len3, Len4 As Integer
Dim GetData, Neir, ToName As String
Neir = ""
SckServer(Index).GetData GetData, vbString
MsgBox GetData
'先判断是否在聊天室内
'规定"~ni~"为不在聊天室标志
If Left$(GetData, 4) = "~ni~" Then
    '判断是否有请求进入聊天室标志
    If Mid$(GetData, 6, 4) = "~ai~" Then
        Len1 = Mid$(GetData, 11, 1)
        Len2 = Val(Mid$(GetData, 12, Len1))
        '通过长度信息得到用户名
        User(Index) = Right$(GetData, Len2)
        '加入到聊天者列表中
        ListView1.ListItems.Add UserIndex, , User(Index)
    End If
'先判断是否在聊天室内
'规定"~in~"为在聊天室内标志
If Left$(GetData, 4) = "~in~" Then
    '判断是否有请求名单标志
    '规定"~aw~"为请求名单标志
    If Mid$(GetData, 6, 4) = "~aw~" Then
        For i = 0 To ListView1.ListItems.Count - 1
            '逐个将名单发送
            SckServer(Index).SendData "~nb~|" & LenInfo(ListView1.ListItems(i)) & ListView1.ListItems(i)
        Next i
    End If
    '判断是否要请求退出
    '规定"~wo~"为请求退出标志
    If Mid$(GetData, 6, 4) = "~wo~" Then
        '发送同意退出标志
        SckServer(Index).SendData "~aq~"
        '相应的服务器关闭
        SckServer(Index).Close
        '清除在服务器中的显示
        ListView1.ListItems.Remove (Index)
    End If
    '判断是否有公开聊天标志
    '规定"~ev~"为公开聊天标志
    If Mid$(GetData, 6, 4) = "~ev~" Then
        Len1 = Mid$(GetData, 11, 1)
        Len2 = Val(Mid$(GetData, 12, Len1))
        Neir = Right$(GetData, Len2)
        For i = 0 To SckServer.UBound
            If SckServer(i).State = 7 Then
                '向参与聊天的每个人发送此消息
                '对于每个WINSOCK控件，必须判断其状态
                SckServer(i).SendData "~ev~|" & LenInfo(Neir) & Neir
            End If
        Next i
    End If
    '判断是否为私聊
    '规定"~on~"为私聊标志
    If Mid$(GetData, 6, 4) = "~on~" Then
        '先获得私聊的对象
        Len1 = Mid$(GetData, 11, 1)
        Len2 = Mid$(GetData, 12, Len1)
        ToName = Mid$(GetData, 11 + Len1, Len2)
        '再获得私聊的内容
        Len3 = Mid$(GetData, 11 + Len1 + Len2, 1)
        Len4 = Mid$(GetData, 11 + lne1 + Len2 + Len3, Len3)
        Neir = Right$(GetData, Len4)
        '向私聊对象发送消息，由相应的WINSOCK发送
        SckServer(NameInfo(ToName)).SendData "~on~|" & LenInfo(ToName) & ToName & LenInfo(nei) & nei
    End If
End If
End If
End Sub

Private Sub SckServer_Error(Index As Integer, 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)
    SckServer(Index).Close
End Sub