frmbuilding.frm

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

   End
   Begin VB.Line Line1 
      X1              =   1800
      X2              =   6000
      Y1              =   720
      Y2              =   720
   End
   Begin VB.Label Label2 
      Caption         =   "帐号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3360
      TabIndex        =   43
      Top             =   1560
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "终止时间"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   41
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label LblValidDate 
      Caption         =   "起始时间"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   40
      Top             =   2280
      Width           =   1095
   End
   Begin VB.Label LblBuildingNumber 
      Caption         =   "楼号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   480
      TabIndex        =   12
      Top             =   1560
      Width           =   615
   End
   Begin VB.Label Label4 
      Caption         =   "备注"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   480
      TabIndex        =   9
      Top             =   3960
      Width           =   615
   End
   Begin VB.Label LblIDCard 
      Caption         =   "证件"
      Height          =   255
      Left            =   2880
      TabIndex        =   8
      Top             =   3360
      Width           =   735
   End
   Begin VB.Label LblName 
      Caption         =   "持卡人"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   7
      Top             =   3360
      Width           =   735
   End
   Begin VB.Label LblICNumber 
      Caption         =   "卡号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   960
      Width           =   855
   End
End
Attribute VB_Name = "FrmOutBuilding"
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)
    
    TxtYear(1).Text = Year(gValidEndDate)
    TxtMonth(1).Text = Right("00" & Month(gValidEndDate), 2)
    TxtDay(1).Text = Right("00" & Day(gValidEndDate), 2)
    
    TxtHour.Text = Right("00" & Hour(Time), 2)
    TxtMinute.Text = Right("00" & Minute(Time), 2)
    TxtHour1.Text = Right("00" & Hour(gCheckOutTime), 2)
    TxtMinute1.Text = Right("00" & Minute(gCheckOutTime), 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)
    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.Account = TxtAccount.Text
    gICProperty.IDCard = TxtIDCard.Text
    gICProperty.Name = TxtName.Text
    gICProperty.Remark = TxtRemark.Text
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) '延时间
    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 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 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变量初始化
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
 ValidDate
 CmdAccept.Enabled = False
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
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