Attribute VB_Name = "mdlVar"
'用戶注冊詳細信息
Public g_strName As String
Public g_strPwd As String
Public g_intImg As Integer
Public g_intAge As Integer
Public g_intSex As Integer
Public g_strEmail As String
Public g_strAddress As String
Public g_strIntroduce As String
Public g_strNickName As String
Public g_strIP As String
Public g_intPort As Long

Public g_ServerPort As Long

Public g_bClose As Boolean

Public Sub RegisterNewUser(Index As Integer)
    Dim msgstr As String
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUserExist g_strName
    If dataE.rscmdUserExist.RecordCount <> 0 Then
        msgstr = "用戶已經存在！"
    Else
        dataE.Commands("cmdAdduser").CommandText = "insert into usertable(username,pwd,nickname,img,age,sex,email,address,introduce,registertime,lastlogin,logintime,logins,state,ip,port,conindex,friends,hates) values('" & g_strName & "','" & g_strPwd & "','" & g_strNickName & "','" & g_intImg & "','" & g_intAge & "','" & g_intSex & "','" & g_strEmail & "','" & g_strAddress & "','" & g_strIntroduce & "','" & Now & "','" & Now & "','" & Now & "','" & 1 & "','" & 1 & "','" & g_strIP & "','" & g_intPort & "','" & Index & "','QICQFRD','QICQHAT')"
        dataE.cmdAdduser
        msgstr = "用戶注冊成功！"
    End If
    frmServer.wskServer(Index).SendData "QICQSTA" + msgstr
End Sub

Public Sub Loginuser(Index As Integer)
    '用戶登錄
    Dim arrFriends() As String
    
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdFindUser g_strName, g_strPwd
    If dataE.rscmdFindUser.RecordCount <> 0 Then
        msgstr = "你成功登錄了！"
        dataE.Commands("cmdUpdate").CommandText = "update usertable set logintime='" & Now & "',state='" & 1 & "',ip='" & g_strIP & "',port='" & g_intPort & "',conindex='" & Index & "' where username='" & g_strName & "'and pwd='" & g_strPwd & "'"
        'MsgBox dataE.Commands("cmdadduser").CommandText
        dataE.cmdUpdate
        '向用戶發送“好友”、“壞人”名單和他們的狀態
        '發送好友名單
        Dim strFriends As String
        ReDim arrFriends(1) As String
        Dim k As Long
        Dim strSub As String
        Dim count As Integer
        count = 0
        strFriends = dataE.rscmdFindUser!friends
        strFriends = Right(strFriends, Len(strFriends) - 7)
        Do While Len(strFriends) > 7
           k = InStr(1, strFriends, "QICQFRD", vbTextCompare)
            strSub = Left(strFriends, k - 1)
            arrFriends(count) = strSub
            ReDim Preserve arrFriends(UBound(arrFriends) + 1)
            count = count + 1
            strFriends = Right(strFriends, Len(strFriends) - k - 6)
        Loop
        If count > 0 Then
        '有好友
            strSub = "QICQFRD"
            For k = 0 To count - 1
                If dataE.conQICQ.State <> adStateClosed Then
                    dataE.conQICQ.Close
                    dataE.conQICQ.Open
                End If
                dataE.cmdUserExist arrFriends(k)
                strSub = strSub + dataE.rscmdUserExist!username + "," + dataE.rscmdUserExist!nickname + "," + CStr(dataE.rscmdUserExist!img) + "," + CStr(dataE.rscmdUserExist!State) + "," + dataE.rscmdUserExist!ip + "," + "QICQFRD"
                '向所有在線的好友發送自己上線信息
                If dataE.rscmdUserExist!State = 1 Then
                    frmServer.wskServer(dataE.rscmdUserExist!conindex).SendData "QICQUPL" + g_strName + "," + g_strIP
                End If
            Next
            'MsgBox strSub
            frmServer.wskServer(Index).SendData strSub
        End If
        '發送壞人名單,這和上面的一樣，程序略
    Else
        msgstr = "沒有這個用戶！"
    End If
    frmServer.wskServer(Index).SendData "QICQSTA" + msgstr
   ' If msgstr = "用戶已經存在！" Then
    '    frmServer.wskServer(0).Close
      '  frmServer.wskServer(0).LocalPort = 716
     '   frmServer.wskServer(0).Listen
   ' End If
