frmfloor.frm

智能门锁的程序,用于控制门锁发卡程序,是科布尔的

    gICProperty.ICNumber = TxtICNumber.Text
    gICProperty.ICType = "楼层卡"
    gICProperty.PutOutSDate = "" & Year(Date) & "年" & Right("00" & Month(Date), 2) & "月" & Right("00" & Day(Date), 2) & "日" & _
    Right("00" & Hour(Time), 2) & ":" & Right("00" & Minute(Time), 2) & ":" & Right("00" & Second(Time), 2)
    gICProperty.FloorNumber = CboFloorNumber.Text
    If CboBuildingNumber.Text = "默认" Then
           gICProperty.BuildingNumber = 1
       Else
           gICProperty.BuildingNumber = CboBuildingNumber.Text
    End If
    gICProperty.ValidBeginDate = gValidBeginDate
    gICProperty.ValidEndDate = gValidEndDate
    gICProperty.ValidBeginTime1 = Time
    gICProperty.ValidEndTime1 = gValidEndTime1
    gICProperty.OperatorOut = gUserName
    gICProperty.IDCard = TxtIDCard.Text
    gICProperty.Account = TxtAccount.Text
    gICProperty.Name = TxtName.Text
    gICProperty.Remark = TxtRemark.Text
End Sub
Private Sub CboBuildingNumber_Click()
 CboFloorNumber.Clear
 With RC_Floor
      If CboBuildingNumber.Text = "默认" Then
          If Not (.BOF And .EOF) Then
              While Not .EOF
                  CboFloorNumber.AddItem .Fields("FloorNumber")
                  .MoveNext
              Wend
          End If
        Else
          sTmp = "buildingnumber='" & CboBuildingNumber.Text & "'"
          If Not (.BOF And .EOF) Then
                 .MoveFirst
                 .FindFirst sTmp
                 While Not .EOF
                       If Not .NoMatch Then
                          CboFloorNumber.AddItem .Fields("FloorNumber")
                         Else
                          CboFloorNumber.ListIndex = 0
                          Exit Sub
                       End If
                       .FindNext sTmp
                 Wend
          End If
        End If
 End With
End Sub



Private Sub Timer1_Timer()
    Dim sTmp As String
    Dim iTmp As Integer
    Dim bReturn  As Byte
    TxtHour.Text = Right("00" & Hour(Time), 2)
    TxtMinute.Text = Right("00" & Minute(Time), 2)
    
    PicMSG.Cls
       II = FrmMain.MSCommIC.Input '将接收区清空
    FrmMain.MSCommIC.Output = Chr(&HA)
    FrmMain.MSCommIC.Output = Chr(&HC)
    FrmMain.MSCommIC.Output = Chr(&HF)
    bReturn = DelaySecond(DelaySecondConst + 2) '延时间
    If bReturn <> 0 Then
          Select Case bReturn
                 Case &H1C
                     sTmp = "新卡"
                     TxtICNumber.Text = GetICNumber("NoClient")
                     CmdAccept.Enabled = True
                 Case &H1D
                     sTmp = "非法卡,请插卡"
                     TxtICNumber.Text = ""
                 Case &H1E
                     sTmp = "卡损坏,请插卡"
                     TxtICNumber.Text = ""
                 Case &H1F
                     sTmp = "无卡,请插卡"
                     TxtICNumber.Text = ""
                 Case &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD
                        iTmp = gReceiveBuffer.SendBuffer_Array(4) + gReceiveBuffer.SendBuffer_Array(3) * 256
                        
                        iTmp = Int(gReceiveBuffer.SendBuffer_Array(1) / 16)
                        sTmp = "该卡已经发行" & CodeToIC(iTmp)
                        TxtICNumber.Text = ""
                 Case Else
                     sTmp = "无卡,请插卡！"
                     TxtICNumber.Text = ""
            End Select
        Else
        sTmp = "无卡,请插卡！"
    End If
    PicMSG.Cls
    PicMSG.Print sTmp
End Sub

