frmreaddataic.frm

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

VERSION 5.00
Begin VB.Form FrmReadDataIC 
   Caption         =   "数据采集"
   ClientHeight    =   6795
   ClientLeft      =   45
   ClientTop       =   735
   ClientWidth     =   10140
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   10.5
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   6795
   ScaleWidth      =   10140
   Begin VB.CommandButton CmdPrint 
      Caption         =   "打印"
      Enabled         =   0   'False
      Height          =   375
      Left            =   7080
      TabIndex        =   11
      Top             =   360
      Width           =   1095
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   4680
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "select * from LockedRecord order by UnLockSDate desc"
      Top             =   1080
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.PictureBox PicMsg 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   240
      ScaleHeight     =   375
      ScaleWidth      =   9255
      TabIndex        =   9
      Top             =   6360
      Width           =   9255
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "退出"
      Height          =   375
      Left            =   8400
      TabIndex        =   8
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton CmdSave 
      Caption         =   "保存"
      Enabled         =   0   'False
      Height          =   375
      Left            =   5760
      TabIndex        =   7
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton CmdRead 
      Caption         =   "读卡"
      Height          =   375
      Left            =   4560
      TabIndex        =   6
      Top             =   360
      Width           =   975
   End
   Begin VB.TextBox TxtCollectSDate 
      Height          =   375
      Left            =   1680
      TabIndex        =   5
      Top             =   960
      Width           =   2415
   End
   Begin VB.TextBox TxtRecordCount 
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   360
      Width           =   735
   End
   Begin VB.TextBox TxtShortRoomNumber 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   840
      TabIndex        =   1
      Top             =   360
      Width           =   1455
   End
   Begin VB.Label Label3 
      Caption         =   "采集时间"
      Height          =   252
      Left            =   360
      TabIndex        =   4
      Top             =   960
      Width           =   1212
   End
   Begin VB.Label Label2 
      Caption         =   "开门记录数"
      Height          =   255
      Left            =   2640
      TabIndex        =   2
      Top             =   360
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "房号"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   615
   End
End
Attribute VB_Name = "FrmReadDataIC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim pCollectionDate, pCollectionTime As Date
Dim pUnLockRecordCount As Integer
Dim ReceiveDataCard()    As Byte
Private Sub CmdCancel_Click()
     Unload Me
End Sub
Private Sub CmdPrint_Click()
   DataEnvironment1.iclock.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\ICData.mdb"
   DataReport1.Show vbModal
End Sub

Private Sub CmdRead_Click()
    Dim sTmp As String
    Dim iTmp As Integer
    DB_ICData.Execute "delete * from LockedRecord"
    Data1.Refresh
    TxtShortRoomNumber.Text = ""
    TxtRecordCount.Text = ""
    TxtCollectSDate.Text = ""
    'READ DATA
    PicMSG.Cls
    PicMSG.Print "正在读采集卡,请等待..."
    II = FrmMain.MSCommIC.Input '将接收区清空
    FrmMain.MSCommIC.Output = Chr(&HA) + Chr(&HD) + Chr(&HF)
   ' DelayTimeMills (1)
  '  FrmMain.MSCommIC.Output = Chr(&HA)
    SpaceDelaySecond (4) '延Hour间
    ReceiveDataCard = FrmMain.MSCommIC.Input
    If UBound(ReceiveDataCard) >= 8 Then  '0a+0c+0a+卡类(1)+Room（3）+记录（1）共8Byte
          AnalyzeData
       Else
        sTmp = "Not DataIC,Insert！"
    End If
    Data1.Refresh
    PicMSG.Cls
    PicMSG.Print sTmp
