Attribute VB_Name = "Module1"
Public Connstring As String
Public Conn As Object
Public Rs As Object
Public Const db_host = "211.90.248.135"
Public Const db_name = "voice_db"
Public Const db_user = "retag"
Public Const db_pass = "qy7ttvj7vg"
Public Const maxnum = 100 '最大人數(shù)
Public Const roomnum = 10 '最大房間數(shù)
Public Const port = 701 '監(jiān)聽端口
Public Type User        '定義用戶信息變量
    Name As String
    RemoteIp As String
    RemotePort As String
    RoomID As String
End Type
Public Type Room
    CanTalk As Boolean
    Name As String
End Type
Public User_info(maxnum) As User    '定義用戶信息
Public room_info(roomnum) As Room   '定義房間信息

Public Sub log(i As String)  '日志過程
   log_info.db_log.Text = i + "(" + CStr(Now) + ")" + vbCrLf + log_info.db_log.Text
End Sub

Public Sub start_server()
       Call log("服務(wù)已啟動(dòng)")
       main.sckListen.Close
       main.sckListen.LocalPort = port
       main.sckListen.Listen
       main.Toolbar.Buttons(2).Enabled = False
       main.Toolbar.Buttons(3).Enabled = True
       main.Toolbar.Buttons(4).Enabled = True
End Sub

Public Sub pause_server()
    Call log("服務(wù)已暫停")
       main.sckListen.Close
       main.Toolbar.Buttons(2).Enabled = True
       main.Toolbar.Buttons(3).Enabled = False
       main.Toolbar.Buttons(4).Enabled = True
End Sub

Public Sub stop_server()
    Call log("服務(wù)已關(guān)閉")
       main.sckListen.Close
         For i = 0 To main.sckServer.Count - 1
            main.sckServer(i).Close
         Next i
       Conn.execute "delete from active"
       main.Toolbar.Buttons(2).Enabled = True
       main.Toolbar.Buttons(3).Enabled = False
       main.Toolbar.Buttons(4).Enabled = False
End Sub

Function bytes2BSTR(vIn)  '字節(jié)轉(zhuǎn)換函數(shù)
Dim strReturn
Dim i, ThisCharCode, NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn, i, 1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn, i + 1, 1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

Public Sub ConnectDataBase(db_host As String, db_name As String, db_user As String, db_pass As String)
    Set Conn = CreateObject("adodb.connection")   '連接數(shù)據(jù)庫
    Conn.open "driver={sql server};server=" + db_host + ";database=" + db_name + ";uid=" + db_user + ";pwd=" + db_pass
    Call log("成功接駁數(shù)據(jù)庫！")
End Sub

Public Sub CloseDataBase()   '關(guān)閉數(shù)據(jù)庫
    Conn.Close
    Set Conn = Nothing
End Sub

Public Sub ProcessData(s As Variant, index As Integer)   '分類處理數(shù)據(jù)
          s = bytes2BSTR(s)
          s_head = Left(s, InStr(2, s, "#"))
          s_main = Right(s, CInt(Len(s) - InStr(2, s, "#")))
          Select Case s_head
            Case "#USERLOGIN#"
               Call UserLogin(s_main, index)
            Case "#USERTALK#"
               Call UserTalk(s_main, index)
            Case "#TALKREQUEST#"
               Call TalkRequest(index)
          End Select
End Sub

