frmclog.frm

一个vb编的计算机机房管理系统

VERSION 5.00
Begin VB.Form frmClog 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "设备使用"
   ClientHeight    =   5940
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5940
   ScaleWidth      =   6975
   Begin VB.CommandButton cmdEnd 
      Caption         =   "下机"
      Height          =   495
      Left            =   2160
      TabIndex        =   14
      Top             =   5040
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   6480
      Top             =   2520
   End
   Begin VB.Frame Frame1 
      Height          =   4575
      Left            =   600
      TabIndex        =   3
      Top             =   240
      Width           =   5775
      Begin VB.CommandButton cmdCheckUser 
         Caption         =   "检验"
         Height          =   375
         Left            =   4200
         TabIndex        =   16
         Top             =   1200
         Width           =   735
      End
      Begin VB.CommandButton cmdApply 
         Caption         =   "申请"
         Height          =   375
         Left            =   4200
         TabIndex        =   15
         Top             =   480
         Width           =   735
      End
      Begin VB.TextBox txtStartTime 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   2400
         Locked          =   -1  'True
         MaxLength       =   50
         TabIndex        =   11
         Top             =   2160
         Width           =   2175
      End
      Begin VB.TextBox txtEndTime 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   2400
         Locked          =   -1  'True
         MaxLength       =   50
         TabIndex        =   10
         Top             =   2760
         Width           =   2175
      End
      Begin VB.TextBox txtCharge 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   2400
         Locked          =   -1  'True
         TabIndex        =   9
         Top             =   3360
         Width           =   2175
      End
      Begin VB.TextBox txtUID 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   2400
         MaxLength       =   6
         TabIndex        =   7
         Top             =   1200
         Width           =   1575
      End
      Begin VB.TextBox txtEID 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   2400
         Locked          =   -1  'True
         MaxLength       =   5
         TabIndex        =   4
         Top             =   480
         Width           =   1575
      End
      Begin VB.Label Label5 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "开始时间："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   720
         TabIndex        =   13
         Top             =   2280
         Width           =   1575
      End
      Begin VB.Label Label4 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "结束时间："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   720
         TabIndex        =   12
         Top             =   2880
         Width           =   1575
      End
      Begin VB.Label Label6 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "应收费用："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   720
         TabIndex        =   8
         Top             =   3480
         Width           =   1575
      End
      Begin VB.Label Label2 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "设备编号："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   720
         TabIndex        =   6
         Top             =   600
         Width           =   1575
      End
      Begin VB.Label Label1 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "用户编号："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   720
         TabIndex        =   5
         Top             =   1320
         Width           =   1575
      End
   End
   Begin VB.CommandButton cmdSearch 
      Caption         =   "查询"
      Height          =   495
      Left            =   3600
      TabIndex        =   2
      Top             =   5040
      Width           =   1215
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "上机"
      Height          =   495
      Left            =   720
      TabIndex        =   1
      Top             =   5040
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   495
      Left            =   5040
      TabIndex        =   0
      Top             =   5040
      Width           =   1215
   End
End
Attribute VB_Name = "frmClog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'
'设备使用记录

'开始时候添加记录，用户使用完毕修改记录
'


Private TimerEnable As Boolean


Private Sub cmdApply_Click()
    '获取一个空闲的机器号
    Dim strSql As String
    Dim rsE As New ADODB.Recordset
    strSql = "select top 1 EID from EQUIPMENT where state='E'"
    Set rsE = objDBOpt.getRecords(strSql)
    If rsE Is Nothing Then
        MsgBox "数据查询错误！"
        Exit Sub
    End If
    If rsE.BOF And rsE.EOF Then
        MsgBox "没有空闲的机器！"
        Exit Sub
    End If
    Me.txtEID.Text = setNotNull(rsE.Fields("EID").value)
    Me.cmdApply.Enabled = False
    Me.cmdStart.Enabled = True
    rsE.Close
    Set rsE = Nothing
    
    
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub



Private Sub cmdCheckUser_Click()
    '检验用户是否存在
    Dim strUID As String
    strUID = Me.txtUID.Text
    If IsUserExist(strUID) Then
        MsgBox "该用户通过验证！"
    Else
        MsgBox "该用户不存在！"
    End If
    
End Sub

Private Sub cmdEnd_Click()
'下机，进行费用结算
    Dim strUID As String
    Dim strEID As String
    Dim dblCharge As Double
    Dim dblBalance As Double
    Dim dtStartTime As Date
    Dim dtEndTime As Date
    
    Dim strSql As String
    Dim rs As ADODB.Recordset
    
    strUID = Me.txtUID.Text
    strEID = Me.txtEID.Text
    dblCharge = Me.txtCharge.Text
    dtStartTime = Me.txtStartTime.Text
    dtEndTime = Me.txtEndTime.Text
    
    
    '检查用户余额(Cuser－》BALANCE )是否大于应收款
    strSql = "select * from CUser where UID='" & strUID & "'"
    Set rs = objDBOpt.getRecords(strSql, 1, 3)
    If rs Is Nothing Then
        MsgBox "数据库查询出错！"
        Exit Sub
    End If
    If Not (rs.EOF And rs.BOF) Then
        dblBalance = setNotNull(rs.Fields("balance").value, 0)
        objDBOpt.ModiRecord "Cuser", "balance", dblBalance - dblCharge, "uid='" & strUID & "'"
        If dblBalance < dblCharge Then
            MsgBox "用户余额不足！"
        End If
    End If
    '更新 Equipment 表
    objDBOpt.ModiRecord "EQUIPMENT", "State", "'E'", "EID='" & strEID & "'"
    objDBOpt.ModiRecord "EQUIPMENT", "STARTTIME", "'" & dtStartTime & "'", "EID='" & strEID & "'"
    
    '更新 Charge 表
    objDBOpt.ModiRecord "CHARGE", "Charge", dblCharge, "uid='" & strUID & "' and starttime=endtime"
    
    objDBOpt.ModiRecord "CHARGE", "EndTime", "'" & dtEndTime & "'", "uid='" & strUID & "' and starttime=endtime"
        
    '更新 Clog 表
    objDBOpt.ModiRecord "CLOG", "EndTime", "'" & dtEndTime & "'", "uid='" & strUID & "' and starttime=endtime"
    
    MsgBox "操作成功！"
    
    Call initForm
    