Private Sub TxtDay_Change(Index As Integer)
    Dim sTmp As String
    sTmp = TxtDay(Index).Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 31 Then
       MsgBox "日期（日00~31)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtDay(Index).Text = Left(TxtDay(Index).Text, Len(TxtDay(Index).Text) - 1)
    End If
End Sub

Private Sub TxtDay_LostFocus(Index As Integer)
    TxtDay(Index).Text = Right("00" & Val(TxtDay(Index).Text), 2)
End Sub

Private Sub TxtHour_Change()
    Dim sTmp As String
    sTmp = TxtHour.Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 24 Then
       MsgBox "小时（00~24)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtHour.Text = Left(TxtHour.Text, Len(TxtHour.Text) - 1)
    End If
End Sub
Private Sub TxtHour_LostFocus()
    TxtHour.Text = Right("00" & Val(TxtHour.Text), 2)
End Sub

Private Sub TxtHour1_Change()
    Dim sTmp As String
    sTmp = TxtHour1.Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 24 Then
       MsgBox "小时（00~24)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtHour1.Text = "00"
    End If
End Sub
Private Sub TxtHour1_LostFocus()
    TxtHour1.Text = Right("00" & Val(TxtHour1.Text), 2)
End Sub

Private Sub TxtICNumber_Change()
    If Val(TxtICNumber.Text) = 0 Then
           CmdAccept.Enabled = False
      Else
        '   If ICHavePutOut(TxtICNumber.Text) Then '该已经IC发行True
        '        CmdAccept.Enabled = False
        ''        MsgBox "该IC已经发行", vbInformation + vbOKOnly, "提示"
         '     Else
                CmdAccept.Enabled = True
         '       CmdLoss.Caption = "挂失"
           '     CmdLoss.Enabled = True
        '   End If
    End If
End Sub

Private Sub TxtMinute_Change()
    Dim sTmp As String
    sTmp = TxtMinute.Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 59 Then
       MsgBox "小时（00~59)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtMinute.Text = Left(TxtMinute.Text, Len(TxtMinute.Text) - 1)
    End If
End Sub
Private Sub TxtMinute_LostFocus()
    TxtMinute.Text = Right("00" & Val(TxtMinute.Text), 2)
End Sub

Private Sub TxtMinute1_Change()
    Dim sTmp As String
    sTmp = TxtMinute1.Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 59 Then
       MsgBox "小时（00~59)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtMinute1.Text = "00"
    End If
End Sub
Private Sub TxtMinute1_LostFocus()
    TxtMinute1.Text = Right("00" & Val(TxtMinute1.Text), 2)
End Sub

Private Sub TxtMonth_Change(Index As Integer)
    Dim sTmp As String
    sTmp = TxtMonth(Index).Text
    sTmp = "00" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) _
           > "9" Or Val(sTmp) > 12 Then
       MsgBox "日期月(00~12)输入错误！", vbInformation + vbOKOnly, "提示"
       TxtMonth(Index).Text = Left(TxtMonth(Index).Text, Len(TxtMonth(Index).Text) - 1)
    End If
End Sub
Private Sub TxtMonth_LostFocus(Index As Integer)
    TxtMonth(Index).Text = Right("00" & Val(TxtMonth(Index).Text), 2)
End Sub



Private Sub CmdAccept_Click()
    If Not gValidTimeRefresh Then  '判断时间输入是否有误
        Exit Sub
    End If
    gICPropertyGetValue '将楼号卡数据赋予gICProperty变量
    If PutoutIC Then  '写卡true success,false failure
       If ICCard_Add Then
          Call RC_EventLog_Add(Caption & TxtICNumber.Text, gUserName, "")
        End If
        TxtICNumber.Text = ""
        CmdAccept.Enabled = False
        PicMSG.Cls
        PicMSG.Print "写卡成功"
      Else
        PicMSG.Cls
        PicMSG.Print "写卡失败"
    End If
End Sub

Private Sub CmdCancel_Click()
   Unload Me
End Sub

