icclient.frm

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

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'************************
'*  功能：获得默认的有效日期，时间
'*  作者：韩国栋
'*  时间：2000-2-12
'************************
Sub ValidDate()
    TxtYear.Text = Year(Date)
    TxtMonth.Text = Right("00" & Month(Date), 2)
    TxtDay.Text = Right("00" & Day(Date), 2)
    
    TxtHour.Text = Right("00" & Hour(Time), 2)
    TxtMinute.Text = Right("00" & Minute(Time), 2)
    
End Sub
'给变量赋值
Sub gICPropertyGetValue()
  On Error GoTo ErrHand:
    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.ValidBeginDate = Format(TxtYear.Text & "-" & TxtMonth.Text & "-" & TxtDay, "yyyy-mm-dd")
    gICProperty.ValidEndDate = DateAdd("d", Val(TxtStayDays.Text), gICProperty.ValidBeginDate)
    gICProperty.ValidBeginTime1 = Time
    gICProperty.ValidEndTime1 = Format("" & TxtHour1.Text & ":" & TxtMinute1.Text & ":00", "hh:mm:ss")
    gICProperty.BuildingNumber = GetBuildingNumber(CboShortRoomNumber.Text)
    gICProperty.FloorNumber = GetFloorNumber(CboShortRoomNumber.Text)
    gICProperty.RoomNumber = GetRoomNumber(CboShortRoomNumber.Text)
    gICProperty.ShortRoomNumber = CboShortRoomNumber
    gICProperty.OperatorOut = gUserName
    gICProperty.Account = TxtAccount.Text
    gICProperty.IDCard = TxtIDCard.Text
    gICProperty.Name = TxtName.Text
    gICProperty.Remark = TxtRemark.Text
    Exit Sub
ErrHand:
       MsgBox "Sorry,日期输入错误！", vbInformation + vbOKOnly, "错误"
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


Private Sub Timer1_Timer()
    Dim sTmp As String
    Dim iTmp As Integer
    Dim bReturn  As Byte
    'time refresh
    ValidDate   '将所有时间全部格式化
    PicMSG.Cls  'label控件内容置空
     II = FrmMain.MSCommIC.Input '将接收区清空   接收区在主窗体中
    FrmMain.MSCommIC.Output = Chr(&HA)
    FrmMain.MSCommIC.Output = Chr(&HC)
    FrmMain.MSCommIC.Output = Chr(&HF)
    bReturn = DelaySecond(DelaySecondConst) '延时间获取当前卡类型对应关系如下显示
    If bReturn <> 0 Then
          Select Case bReturn
                 Case &H1C
                     sTmp = "新卡"
                     TxtICNumber.Text = GetICNumber("Client")
                     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(3) + gReceiveBuffer.SendBuffer_Array(2) * 256
                        TxtICNumber.Text = Right("00000000" & iTmp, 6)
                        iTmp = Int(gReceiveBuffer.SendBuffer_Array(1) / 16)
                        sTmp = "该卡已经发行" & CodeToIC(iTmp)
                        TxtICNumber.Text = ""
                 Case Else
                     sTmp = "无卡,请插卡！"
                     TxtICNumber.Text = ""
            End Select
        Else   '如果无卡,则breturen 返回值为0
        sTmp = "无卡,请插卡！"
    End If
    PicMSG.Cls
    PicMSG.Print sTmp '输出无卡提示
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()   '只有当读出卡号时,才能证明有卡,有卡只,发卡工作才设为允许(enabled)
    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
           '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 = "00"
    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 CmdAccept_Click()   '写卡操作
    gICPropertyGetValue '此工程将所有数据都不得定义到了变量当中(gicproperty )将楼号卡数据赋予gICProperty变量
    If PutoutIC Then  '写卡true success,false failure
       If ICCard_Add Then
          Call RC_EventLog_Add(Caption & TxtICNumber.Text, gUserName, "") '向库中写停息
        With RC_Client
         .AddNew
         If TxtIDCard.Text = "" Then
                .Fields("IDCard") = "NO"
             Else
                .Fields("IDCard") = TxtIDCard.Text
         End If
         If TxtName.Text = "" Then
                .Fields("Name") = "NO"
             Else
                .Fields("Name") = TxtName.Text
         End If
         .Fields("CheckInSDate") = "" & 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)
         .Fields("StayDays") = Val(TxtStayDays.Text)
         .Fields("ShortRoomnumber") = CboShortRoomNumber.Text
         .Fields("ICNumber") = TxtICNumber.Text
         .Fields("OperatorCheckIn") = gUserName
         .Fields("CheckLog") = True
         .Fields("Remark") = TxtRemark.Text
         .UpDate
        End With
        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 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

Private Sub Form_Load()
 gICProperty_Init 'gICProperty变量初始化
 ValidDate
 TxtStayDays.Text = 1
 TxtYear1.Text = Year(Date + 1)
 TxtMonth1.Text = Right("00" & Month(Date + 1), 2)
 TxtDay1.Text = Right("00" & Day(Date + 1), 2)
 TxtHour1.Text = Right("00" & Hour(gCheckOutTime), 2)
 TxtMinute1.Text = Right("00" & Minute(gCheckOutTime), 2)
 CmdAccept.Enabled = False
 With RC_Room
      If Not (.BOF And .EOF) Then
         .MoveFirst
         While Not .EOF
              If .Fields("RoomICCount") <= gRoomICCount Then
                 CboShortRoomNumber.AddItem .Fields("ShortRoomNumber")
              End If
              .MoveNext
         Wend
         CboShortRoomNumber.ListIndex = 0
       End If
  End With
End Sub

Private Sub TxtStayDays_Change()
    Dim dTmp As Date
    dTmp = DateAdd("d", Val(TxtStayDays.Text), Date)
    TxtYear1.Text = Year(dTmp)
    TxtMonth1.Text = Right("00" & Month(dTmp), 2)
    TxtDay1.Text = Right("00" & Day(dTmp), 2)
End Sub

Private Sub TxtYear_Change()
    Dim sTmp As String
    sTmp = TxtYear.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.Text = Left(TxtYear.Text, Len(TxtYear.Text) - 1)
    End If
End Sub
Private Sub TxtYear_LostFocus()
    If Val(TxtYear.Text) < 2000 Then
       TxtYear.Text = "2000"
       MsgBox "日期年(2000以上数字)！", vbInformation + vbOKOnly, "提示"
    End If
End Sub
Private Sub TxtMonth_Change()
    Dim sTmp As String
    sTmp = TxtMonth.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.Text = Left(TxtMonth.Text, Len(TxtMonth.Text) - 1)
    End If
End Sub
Private Sub TxtMonth_LostFocus()
    TxtMonth.Text = Right("00" & Val(TxtMonth.Text), 2)
End Sub
Private Sub TxtDay_Change()
    Dim sTmp As String
    sTmp = TxtDay.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.Text = Left(TxtDay.Text, Len(TxtDay.Text) - 1)
    End If
End Sub

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