serverfrm.frm

短信与酒店管理系统

Private Sub Form_Unload(Cancel As Integer)
    If Me.MSComm1.PortOpen = True Then Me.MSComm1.PortOpen = False
    Dim i As Integer
        '关闭还没有关闭的Winsock连接
        For i = 1 To ClMax
            If Me.SockToCln(i).State <> sckClosed Then
                Me.SockToCln(i).Close
            End If
        Next i
End Sub

'网络连接关闭
Private Sub SockToCln_Close(index As Integer)
Dim i As Integer
Dim FindItm As ListItem

    For i = 1 To ClMax
        '找到该连接
        If Client(i).index = index Then
            Set FindItm = Me.LvCnn.FindItem(Client(i).UsrID)
                FindItm.SubItems(1) = "断开"
                FindItm.SubItems(2) = Now
            Exit For
        End If
    Next i
    
End Sub

'接受连接请求
Private Sub SockToCln_ConnectionRequest(index As Integer, ByVal requestID As Long)
Dim i As Integer
    
    '查询是否有关闭的空闲控件
    For i = 1 To MaxSvrSock
        If SockToCln(i).State = sckClosed Then
            SockToCln(i).LocalPort = 0
            '不能占用侦听端口
            If SockToCln(i).LocalPort = SvrPort Then
                Exit Sub
            End If
            SockToCln(i).Accept requestID
            Exit Sub
        End If
    Next i
       
    '没有空闲的控件,原有socket都被占用，需要新增Winsock
    MaxSvrSock = MaxSvrSock + 1             '控件数增加
    Load SockToCln(MaxSvrSock)              '动态生成一个winsock控件
    SockToCln(MaxSvrSock).LocalPort = 0     '设置新端口
    SockToCln(MaxSvrSock).Accept requestID  '接受连接请求

End Sub

'接受并处理数据
Private Sub SockToCln_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim StrArrival As String, StrGet() As String
Dim strback As String
Dim phoneNum, msgTxt As String
Dim bkNum As Long
Dim StatNum As Integer
Dim UsrID As String
Dim UsrPwd As String
Dim i As Integer
Dim Sendall As Boolean
    
    '接受数据
    Me.SockToCln(index).GetData StrArrival, vbString
    If Len(StrArrival) < 1 Then Exit Sub
    '拆分接收到的数据
    StrGet() = Split(StrArrival, "*", -1)
    
    '判断类型
    Select Case StrGet(0)
    '检索联系人
    Case "Linkman"
        strback = LinkMan(StrGet, index)
    '发送短信
    Case "Send"
        Sendall = True
        For i = 1 To UBound(StrGet) - 1
            phoneNum = StrGet(i)
            msgTxt = StrGet(UBound(StrGet))
            If Sendmsg(phoneNum, msgTxt, index) = False Then
                strback = "Send*" & i - 1 & "条信息发送成功！"
                Sendall = False
                Exit For
            End If
        Next i
        If Sendall = True Then
            strback = "Send*" & "全部短信发送成功！"
        End If
    '修改密码
    Case "User"
        strback = Mcode(StrGet(1), StrGet(2), index)
    '手机号码管理（增删改）
    Case "Phone"
        Select Case StrGet(1)
            Case "Add"
                strback = AddPhone(StrGet(3), StrGet(4), StrGet(5), StrGet(2), index)
            Case "Modify"
                strback = MPhone(StrGet(3), StrGet(4), StrGet(2))
        End Select
    '读取信息
    Case "Read"
        If UBound(StrGet) = 2 Then
            strback = ReadMsg(Val(StrGet(1)), -1, StrGet(2))
        Else
            strback = ReadMsg(Val(StrGet(1)), index)
        End If
    Case "DeleteMSg"
        strback = DeleteMsg(StrGet)
    Case "SetState"
        SetState Val(StrGet(1))
    Case "SInformation"
        Select Case StrGet(1)
            Case "01"
                strback = ViewInfo(index)
            Case "02"
                strback = SUpdate(StrGet)
            Case "03"
                strback = SView(StrGet(2))
            Case "04"
                strback = InfoDel(StrGet(2))
            Case "05"
                strback = ViewInfo(-1, StrGet(2))
        End Select
    Case "AddClass"
        strback = AddClass(StrGet(1), StrGet(2), StrGet(3))
    Case "ViewClass"
        strback = ViewClass()
    Case "DeleteClass"
        strback = DClass(StrGet)
    Case "ModifyClass"
        strback = CUpdate(StrGet)
    Case "SelectClass"
        strback = SClass()
    '图书借阅