End Sub

Private Sub cmdSearch_Click()
'用户下机时，根据用户ID查询机器的使用信息
    Dim strUID As String
    Dim strEID As String
    Dim dtStartTime As Date
    Dim dtEndTime As Date
    Dim dblCharge As Double
    
    Dim rsU As ADODB.Recordset
    Dim strSql As String
    
    strUID = Trim(Me.txtUID.Text)
    If strUID = "" Then
        MsgBox "请填写用户编号！"
        Exit Sub
    End If
    '检查用户是否上机
    strSql = "select * from charge where UID='" & strUID & "' and starttime=endtime"
    Set rsU = objDBOpt.getRecords(strSql)
    If rsU Is Nothing Then
        MsgBox "数据查询失败！"
        Exit Sub
    End If
    If rsU.EOF And rsU.BOF Then
        MsgBox "没有找到用户上机信息！"
        Exit Sub
    End If
    '如果找到用户上机信息
    Me.cmdEnd.Enabled = True
    Me.Timer1.Enabled = False
    strEID = setNotNull(rsU.Fields("EID").value)
    strCType = setNotNull(rsU.Fields("CType").value, "O")
    dtStartTime = setNotNull(rsU.Fields("StartTime").value, Now)
    dtEndTime = Now()
    dblCharge = getCharge(dtStartTime, dtEndTime, strCType)
    
    Me.txtEID.Text = strEID
    Me.txtStartTime.Text = dtStartTime
    Me.txtEndTime.Text = dtEndTime
    Me.txtCharge.Text = dblCharge
    
    rsU.Close
    Me.txtUID.Locked = True
    
End Sub


Private Sub cmdStart_Click()
'上机，分配机器给用户
    Dim strEID As String
    Dim strUID As String
    Dim dtStartTime As Date
    Dim strCType As String
    Dim rst As ADODB.Recordset
    
    strEID = Trim(Me.txtEID.Text)
    strUID = Trim(Me.txtUID.Text)
    dtStartTime = Trim(Me.txtStartTime.Text)
    If strUID = "" Then
        MsgBox "请填写用户编号！"
        Exit Sub
    End If
    '检查是否有该用户
    If IsUserExist(strUID) Then
        '获取用户收费方式
        Set rst = objDBOpt.getRecords("select CType from CUser where UID='" & strUID & "'")
        If rst Is Nothing Then
            MsgBox "数据查询错误"
            Exit Sub
        End If
        If rst.EOF Or rst.BOF Then
            MsgBox "没有找到用户相关信息！"
            Exit Sub
        End If
        strCType = setNotNull(rst.Fields("CType").value, "O")
        rst.Close
        '修改设备使用状态
        objDBOpt.ModiRecord "EQUIPMENT", "State", "'U'", "EID='" & strEID & "'"
        objDBOpt.ModiRecord "EQUIPMENT", "STARTTIME", "'" & dtStartTime & "'", "EID='" & strEID & "'"
        'CHARGE 表分别加入相应的记录
        
        objDBOpt.AddRecord "CHARGE", "UID,EID,CType,StartTime,EndTime", "'" & strUID & "','" & strEID & "','" & strCType & "','" & dtStartTime & "','" & dtStartTime & "'"
        
        'CLOG 表分别加入相应的记录
        objDBOpt.AddRecord "CLOG", "UID,EID,StartTime,EndTime", "'" & strUID & "','" & strEID & "','" & dtStartTime & "','" & dtStartTime & "'"
        
        MsgBox "数据添加成功！"
        
    Else
        MsgBox "该用户不存在！"
    End If
    Call initForm
End Sub


Private Sub Form_Load()
    Call initForm
End Sub

Private Sub Timer1_Timer()
    If TimerEnable Then
        Me.txtStartTime.Text = CStr(Now())
    End If
    Me.txtEndTime.Text = Now()
End Sub
Private Function IsUserExist(ByVal strUID As String)
    
    IsUserExist = objDBOpt.IsRecordExist("CUser", "UID='" & strUID & "'")
    
End Function

Private Function getCharge(ByVal dtStartTime As Date, ByVal dtEndTime As Date, Optional ByVal strCType = "O")
'计算应收费用的函数，如果计价方式是可设定的，可以修改该函数
    Dim nPrice As Integer
    Dim nMinute As Double
    If LCase(strCType) = "u" Then
        nPrice = 1
    ElseIf LCase(strCType) = "h" Then '
        nPrice = 2
    Else
        nPrice = 0
    End If
    nMinute = DateDiff("n", dtStartTime, dtEndTime)
    getCharge = nMinute * nPrice
    If nMinute < 1 Then
        getCharge = 1
    End If
End Function

Private Function initForm()
    resetForm Me
    
    Me.cmdEnd.Enabled = False
    Me.cmdApply.Enabled = True
    Me.cmdStart.Enabled = False
    Me.txtUID.Locked = False
    Me.txtCharge.Text = 0
    Me.txtStartTime.Text = Now()
    Me.txtEndTime.Text = Now()
    TimerEnable = True
    Me.Timer1.Enabled = True
End Function