End Sub

Public Sub Logoutuser(Index As Integer)
    '用戶退出
    Dim arrFriends() As String
    Dim myname As String
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUser Index
    Dim strFriends As String
    ReDim arrFriends(1) As String
    Dim k As Long
    Dim strSub As String
    Dim count As Integer
    count = 0
    strFriends = dataE.rscmdUser!friends
    myname = dataE.rscmdUser!username
    strFriends = Right(strFriends, Len(strFriends) - 7)
    Do While Len(strFriends) > 7
       k = InStr(1, strFriends, "QICQFRD", vbTextCompare)
        strSub = Left(strFriends, k - 1)
        arrFriends(count) = strSub
        ReDim Preserve arrFriends(UBound(arrFriends) + 1)
        count = count + 1
        strFriends = Right(strFriends, Len(strFriends) - k - 6)
    Loop
    If count > 0 Then
    '有好友
        For k = 0 To count - 1
            If dataE.conQICQ.State <> adStateClosed Then
                dataE.conQICQ.Close
                dataE.conQICQ.Open
            End If
            dataE.cmdUserExist arrFriends(k)
            '向所有在線的好友發送自己離開信息
            If dataE.rscmdUserExist!State = 1 Then
                frmServer.wskServer(dataE.rscmdUserExist!conindex).SendData "QICQOUT" + myname
            End If
        Next
    End If
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
        dataE.Commands("cmdAdduser").CommandText = "update usertable set lastlogin='" & Now & "',state='" & 0 & "',conindex='" & -1 & "' where username='" & myname & "'"
        'MsgBox dataE.Commands("cmdadduser").CommandText
        dataE.cmdAdduser
        '關閉某連接
       ' CloseWinsock Index
End Sub

Public Sub CloseWinsock(Index As Integer)
    '減少關閉的wnsock
    frmServer.wskServer(Index).Close
    Unload frmServer.wskServer(Index)
End Sub

Public Sub Findalluser(Index As Integer)
    '查找所有的用戶信息
    Dim str As String
    
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdFindAll
    str = "QICQFND"
    Do While Not dataE.rscmdFindAll.EOF
        str = str + dataE.rscmdFindAll!username + "," + dataE.rscmdFindAll!nickname + "," + CStr(dataE.rscmdFindAll!img) + "," + CStr(dataE.rscmdFindAll!sex) + "," + CStr(dataE.rscmdFindAll!State) + ",QICQFND"
        dataE.rscmdFindAll.MoveNext
    Loop
    'MsgBox str
    frmServer.wskServer(Index).SendData str
End Sub

Public Sub Addfrd(strname As String, Index As Integer)
    '增加好友
    Dim strFriends As String
    Dim strUser As String
    Dim msg As String
    Dim intState As Integer
    Dim intImg As Integer
    Dim strNickname As String
    'Dim intconIndex As Integer
    Dim strIP As String
    Dim strHates As String
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUser Index
    '獲得朋友
    strFriends = dataE.rscmdUser!friends
    strUser = dataE.rscmdUser!username
    If InStr(1, strFriends, strname, vbTextCompare) > 1 Then
        msg = "好友已經存在！"
    ElseIf strUser = strname Then
        msg = "不能添加自己為好友！"
    ElseIf InStr(1, strHates, strname, vbTextCompare) > 1 Then
        '如果此人在壞人名單里，則先把他從壞人名單里除掉,程序略。
    Else
        '添加好友
        strFriends = strFriends + strname + "QICQFRD"
        dataE.Commands("cmdUpdate").CommandText = "update usertable set friends='" & strFriends & "' where username='" & strUser & "'"
        dataE.cmdUpdate
        dataE.cmdUserExist strname
        intState = dataE.rscmdUserExist!State
        intImg = dataE.rscmdUserExist!img
        strNickname = dataE.rscmdUserExist!nickname
        'intconIndex = dataE.rscmdUserExist!conindex
        strIP = dataE.rscmdUserExist!ip
        
        msg = "QICQFAD" + strname + "," + strNickname + "," + CStr(intImg) + "," + CStr(intState) + "," + strIP + "," + "QICQFAD"
    End If
    '返回信息
    frmServer.wskServer(Index).SendData msg
        