Private Sub Form_Load()
gICProperty_Init 'gICProperty变量初始化
 ValidDate
 CmdAccept.Enabled = False
 If gBuildingLog Then
    With RC_Building
    If Not (.BOF And .EOF) Then
       .MoveFirst
       While Not .EOF
             CboBuildingNumber.AddItem .Fields("BuildingNumber")
             .MoveNext
       Wend
       CboBuildingNumber.ListIndex = 0
    End If
    End With
  Else
    CboBuildingNumber.AddItem "默认"
    CboBuildingNumber.ListIndex = 0
 End If
 CboFloorNumber.Clear
 With RC_Floor
      If CboBuildingNumber.Text = "默认" Then
          If Not (.BOF And .EOF) Then
              While Not .EOF
                  CboFloorNumber.AddItem .Fields("FloorNumber")
                  .MoveNext
              Wend
              CboFloorNumber.ListIndex = 0
          End If
        Else
          sTmp = "buildingnumber='" & CboBuildingNumber.Text & "'"
          If Not (.BOF And .EOF) Then
                 .MoveFirst
                 .FindFirst sTmp
                 While Not .EOF
                       If Not .NoMatch Then
                          CboFloorNumber.AddItem .Fields("FloorNumber")
                         Else
                          Exit Sub
                       End If
                       .FindNext sTmp
                 Wend
                 CboFloorNumber.ListIndex = 0
          End If
        End If
 End With
End Sub
Private Sub TxtYear_Change(Index As Integer)
    Dim sTmp As String
    sTmp = TxtYear(Index).Text
    sTmp = "0000" & sTmp
    If Mid(sTmp, Len(sTmp), 1) < "0" Or Mid(sTmp, Len(sTmp), 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 1, 1) < "0" Or Mid(sTmp, Len(sTmp) - 1, 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 2, 1) < "0" Or Mid(sTmp, Len(sTmp) - 2, 1) > "9" _
           Or Mid(sTmp, Len(sTmp) - 3, 1) < "0" Or Mid(sTmp, Len(sTmp) - 3, 1) > "9" _
            Then
       MsgBox "日期年(2000以上数字)！", vbInformation + vbOKOnly, "提示"
       TxtYear(Index).Text = Left(TxtYear(Index).Text, Len(TxtYear(Index).Text) - 1)
    End If
End Sub
Private Sub TxtYear_LostFocus(Index As Integer)
    If Val(TxtYear(Index).Text) < 2000 Then
       TxtYear(Index).Text = "2000"
       MsgBox "日期年(2000以上数字)！", vbInformation + vbOKOnly, "提示"
    End If
End Sub

Private Sub CmdLoss_Click()
    Dim sTmp As String
    sTmp = Mid(Caption, 3)
    sTmp = sTmp & ":" & TxtICNumber.Text
    If CmdLoss.Caption = "挂失" Then
        i = MsgBox("请谨慎使用此功能，您确实要挂失" & sTmp & "吗？", vbInformation + vbOKCancel, "提示")
        If i = vbOK Then
              gICProperty.LossLog = 1
              CmdLoss.Caption = "已挂失"
        End If
       Else
        i = MsgBox("请谨慎使用此功能，您确实要不需挂失" & sTmp & "吗？", vbInformation + vbOKCancel, "提示")
        If i = vbOK Then
              gICProperty.LossLog = 0
              CmdLoss.Caption = "挂失"
        End If
    End If


End Sub
Function PutoutIC() As Boolean
    Dim i As Integer
    Timer1.Enabled = False
     PutoutIC = False
    Call GetSendCommonMSG("楼层卡") '获得楼号卡发送信息,写入gSendBuffer内
    II = FrmMain.MSCommIC.Input 'clear comm buffer
    'For i = 0 To gSendBuffer.ArrayLen - 1
      ' DelayTimeMills (1)
     '  FrmMain.MSCommIC.Output = Chr(gSendBuffer.SendBuffer_Array(i))
    'Next
    gCommVariant = gSendBuffer.SendBuffer_Array
    FrmMain.MSCommIC.Output = gCommVariant
    If DelaySecond(DelaySecondConst * 4) = &H55 Then '延时间,read data
          PutoutIC = True
        Else
          PutoutIC = False
    End If
    Timer1.Enabled = True
End Function