client.frm

This article introduces how to construct a Hospital Ward Information System with three-tiered techno

Private Sub cmdLogout_Click()
    On Error GoTo that1
       Dim k
       If (MsgBox("真的要退出QICQ吗？", vbCritical + vbYesNo, "注销")) = vbYes Then
        '发送注销消息
        
            wskClient.SendData "QICQOUT" + g_selfName + "QICQOUT" + g_selfPwd + "QICQOUT"
        'wskClient.Close
        cmdLogout.Enabled = False
        cmdRegister.Enabled = False
        cmdFind.Enabled = False
        cmdInfo.Enabled = False
        cmdChat.Enabled = False
        cmdLogin.Enabled = True
        mnuLeft.Visible = False
        mnuRight.Visible = False
        If FriendCount > 0 Then
      
            For k = 1 To FriendCount - 1
                Unload imgFriend(k)
                Unload lblName(k)
            Next
            Set imgFriend(0).Picture = Nothing
            lblName(0).Caption = ""
            ReDim arrFriends(1) As FriendInfo
            FriendCount = 0
        End If
        For k = 0 To TwoCount - 1
            Unload frmNewTwo(k)
        Next
            TwoCount = 0
            ReDim frmNewTwo(1) As frmTwo
            
    End If
    Exit Sub
that1:
    
End Sub

Private Sub cmdRegister_Click()
    '注册
    frmReg.Show
End Sub

Private Sub Form_Load()
    Dim i As Integer
    
        picFriend.Left = tabStrip.ClientLeft
        picFriend.Top = tabStrip.ClientTop
        picFriend.Height = tabStrip.ClientHeight
        picFriend.Width = tabStrip.ClientWidth
        HScroll.Left = 0
        HScroll.Top = picFriend.ScaleHeight - HScroll.Height
        HScroll.Width = picFriend.ScaleWidth
        picHate.Left = tabStrip.ClientLeft
        picHate.Top = tabStrip.ClientTop
        picHate.Height = tabStrip.ClientHeight
        picHate.Width = tabStrip.ClientWidth
        HScroll2.Left = 0
        HScroll2.Top = picHate.ScaleHeight - HScroll2.Height
        HScroll2.Width = picHate.ScaleWidth
        picForeign.Left = tabStrip.ClientLeft
        picForeign.Top = tabStrip.ClientTop
        picForeign.Height = tabStrip.ClientHeight
        picForeign.Width = tabStrip.ClientWidth
        HScroll3.Left = 0
        HScroll3.Top = picForeign.ScaleHeight - HScroll3.Height
        HScroll3.Width = picForeign.ScaleWidth
      
    
    cmdLogout.Enabled = False
    cmdRegister.Enabled = False
    tabStrip.Tabs(1).Selected = True
    cmdFind.Enabled = False
    cmdInfo.Enabled = False
    cmdChat.Enabled = False
    mnuLeft.Visible = False
    mnuRight.Visible = False
    '初始化数组
    ReDim arrFriends(1) As FriendInfo
    FriendCount = 0
    ReDim arrCon(1) As ConInfo
    ConCount = 0
    ReDim frmNewTwo(1) As frmTwo
    TwoCount = 0

End Sub





Private Sub Form_Unload(Cancel As Integer)
    '注销
    If cmdLogout.Enabled Then
        cmdLogout_Click
    End If
    
End Sub

Private Sub HScroll_Change()
    Dim k As Integer
    
    For k = 0 To FriendCount - 1
        imgFriend(k).Top = imgFriend(k).Top - (HScroll.Value - HscrollValueBak)
        lblName(k).Top = lblName(k).Top - (HScroll.Value - HscrollValueBak)
    Next
    HscrollValueBak = HScroll.Value
End Sub





Private Sub imgFriend_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '有图像
    If lblName(Index).Caption <> "" Then
        selectIndex = Index
        If Button = 1 Then
            If arrFriends(Index).state = 1 Then
                mnuTwo.Enabled = True
                mnuSendandGet.Enabled = True
            Else
                mnuTwo.Enabled = False
                mnuSendandGet.Enabled = False
            End If
            PopupMenu mnuLeft
        ElseIf Button = 2 Then
            PopupMenu mnuRight
        End If
    End If
End Sub

Private Sub mnuDel_Click()
    '程序略
    MsgBox "在这里实现删除好友功能。"
End Sub

Private Sub mnuDetail_Click()
    '程序略
    MsgBox "在这里查看好友的详细信息。"
End Sub

Private Sub mnuFriend_Click()
    '程序略
    MsgBox "在这里实现把坏人设置为好友。"