'    Case "Lend"
'        '得到RdrID和BkNum
'        RdrID = StrGet(1)
'        bkNum = Val(StrGet(2))
'        '回复客户端
'        strBack = CheckLend(RdrID, bkNum)
'
'    '图书归还
'    Case "Return"
'        '得到BkNum
'        bkNum = Val(StrGet(1))
'        '回复客户端
'        strBack = CheckReturn(bkNum)
'
'    '缴纳欠款
'    Case "Pay"
'        '得到RdrID
'        RdrID = StrGet(1)
'        '回复客户端
'        strBack = CheckPay(RdrID)
'
'    '操作图书类别
'    Case "Type"
'        '调用BookType函数处理图书管理命令
'        strBack = BookType(StrGet, index)
'
'    '图书管理
'    Case "Book"
'        '调用BookInfo函数处理图书管理命令
'        strBack = BookInfo(StrGet, index)
'
'   '读者管理
'   Case "Rdr"
'        '调用Reader函数处理图书管理命令
'        strBack = Reader(StrGet, index)
'
'    '管理员管理
'    Case "Usr"
'        '调用User函数处理图书管理命令
'        strBack = User(StrGet, index)
'
'    Case "Stat"
'        '得到StatNum
'        StatNum = Val(StrGet(1))
'        '回复客户端
'        strBack = CheckStat(StatNum)
'
    '连接信息
    Case "Cnn"
        '得到UsrID和UsrPwd
        UsrID = StrGet(1)
        UsrPwd = StrGet(2)
        '回复客户端
        strback = CheckUsr(UsrID, UsrPwd, index)
        
    End Select
    
    '检验sock连接
    If Me.SockToCln(index).State <> sckConnected Then
        Exit Sub
    End If
    '发送返回信息
    Me.SockToCln(index).SendData strback
    
End Sub

