frmtime.frm

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

         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1320
      TabIndex        =   0
      Top             =   1200
      Width           =   2415
   End
   Begin VB.Label LblHeader 
      Alignment       =   2  'Center
      Caption         =   "发行时钟卡"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   960
      TabIndex        =   34
      Top             =   0
      Width           =   4095
   End
   Begin VB.Line Line1 
      X1              =   840
      X2              =   5040
      Y1              =   600
      Y2              =   600
   End
   Begin VB.Label LblValidDate 
      Caption         =   "起始时间"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   33
      Top             =   1920
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "设定时间"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   32
      Top             =   2520
      Width           =   975
   End
   Begin VB.Label LblICNumber 
      Caption         =   "卡号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   1200
      Width           =   855
   End
End
Attribute VB_Name = "FrmOutTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'************************
'*  功能：获得默认的有效日期，时间
'*  作者：韩国栋
'*  时间：2000-2-12
'************************
Sub ValidDate()
    gValidBeginDate = Date
    gValidEndDate = Date + 1
    TxtYear(0).Text = Year(Date)
    TxtMonth(0).Text = Right("00" & Month(Date), 2)
    TxtDay(0).Text = Right("00" & Day(Date), 2)
    TxtHour.Text = Right("00" & Hour(Time), 2)
    TxtMinute.Text = Right("00" & Minute(Time), 2)
    
    TxtYear(1).Text = Year(Date)
    TxtMonth(1).Text = Right("00" & Month(Date), 2)
    TxtDay(1).Text = Right("00" & Day(Date), 2)
    
    TxtHour1.Text = Right("00" & Hour(Time), 2)
    TxtMinute1.Text = Right("00" & Minute(Time + 1), 2)
End Sub
'****************************
'*  功能：更新有效时间gValidBeginTime1~gValidEndTime3 and gValidBeginDate
'*        韩国栋
'*  时间：2000-02-11
'****************************
Function gValidTimeRefresh() As Boolean
  On Error GoTo ErrHand:
    gValidTimeRefresh = True
    gValidBeginDate = Format(TxtYear(0).Text & "-" & TxtMonth(0).Text & "-" & TxtDay(0), "yyyy-mm-dd")
    gValidEndDate = Format(TxtYear(1).Text & "-" & TxtMonth(1).Text & "-" & TxtDay(1), "yyyy-mm-dd")
    
    gValidBeginTime1 = Format(TxtHour.Text & ":" & TxtMinute.Text & ":00", "hh:mm:ss")
    gValidEndTime1 = Format(TxtHour1.Text & ":" & TxtMinute1.Text & ":00", "hh:mm:ss")

    If (gValidEndDate < gValidBeginDate) Then
       gValidTimeRefresh = False
       MsgBox "Sorry,起始日期比终止日期大！", vbInformation + vbOKOnly, "错误"
       Exit Function
    End If
    If (gValidEndDate = gValidBeginDate) Then
        If gValidEndTime1 < gValidBeginTime1 Then
           gValidTimeRefresh = False
           MsgBox "Sorry,起始时间比终止时间大！", vbInformation + vbOKOnly, "错误"
           Exit Function
         End If
    End If
    gValidTimeRefresh = True
    Exit Function
ErrHand:
       gValidTimeRefresh = False
       MsgBox "Sorry,有效期输入错误！", vbInformation + vbOKOnly, "错误"
End Function
'给变量赋值
Sub gICPropertyGetValue()
    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.OperatorOut = gUserName
    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 = gValidBeginDate
    gICProperty.ValidEndDate = gValidEndDate
    gICProperty.ValidBeginTime1 = Time
    gICProperty.ValidEndTime1 = gValidEndTime1
    
    
End Sub
Private Sub CmdAccept_Click()
    If Not gValidTimeRefresh Then  '判断时间输入是否有误
        Exit Sub
    End If
    gICPropertyGetValue '将楼号卡数据赋予gICProperty变量
    gICProperty.ICNumber = TxtICNumber.Text
    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 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变量初始化
   
   TxtYear(0) = Year(Date)
   TxtMonth(0) = Right("00" & Month(Date), 2)
   TxtDay(0) = Right("00" & Day(Date), 2)
   TxtHour.Text = Hour(Time)
   TxtMinute.Text = Minute(Time)

   TxtYear(1) = Year(Date)
   TxtMonth(1) = Right("00" & Month(Date), 2)
   TxtDay(1) = Right("00" & Day(Date), 2)
   TxtHour1.Text = Hour(Time)
   TxtMinute1.Text = Minute(Time)
   
   CmdAccept.Enabled = False
End Sub

Private Sub Timer1_Timer()
    Dim sTmp As String
    Dim iTmp As Integer
    Dim bReturn  As Byte
    
    PicMSG.Cls
     II = FrmMain.MSCommIC.Input '将接收区清空
    FrmMain.MSCommIC.Output = Chr(&HA) + Chr(&HC) + Chr(&HF)
    bReturn = DelaySecond(DelaySecondConst + 2) '延时间
    If bReturn <> 0 Then
          Select Case bReturn
                 Case &H1C
                     sTmp = "新卡"
                     TxtICNumber.Text = GetICNumber("NoClient")
                 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
    
   TxtYear(0) = Year(Date)
   TxtMonth(0) = Right("00" & Month(Date), 2)
   TxtDay(0) = Right("00" & Day(Date), 2)
   TxtHour.Text = Hour(Time)
   TxtMinute.Text = Minute(Time)


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
         '  End If
    End If

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 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 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 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
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