End Sub
Sub AnalyzeData()
    Dim sCollectSDate As String
    Dim sTmp, sICNumber, sICType, sShortRoomNumber As String
    Dim iLocate, iRealRecordCount, iCount As Integer '实际开锁记录数据
    sCollectSDate = ""
    sCollectSDate = sCollectSDate & (ReceiveDataCard(iLocate + 8 * i + 1) + 2000) & "年"
    sCollectSDate = sCollectSDate & Right("00" & ReceiveDataCard(iLocate + 8 * i + 2), 2) & "月"
    sCollectSDate = sCollectSDate & Right("00" & ReceiveDataCard(iLocate + 8 * i + 3), 2) & "日"
    sCollectSDate = sCollectSDate & Right("00" & ReceiveDataCard(iLocate + 8 * i + 4), 2) & ":"
    sCollectSDate = sCollectSDate & Right("00" & ReceiveDataCard(iLocate + 8 * i + 5), 2) & ":"
    sCollectSDate = sCollectSDate & "00"
    TxtCollectSDate.Text = sCollectSDate
    '0a+0c+0a+卡类(1)+Room（3）+记录（1）共8Byte   type(1)+y(1)+m(1)+d(1)+h(1)+m(1)+0+0
       sShortRoomNumber = Right("00" & ReceiveDataCard(6), 2) & Right("00" & ReceiveDataCard(7), 2) & Right("00" & ReceiveDataCard(8), 2)
       TxtShortRoomNumber = sShortRoomNumber
       iRealRecordCount = Int((UBound(ReceiveDataCard) + 1 - 9) / 8)
       iCount = 0
       'TxtRecordCount.Text = iRealRecordCount
       iLocate = 9
       i = 0
       While (i <= iRealRecordCount - 1)
           '卡开门
           If (ReceiveDataCard(iLocate + 8 * i + 0) >= &H1) And (ReceiveDataCard(iLocate + 8 * i + 0) <= &HD) Then
              sICType = ReceiveDataCard(iLocate + 8 * i + 0) And &HF
              sICNumber = ReceiveDataCard(iLocate + 8 * i + 2) * 256 + ReceiveDataCard(iLocate + 8 * i + 1)
              sICNumber = Right("000000" & sICNumber, 6)
              sTmp = ""
              sTmp = sTmp & (ReceiveDataCard(iLocate + 8 * i + 3) + 2000) & "年"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 4), 2) & "月"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 5), 2) & "日"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 6), 2) & ":"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 7), 2) & ":"
              sTmp = sTmp & "00"
              With Data1.Recordset
                .AddNew
                .Fields("ShortRoomNumber") = sShortRoomNumber
                .Fields("ICType") = CodeToIC((sICType))
                .Fields("UnlockSDate") = sTmp
                .Fields("CollectionSDate") = sCollectSDate
                .Fields("ICNumber") = sICNumber
                .Fields("Name") = UnLockSomeOne((sICNumber))
                .UpDate
              End With
              iCount = iCount + 1
           End If
           '钥匙开门
           If (Int(ReceiveDataCard(iLocate + 8 * i + 0) / 16) = 1) Then
              sICType = "钥匙"
              sICNumber = "No"
              sTmp = ""
              sTmp = sTmp & (ReceiveDataCard(iLocate + 8 * i + 3) + 2000) & "年"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 4), 2) & "月"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 5), 2) & "日"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 6), 2) & ":"
              sTmp = sTmp & Right("00" & ReceiveDataCard(iLocate + 8 * i + 7), 2) & ":"
              sTmp = sTmp & "00"
              With Data1.Recordset
                .AddNew
                .Fields("ShortRoomNumber") = sShortRoomNumber
                .Fields("ICType") = sICType
                .Fields("UnlockSDate") = sTmp
                .Fields("CollectionSDate") = sCollectSDate
                .Fields("ICNumber") = sICNumber
                .Fields("Name") = "NO"
                .UpDate
              End With
              iCount = iCount + 1
           End If
         
           i = i + 1
        Wend
    TxtRecordCount.Text = iCount
    CmdSave.Enabled = True
End Sub

'**************************
' 功能：空延Hour等待一段Hour间
' Hour间：2000-03-01
' 参数：pSecond 延Hour秒数
' Change：韩国栋
'**************************
Function SpaceDelaySecond(pSecond As Integer)
Dim OldTime As SystemTime
Dim CurrTime As SystemTime
Dim iTmp As Integer
Dim ExitLog As Boolean
 ExitLog = False
 Call GetSystemTime(OldTime)
 Do
    Call GetSystemTime(CurrTime)
    If CurrTime.wSecond >= OldTime.wSecond Then
       iTmp = CurrTime.wSecond - OldTime.wSecond
    Else
       iTmp = 60 + CurrTime.wSecond - OldTime.wSecond
    End If
    If iTmp >= pSecond Then
      ExitLog = True
    End If
 Loop Until ExitLog = True
End Function
Private Sub CmdSave_Click()
       Dim sTmp As String
       While Not Data1.Recordset.EOF
                     RC_AllLockedRecord.AddNew
                     RC_AllLockedRecord.Fields("ShortRoomNumber") = Data1.Recordset.Fields("ShortRoomNumber")
                     RC_AllLockedRecord.Fields("ICType") = Data1.Recordset.Fields("ICType")
                     RC_AllLockedRecord.Fields("ICNumber") = Data1.Recordset.Fields("ICNumber")
                     RC_AllLockedRecord.Fields("Name") = Data1.Recordset.Fields("Name")
                     RC_AllLockedRecord.Fields("UnlockSDate") = Data1.Recordset.Fields("UnlockSDate")
                     RC_AllLockedRecord.Fields("CollectionSDate") = Data1.Recordset.Fields("CollectionSDate")
                     RC_AllLockedRecord.UpDate
          Data1.Recordset.MoveNext
        Wend
        CmdSave.Enabled = False
        CmdPrint.Enabled = True
End Sub

Private Sub Form_Load()
   DB_ICData.Execute "delete * from LockedRecord"
   Data1.DatabaseName = SystemDir & "ICData.mdb"
End Sub