End Sub
Public Sub AddHate(strname As String, Index As Integer)
    '增加壞人，此程序和添加好友思路一樣。
End Sub

Public Sub SendTwoRequest(Index As Integer, strusername As String, port As Long, quest As String)
'請求二人世界處理
    Dim strNameQuery As String
    Dim strIP As String
    Dim strNickname As String
    Dim intImg As Integer
    Dim intState As Integer
    '查找申請用戶
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUser Index
    strNameQuery = dataE.rscmdUser!username
    strIP = dataE.rscmdUser!ip
    strNickname = dataE.rscmdUser!nickname
    intImg = dataE.rscmdUser!img
    intState = dataE.rscmdUser!State
    '查找被申請用戶
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUserExist strusername
    If dataE.rscmdUserExist!State = 1 Then
        '在線上
        frmServer.wskServer(dataE.rscmdUserExist!conindex).SendData "QICQRTC" + strNameQuery + "," + strIP + "," + CStr(port) + "," + strNickname + "," + CStr(intImg) + "," + CStr(intState) + "," + quest
    Else
        frmServer.wskServer(Index).SendData "QICQSTA" + "用戶不在線上！"
    End If
End Sub
Public Sub SendTwoResponse(Index As Integer, port As Long, strname As String)
'二人世界連接應答
    Dim intState As Integer
    Dim conindex As Integer
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUserExist strname
    intState = dataE.rscmdUserExist!State
    conindex = dataE.rscmdUserExist!conindex
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdUser Index

    If intState = 1 Then
        '在線上
        frmServer.wskServer(conindex).SendData "QICQATC" + dataE.rscmdUser!username + "," + CStr(port)
    Else
        frmServer.wskServer(Index).SendData "QICQATC" + "用戶不在線上！"
    End If
End Sub

Public Sub CloseAll()
    '關閉所有的連接
    Dim con() As Integer
    ReDim con(1) As Integer
    Dim count As Integer
    Dim k As Integer
    
    count = 0
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
    dataE.cmdFindAll
    Do While Not dataE.rscmdFindAll.EOF
        If dataE.rscmdFindAll!State = 1 Then
        'MsgBox dataE.rscmdFindAll!nickname & dataE.rscmdFindAll!conindex
        con(count) = dataE.rscmdFindAll!conindex
        count = count + 1
        ReDim Preserve con(UBound(con) + 1)
        End If
        dataE.rscmdFindAll.MoveNext
    Loop
    For k = 0 To count - 1
        frmServer.wskServer(con(k)).SendData "QICQSTA" + "系統關閉！"
        MsgBox "關閉連接" + CStr(con(k)) + "……", vbInformation, "關閉連接"
        'CloseWinsock con(k)
        'MsgBox con(k)
    Next
    'frmServer.wskServer(0).Close
    If dataE.conQICQ.State <> adStateClosed Then
        dataE.conQICQ.Close
        dataE.conQICQ.Open
    End If
        dataE.Commands("cmdAdduser").CommandText = "update usertable set lastlogin='" & Now & "',state='" & 0 & "',conindex='" & -1 & "'"
        dataE.cmdAdduser
   g_bClose = True

   'Unload frmServer
End Sub