Public Sub UserLogin(str As Variant, index As Integer) '用戶登陸
          str = Split(str, "#")
          User_info(index).Name = str(0)
          User_info(index).RemoteIp = str(1)
          User_info(index).RemotePort = str(2)
          User_info(index).RoomID = str(3)
          If User_info(index).Name = "" Or User_info(index).RoomID = "" Then
                  main.sckServer(index).Close
                  Exit Sub
          End If
          Set Rs = CreateObject("adodb.recordset")
          Rs.open "select * from active where name='" + User_info(index).Name + "'", Conn, 1, 3
          If Rs.EOF Then Rs.addnew
          Rs("name") = User_info(index).Name
          Rs("remoteip") = User_info(index).RemoteIp
          Rs("remoteport") = User_info(index).RemotePort
          Rs("roomid") = User_info(index).RoomID
          Rs("logintime") = Now()
          Rs("talk") = 0
          Rs.Update
          Rs.Close
          Set Rs = Nothing
          Call log("用戶：" + User_info(index).Name + Chr(10) + "IP：" + User_info(index).RemoteIp + ":" + User_info(index).RemotePort + Chr(10) + "房間號(hào)：" + User_info(index).RoomID + Chr(10) + "進(jìn)入聊天室")
End Sub

Public Sub UserLogout(index As Integer) '用戶離開
           If room_info(User_info(index).RoomID).Name = User_info(index).Name And room_info(User_info(index).RoomID).CanTalk = False Then room_info(User_info(index).RoomID).CanTalk = True
           Conn.execute "delete from active where name='" + User_info(index).Name + "'"
           Call log("用戶：" + User_info(index).Name + Chr(10) + "IP：" + User_info(index).RemoteIp + ":" + User_info(index).RemotePort + Chr(10) + "房間號(hào)：" + User_info(index).RoomID + Chr(10) + "退出聊天室")
           main.sckServer(index).Close
End Sub

Public Sub UserTalk(str As Variant, index As Integer)
          str = CInt(Left(str, 1))
          If str = 0 Then room_info(User_info(index).RoomID).CanTalk = True
          Conn.execute "update active set talk=0 where roomid='" + User_info(index).RoomID + "'"
          Conn.execute "update active set talk='" + CStr(str) + "' where name='" + User_info(index).Name + "'"
          
End Sub

Public Sub SendMessage(str As String, index As Integer)
          If str = "" Then Exit Sub
          If main.sckServer(index).State <> 7 Then
              MsgBox "對(duì)方并未連接，請(qǐng)重試！", vbOKOnly, "提示"
          Else
              main.sckServer(index).SendData "#MSG#" + str
          End If
End Sub

Public Sub BoardCast(str As String)
          If str = "" Then Exit Sub
          For i = 0 To main.sckServer.Count - 1 Step 1
               If main.sckServer(i).State = 7 Then
                    main.sckServer(i).SendData "#BC#" + str
                    DoEvents
               End If
          Next i
          MsgBox "發(fā)送廣播信號(hào)成功！", vbOKOnly, "提示"
End Sub

Public Sub Kick(str As String, index As Integer)
          Call SendMessage(str, index)
          UserLogout (index)
End Sub

Public Sub InitRoom()
          Set Rs = CreateObject("adodb.recordset")
          Rs.open "select * from room order by room_id", Conn, 1, 1
          If Rs.recordcount > roomnum Then
              MsgBox "房間設(shè)定出錯(cuò)！", vbOKOnly, "提示"
              End
              Exit Sub
          End If
          Rs.Close
          Set Rs = Nothing
          For i = 0 To roomnum - 1
             room_info(i).CanTalk = True
             room_info(i).Name = ""
          Next i
          Conn.execute "update active set talk=0"
End Sub

Public Sub TalkRequest(index As Integer)
          If room_info(User_info(index).RoomID).CanTalk = True Then
               room_info(User_info(index).RoomID).CanTalk = False
               room_info(User_info(index).RoomID).Name = User_info(index).Name
               main.sckServer(index).SendData "#TALK#"
          End If
End Sub

Public Sub CloseMic(index As Integer)
          If main.sckServer(index).State = 7 Then
              main.sckServer(index).SendData "#CLOSEMIC#"
          End If
End Sub

Public Sub CloseAllMic()
    Dim i As Integer
    For i = 0 To main.sckServer.Count - 1
        Call CloseMic(i)
        DoEvents
    Next i
    Call InitRoom
End Sub