frmmain.frm

短信与酒店管理系统

Private Sub MSComm1_OnComm()
    Dim strTemp, strNum, strTime, strLen As String, msgStr As String
    Dim nPos, nLen, nNum, nTime As Integer, nCount As Integer
    Dim what As Boolean
   ' LstState.AddItem "正在向端口发送数据....."
    MsgArrive = False
    If Me.MSComm1.CommEvent = comEvReceive Then
        strTemp = Me.MSComm1.Input
        sData = sData & strTemp
        If InStr(sData, "+CMTI") > 0 Then
            MsgArrive = True
            setDoit True
        ElseIf InStr(sData, mOK) > 0 Then
            'doit = True
            setDoit True
        ElseIf InStr(sData, mErr) > 0 Then
            setDoit True
        ElseIf InStr(sData, ">") > 0 Then
            setDoit True
        End If
        'mResult = sData
'        If Len(sData) > 0 Then
'           ' LstState.AddItem "端口返回数据--> " & sData
'        End If
        txtOut = sData

        If MsgArrive = True Then
            nPos = InStr(sData, "+CMTI")
            msgStr = Mid(sData, nPos)
            nPos = InStr(msgStr, ",")
            nCount = Trim(Val(Mid(msgStr, nPos + 1, 3)))
            If InStr(msgStr, "ME") > 0 Then
                what = sendIt("AT+CPMS=" & Chr(34) & "ME" & Chr(34), "OK", "ERROR")
                If what = True Then
                    what = sendIt("AT+CMGR=" & nCount, "OK", "ERROR")
                    If what = True Then
                        nPos = InStr(sData, "+CMGR")
                        msgStr = Mid(sData, nPos)
                        nPos = InStr(msgStr, "0891")
                        strLen = Mid(msgStr, nPos + 20, 2)
                        nLen = CInt("&h" & strLen)
                        strNum = Mid(msgStr, nPos + 24, nLen + 1)
                        If nLen = 13 Then
                            strNum = Mid(ExChange(strNum), 3, nLen)
                        Else
                            strNum = Mid(ExChange(strNum), 1, nLen)
                        End If
                        frmRx.Label2.Caption = strNum
                        nPos = InStr(msgStr, "0008")
                        strTime = ExChange(Mid(msgStr, nPos + 4, 12))
                        strTime = Format(strTime, "00-00-00 00:00:00")
                        frmRx.Label4.Caption = frmRx.Label4.Caption
                        Text1.Text = msgStr
                        msgStr = Mid(msgStr, nPos + 20)
                        msgStr = Unicode2AscII(msgStr)
                        frmRx.txtMsgRecieve.Text = msgStr
                        frmRx.Visible = True
                    End If
                End If
            End If
        End If
    End If
End Sub



Private Sub txtCenterNumber_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
            KeyAscii = 0 '取消本次按键事件。
            Beep '提示输入错误
    End If
End Sub

Private Sub txtMsg_Change()
    txtMsg.MaxLength = 70
    LabText.Caption = "字数:" & Len(txtMsg.Text) & "/70"
End Sub

' Const LB_SETHORIZONTALEXTENT = &H194
' Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
'         (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
'         lParam As Any) As Long


'List1 为 ListBox 的名称
'Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, _
'     水平卷动轴的宽度, ByVal 0&)' 特别注意：以上的水平卷动轴宽度的单位是 pixel(像素)。

Private Sub txtPhoneNumber_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
        KeyAscii = 0 '取消本次按键事件。
        Beep '提示输入错误
    End If
End Sub

Private Sub CmdCancel_Click()   '退出
Dim i As Integer

    '检查sock连接是否关闭
    For i = 1 To ClMax
        If Me.SockToCln(i).State <> sckClosed Then
            Me.SockToCln(i).Close
        End If
    Next i
    '结束程序
    End
End Sub

Private Sub Form_Load()
Dim SqlStr As String

    '设置网络属性
    '服务器端口
    SvrPort = "1234"
    '设置侦听Winsock
    Me.SockToCln(0).LocalPort = SvrPort
    Me.SockToCln(0).Listen
    
    '连接数据库
'    SqlStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
'              App.Path & "\mdb\library.mdb;Persist Security Info=False"
'    DBCnn.Open SqlStr

End Sub

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 RdrID As String
Dim bkNum As Long
Dim StatNum As Integer
Dim UsrID As String
Dim UsrPwd As String
    
    '接受数据
    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 "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 As String
Dim bEnter As Boolean
Dim FindItm As ListItem, LtItm As ListItem

     '1.读出数据库中的记录
     '2.找到输入的管理员名
     '3.比较输入的密码是否与数据库中的记录相符
     '4.返回响应信息
     
     bEnter = False
     DBstr = "select * from class where cl_id='" & UsrID & "'"
     '打开数据集
     rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockReadOnly, -1
     
     '返回响应信息
     CheckUsr = "Cnn,"
     '查找到的记录数为0
     If rsCheck.RecordCount <= 0 Then  '找不到该管理员名
         CheckUsr = CheckUsr & "该管理员名不存在！请重新输入！"
     Else
         '数据集指针指向第一个记录，这里查找到的记录唯一
         rsCheck.MoveFirst
         If UsrPwd = Trim(rsCheck.Fields("cl_code").Value) Then
             '返回信息
             CheckUsr = CheckUsr & "欢迎进入家校通！"
             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 rs As Recordset
    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
    If StrGet(1) = "01" Then
        strSql = "select s_id,s_name,s_phone from student where cl_id='" & UserId & "'"
    Else
        strSql = "select s_id,parent_name,parent_phone from student where cl_id='" & UserId & "'"
    End If
        Set rs = DBCnn.Execute(strSql)
    If rs.RecordCount = 0 Then
        LinkMan = LinkMan & ",本班暂时还没有学生登记手机号码!"
        Exit Function
    End If
    For i = 1 To rs.RecordCount
        LinkMan = LinkMan & "," & rs.Fields(0).Value & "," & rs.Fields(1).Value & "," & rs.Fields(2).Value
        rs.MoveNext
    Next i
End Function