End Sub

Private Sub mnuHate_Click()
    '程序略
    MsgBox "在这里实现把好友设置为坏人。"

End Sub

Private Sub mnuSendandGet_Click()
    '接收信息
    '发送信息
    '这两个由服务器转发给对方
    MsgBox "在这里可以给某个好友发送信息和接收他（她）发来的信息。", vbInformation, "发送和接收"
End Sub

Private Sub mnuTwo_Click()
    '这实现二人世界聊天
    
    frmConTwo.Show
End Sub



Private Sub tabStrip_Click()
    Select Case tabStrip.SelectedItem.Key
    Case "friend"
        picFriend.Visible = True
        picHate.Visible = False
        picForeign.Visible = False
    Case "hate"
        picFriend.Visible = False
        picHate.Visible = True
        picForeign.Visible = False
    Case "foreign"
        picFriend.Visible = False
        picHate.Visible = False
        picForeign.Visible = True
    End Select
End Sub


Private Sub wskClient_Connect()
    'MsgBox "连接成功！"
    Select Case g_Control
    Case REGCONTROL
        '注册
        frmReg.Show
    Case LOGINSERVER
        '用户登录
        wskClient.SendData "QICQLOG" + g_strName + "QICQLOG" + g_strPwd + "QICQLOG"
    End Select
    
End Sub

Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)
    Dim vardata As String
    Dim litem As ListItem
    Dim strsub As String
    Dim strsub1 As String
    'Dim conIndex As Integer
    Dim location As Integer
    Dim strip As String
    Dim strName  As String
    Dim port As Long
    Dim strQuery As String
    Dim intState As String
    Dim intImg As Integer
    Dim strNickName As String
    '获取数据
    wskClient.GetData vardata, vbString
    
    Select Case Left(vardata, 7)
        Case "QICQFND"
        '查找结果
        vardata = Right(vardata, Len(vardata) - 7)
        Do While InStr(1, vardata, "QICQFND", vbTextCompare) > 0
                k = InStr(1, vardata, "QICQFND", vbTextCompare)
                strsub = Left(vardata, k - 1)
                vardata = Right(vardata, Len(vardata) - k - 6)
                '对strsub分析
                location = 0
                Do While location < 5
                k = InStr(1, strsub, ",", vbTextCompare)
                strsub1 = Left(strsub, k - 1)
                strsub = Right(strsub, Len(strsub) - k)
                location = location + 1
                Select Case location
                Case 1
                    g_strName = strsub1
                Case 2
                    g_strNickName = strsub1
                Case 3
                    g_intImg = Int(strsub1)
                Case 4
                    g_intSex = Int(strsub1)
                Case 5
                    g_intState = Int(strsub1)
                End Select
            Loop
                '填充列表
                Set litem = frmFind.lstView.ListItems.Add(, , g_strNickName, , g_intImg)
                litem.Tag = g_strName
                Select Case g_intSex
                Case 0
                    litem.ListSubItems.Add , , "男"
                Case 1
                    litem.ListSubItems.Add , , "女"
                Case 2
                    litem.ListSubItems.Add , , "不告诉你"
                End Select
                Select Case g_intState
                Case 0
                    litem.ListSubItems.Add , , "不在线上"
                Case 1
                    litem.ListSubItems.Add , , "在线上"
                End Select
        Loop
        Exit Sub
    Case "QICQFAD"
        '添加好友
        vardata = Right(vardata, Len(vardata) - 7)
        k = InStr(1, vardata, "QICQFAD", vbTextCompare)
        strsub = Left(vardata, k - 1)
        vardata = Right(vardata, Len(vardata) - k - 6)
        '对strsub分析
        location = 0
        Do While location < 5
        k = InStr(1, strsub, ",", vbTextCompare)
        strsub1 = Left(strsub, k - 1)
        strsub = Right(strsub, Len(strsub) - k)
        location = location + 1
            Select Case location
            Case 1
                arrFriends(FriendCount).username = strsub1
            Case 2
                arrFriends(FriendCount).nickname = strsub1
            Case 3
                arrFriends(FriendCount).img = Int(strsub1)
            Case 4
                arrFriends(FriendCount).state = Int(strsub1)
            Case 5
                arrFriends(FriendCount).ip = strsub1
            End Select
        Loop
        '填充好友数组上
        FriendCount = FriendCount + 1
        ReDim Preserve arrFriends(UBound(arrFriends) + 1)
        If FriendCount = 1 Then
            k = 0
            imgFriend(k).Top = 100
            Set imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2 - arrFriends(k).state).Picture
        '图像显示