Private Function CheckUsr(ByVal UsrID As String, _
                          ByVal UsrPwd As String, _
                          ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr, strSql(2), strSql1 As String
Dim bEnter As Boolean
Dim FindItm As ListItem, LtItm As ListItem
Dim rs(3) As Recordset
Dim i, count As Integer
     '1.读出数据库中的记录
     '2.找到输入的管理员名
     '3.比较输入的密码是否与数据库中的记录相符
     '4.返回响应信息
     
     bEnter = False
     DBstr = "select * from class where cl_id='" & UsrID & "'"
     strSql1 = "select * from manager where manager_id='" & UsrID & "'"
     '打开数据集
     rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockReadOnly, -1
     
     '返回响应信息
     CheckUsr = "Cnn*"
     '查找到的记录数为0
     If rsCheck.RecordCount <= 0 Then  '找不到该管理员名
         Set rs(3) = DBCnn.Execute(strSql1)
         If rs(3).RecordCount = 0 Then
            CheckUsr = CheckUsr & "该管理员名不存在！请重新输入！"
         Else
            If UsrPwd = Trim(rs(3).Fields("ma_code").Value) Then
                CheckUsr = CheckUsr & "01" & "*" & "欢迎进入家校通！"
                bEnter = True
            Else
                CheckUsr = CheckUsr & "密码错误！请重新输入！"
            End If
         End If
     Else
         '数据集指针指向第一个记录，这里查找到的记录唯一
         rsCheck.MoveFirst
         If UsrPwd = Trim(rsCheck.Fields("cl_code").Value) Then
             '返回信息
             strSql(1) = "select count(*) from student,message where s_phone=sender " & " and cl_id='" & UsrID & "' and state=0"
             strSql(2) = "select count(*) from student,message where parent_phone=sender " & " and cl_id='" & UsrID & "' and state=0"
             For i = 1 To 2
                Set rs(i) = DBCnn.Execute(strSql(i))
             Next i
             n = Val(rs(1).Fields(0).Value + rs(2).Fields(0).Value)
             CheckUsr = CheckUsr & "02" & "*" & "欢迎进入家校通！"
             If n <> 0 Then
                CheckUsr = CheckUsr & "*" & n
             End If
             bEnter = True
         Else
             CheckUsr = CheckUsr & "密码错误！请重新输入！"
         End If
     End If
     '关闭数据集
     rsCheck.Close
     
    If bEnter Then
        '最大连接数加1
        ClMax = ClMax + 1
        Client(ClMax).UsrID = UsrID
        Client(ClMax).index = index
        
        '添加到连接状态列表中
        Set FindItm = Me.LvCnn.FindItem(Client(ClMax).UsrID)
            If FindItm Is Nothing Then  '找不到，添加新列表
                Set LtItm = Me.LvCnn.ListItems.Add()
                    LtItm.Text = Client(ClMax).UsrID
                    LtItm.SubItems(1) = "登录"
                    LtItm.SubItems(2) = Now
                    LtItm.SubItems(3) = index
            Else                        '已有，更改
                FindItm.SubItems(1) = "登录"
                FindItm.SubItems(2) = Now
                FindItm.SubItems(3) = index
            End If
        '在状态栏显示连接数
        'Me.StatusBar1.Panels(1).Text = "客户端连接数：" & ClMax
    End If
End Function

Function LinkMan(ByRef StrGet() As String, index As Integer) As String
    Dim UserID As String
    Dim strSql As String
    Dim i As Integer
    LinkMan = "Linkman"
    For i = 1 To ClMax
        If Client(i).index = index Then
            UserID = Client(i).UsrID
        End If
    Next i
    Select Case StrGet(1)
        Case "01"
            strSql = "select s_id,s_name,s_phone from student where cl_id='" & UserID & "'"
            LinkMan = LinkMan & "*01"
            LinkMan = LinkMan & RunSql(strSql, "学生")
        Case "02"
            strSql = "select s_id,parent_name,parent_phone from student where cl_id='" & UserID & "'"
            LinkMan = LinkMan & "*02"
            LinkMan = LinkMan & RunSql(strSql, "家长")
        Case "03"
            strSql = "select s_id,s_name,s_phone from student where cl_id='" & UserID & "'"
            LinkMan = LinkMan & "*03"
            LinkMan = LinkMan & RunSql(strSql, "学生")
        Case "04"
            strSql = "select s_id,parent_name,parent_phone from student where cl_id='" & UserID & "'"
            LinkMan = LinkMan & "*04"
            LinkMan = LinkMan & RunSql(strSql, "家长")
            DoEvents
    End Select
End Function

Function Sendmsg(ByVal phoneNum As String, ByVal txtMsg As String, index As Integer) As Boolean
    Dim rs As Recordset
    Dim UserID As String
    Dim strSql, SplitSms As String
    Dim i, MsgLen As Integer
    Dim what As Boolean
    For i = 1 To ClMax
        If Client(i).index = index Then
            UserID = Client(i).UsrID
        End If
    Next i
    what = sendIt("AT+CMGF=0", "OK", "ERROR")
    If what = True Then
        MsgLen = Len(txtMsg) \ 70
        For i = 0 To MsgLen
            SplitSms = Mid(txtMsg, i * 70 + 1, 70)
            what = SendSMS(phoneNum, SplitSms)
            If what = False Then Exit For
            DoEvents
        Next i
    End If
    Sendmsg = what
    If Len(phoneNum) = 13 Then phoneNum = Mid(phoneNum, 3)
    If what = True Then
        strSql = "insert into message (sender,receiver,sm_content,sm_time,state)values('" & UserID & "','" & phoneNum & "','" & txtMsg & "','" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," & 3 & ")"
    Else
        strSql = "insert into message (sender,receiver,sm_content,sm_time,state)values('" & UserID & "','" & phoneNum & "','" & txtMsg & "','" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," & 2 & ")"
    End If