mdlic.bas

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

    If sICTypeName = "校时卡" Or sICTypeName = "总控卡" Or sICTypeName = "楼号卡" Or sICTypeName = "楼层卡" Or sICTypeName = "客人卡" Or sICTypeName = "区域卡" Or sICTypeName = "维修卡" Then
        sTmp = "" & (gReceiveBuffer.SendBuffer_Array(9) + 2000) & "年" & Right("00" & (gReceiveBuffer.SendBuffer_Array(10)), 2) & "月" & Right("00" & gReceiveBuffer.SendBuffer_Array(11), 2) & "日"
        sTmp = sTmp & Right("00" & gReceiveBuffer.SendBuffer_Array(12), 2) & "时" & Right("00" & gReceiveBuffer.SendBuffer_Array(13), 2) & "分"
        FrmCancelIC.TxtValidEndDate = sTmp
    End If
    
    
   '区域卡"
   If sICTypeName = "区域卡" Then
         FrmCancelIC.TxtSectNumber = gReceiveBuffer.SendBuffer_Array(14)
   End If
   
   If sICTypeName = "楼号卡" Or sICTypeName = "楼层卡" Or sICTypeName = "客人卡" Or sICTypeName = "维修卡" Or sICTypeName = "通道卡" Then
        FrmCancelIC.TxtBuildingNumber = gReceiveBuffer.SendBuffer_Array(15)
   End If
   
   If sICTypeName = "楼层卡" Or sICTypeName = "客人卡" Or sICTypeName = "维修卡" Or sICTypeName = "通道卡" Then
        FrmCancelIC.TxtFloorNumber = gReceiveBuffer.SendBuffer_Array(16)
   End If
   
   If sICTypeName = "客人卡" Or sICTypeName = "维修卡" Then
        FrmCancelIC.TxtRoomNumber = gReceiveBuffer.SendBuffer_Array(17)
   End If
       
    FrmCancelIC.TxtAccount = Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(18)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(19)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(20)), 2)
    
   '从数据库内取相关数据
    sResult = ""
    sTmp = "ICNumber='" & pICNumber & "'"
    With RC_ICCard
         If Not (.BOF And .EOF) Then
            .MoveFirst
            .FindLast sTmp
            If .NoMatch Then
               GetICMSG = sResult
               Exit Function
            End If
           Else
               GetICMSG = sResult
               Exit Function
          End If
    '发卡人
    FrmCancelIC.TxtOperatorOut = .Fields("OperatorOut")
    '发卡时间
    FrmCancelIC.TxtPutoutSDate = .Fields("PutOutSDate")
    '持卡人
    FrmCancelIC.TxtName = .Fields("Name")
    '持卡人身份证
    FrmCancelIC.TxtIDCard = .Fields("IDCard")
    '备注
    FrmCancelIC.TxtRemark = .Fields("Remark")
   End With
   GetICMSG = sResult
End Function
' 延时时间, 以毫秒计
 Function DelayTimeMills(Timeid As Integer)

 Dim OldTime As SystemTime
 Dim CurrTime As SystemTime
 Dim DelayTime As Integer
 Call GetSystemTime(OldTime)
 Do
    'judge delay
    Call GetSystemTime(CurrTime)
    If CurrTime.wMilliseconds >= OldTime.wMilliseconds Then
       DelayTime = CurrTime.wMilliseconds - OldTime.wMilliseconds
    Else
       DelayTime = 1000 + CurrTime.wMilliseconds - OldTime.wMilliseconds
    End If
 Loop Until DelayTime >= Timeid
End Function

'**************************
' 功能：延时等待通讯返回数据（毫秒）
' 时间：2000-03-12
' 参数：pSecond 延时秒数
' 修改：韩国栋
'**************************
Function DelaySecond(pSecond As Integer) As Byte
Dim OldTime As SystemTime
Dim CurrTime As SystemTime
Dim iTmp As Integer
Dim ExitLog As Boolean
 ExitLog = False
 Call GetSystemTime(OldTime)
 gReceiveBuffer.ArrayLen = 0
 iLocate = 0
 DelaySecond = 0
 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
          DelaySecond = 0
        Else '未超时
          gReceiveData_Array = FrmMain.MSCommIC.Input
          iLocate = gReceiveBuffer.ArrayLen
          
          For i = 0 To UBound(gReceiveData_Array)
              gReceiveBuffer.SendBuffer_Array(iLocate + i) = gReceiveData_Array(i)
          Next
          gReceiveBuffer.ArrayLen = iLocate + UBound(gReceiveData_Array) + 1
          '读卡信息0AH+1ch,0AH+1Eh,0AH+0Ch,
         ' FrmOutClear.Caption = gReceiveBuffer.SendBuffer_Array(0)
          If gReceiveBuffer.ArrayLen >= 2 And gReceiveBuffer.SendBuffer_Array(0) = &HA Then '
                    Select Case gReceiveBuffer.SendBuffer_Array(1)
                           Case &H1A  '新卡,请插卡
                                   DelaySecond = &H1A
                                   ExitLog = True
                           Case &H1C  '新卡,请插卡
                                   DelaySecond = &H1C
                                   ExitLog = True
                           Case &H1D  '非法卡,请插卡
                                   DelaySecond = &H1D
                                   ExitLog = True
                           Case &H1E  '卡损坏,请插卡
                                   DelaySecond = &H1E
                                   ExitLog = True
                           Case &H1F  '无卡,请插卡
                                   DelaySecond = &H1F
                                   ExitLog = True
                           Case Else '已经发行卡
                                '读卡信息0AH+1ch,0AH+1Eh,0AH+0Ch+信息
                                If gReceiveBuffer.ArrayLen >= 19 Then '发行卡数据
                                   DelaySecond = Int(gReceiveBuffer.SendBuffer_Array(1) / 16)
                                   ExitLog = True
                                  Else
                                   DelaySecond = &H1F
                                End If
                      End Select
           End If '发行卡数据结束
           If gReceiveBuffer.ArrayLen = 1 Then '操作返回信息55H,56H
                    Select Case gReceiveBuffer.SendBuffer_Array(0)
                           Case &H55 '空卡
                                'If gReceiveBuffer.ArrayLen >= 4 Then
                                   DelaySecond = &H55
                                   ExitLog = True
                                'End If
                           Case &H56  '无卡,请插卡
                                   DelaySecond = &H56
                                   ExitLog = True
                     End Select
            End If
    End If '未超时处理结束
 Loop Until ExitLog = True
End Function
Function GetICNumber(pICType As String) As String
  Dim RSTmp As Recordset
  Dim sTmp As String
  On Error GoTo ErrHand:
  If pICType = "Client" Then
     Set RSTmp = DB_ICData.OpenRecordset("select max(ICNumber) as MaxICNumber  from iccard where ICType='客人卡'", dbOpenDynaset)
     RSTmp.MoveFirst
     If IsNull(RSTmp.Fields("MaxICNumber")) Then
          sTmp = "002001"
        Else
          sTmp = Right("000000" & (Val(RSTmp.Fields("MaxICNumber")) + 1), 6)
     End If
     If sTmp < "065000" Then
        GetICNumber = sTmp
       Else
        GetICNumber = "002001"
     End If
   Else
     Set RSTmp = DB_ICData.OpenRecordset("select max(ICNumber) as MaxICNumber  from iccard where ICType<>'客人卡'", dbOpenDynaset)
     RSTmp.MoveFirst
     If IsNull(RSTmp.Fields("MaxICNumber")) Then
          sTmp = "000001"
        Else
          sTmp = Right("000000" & (Val(RSTmp.Fields("MaxICNumber")) + 1), 6)
     End If
     If sTmp <= "002000" Then
        GetICNumber = sTmp
       Else
        GetICNumber = "000001"
     End If
 End If
    Exit Function
ErrHand:
    GetICNumber = "Err"
End Function
'0AH+09H+发行机编号(FFFFFFFF)+0FH
Function ReadRegisterNo() As String
    Dim sTmp As String
    'Dim TmpCommVariant As Variant
    'Dim TmpSendArray(6) As Byte
    'sTmpNo = gRegisterNo
    'II = FrmMain.MSCommIC.Input '将接收区清空
    'sTmpNo = Left(sTmpNo & "00000000", 8)
     '  TmpSendArray(0) = &HA
      ' TmpSendArray(1) = &H9
       'TmpSendArray(2) = Val("&h" & Mid(sTmpNo, 1, 2))
'       TmpSendArray(3) = Val("&h" & Mid(sTmpNo, 3, 2))
 '      TmpSendArray(4) = Val("&h" & Mid(sTmpNo, 5, 2))
  '     TmpSendArray(5) = Val("&h" & Mid(sTmpNo, 7, 2))
   '    TmpSendArray(6) = &HF
    'TmpCommVariant = TmpSendArray
    
    'FrmMain.MSCommIC.Output = TmpCommVariant

    FrmMain.MSCommIC.Output = Chr(&HA) + Chr(&H9) + Chr(&HF)
    If DelaySecond(DelaySecondConst * 2) = &H1A Then '延时间,read data
          sTmp = "" & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(2)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(3)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(4)), 2) & Right("00" & Hex(gReceiveBuffer.SendBuffer_Array(5)), 2)
          ReadRegisterNo = sTmp
      Else
        ReadRegisterNo = ""
    End If
End Function
Sub SysParaWrite()
       With RC_SysPara
            If .BOF And .EOF Then
               .AddNew
               .Fields("checkoutTime") = gCheckOutTime
               .Fields("RoomICCount") = gRoomICCount
               .Fields("ComN") = gComN
               .Fields("HotelName") = gHotelName
               .Fields("ReadICNo") = gRegisterNo
               .Fields("RunCount") = gRunCount
               .UpDate
              Else
                .MoveFirst
                .Edit
               .Fields("checkoutTime") = gCheckOutTime
               .Fields("RoomICCount") = gRoomICCount
               .Fields("ComN") = gComN
               .Fields("HotelName") = gHotelName
               .Fields("ReadICNo") = gRegisterNo
               .Fields("RunCount") = gRunCount
                .UpDate
              End If
        End With
End Sub

'********************************
'*   功能：系统参数初始化
'*   作者：韩国栋
'*   时间：2000-1-14
'********************************
Sub SysParaRead()
       With RC_SysPara
       If Not (.EOF And .BOF) Then
              .MoveFirst
              gRoomICCount = .Fields("RoomICCount")
              gCheckOutTime = .Fields("CheckOuttime")
              gBuildingLog = .Fields("BuildingLog")
              gValidBeginDate = Format(.Fields("ValidBeginDate"), "yyyy-mm-dd")
              gValidEndDate = Format(.Fields("ValidEndDate"), "yyyy-mm-dd")
              gValidBeginTime1 = .Fields("ValidBeginTime1")
              gValidEndTime1 = .Fields("ValidEndTime1")
              gValidBeginTime2 = .Fields("ValidBeginTime2")
              gValidEndTime2 = .Fields("ValidEndTime2")
              gValidBeginTime3 = .Fields("ValidBeginTime3")
              gValidEndTime3 = .Fields("ValidEndTime3")
              gComN = .Fields("ComN")
              gHotelName = .Fields("HotelName")
              gRegisterNo = .Fields("ReadICNo")
              gRunCount = .Fields("RunCount")
          Else
              gCheckOutTime = Format("12:00:00", "long time")
              gRoomICCount = 8
              gComN = 1
              gBuildingLog = True '默认有楼号
              gValidBeginDate = Format(Date, "yyyy-mm-dd")
              gValidEndDate = Format(Date, "yyyy-mm-dd")
              gValidBeginTime1 = Format(Time, "long time")
              gValidEndTime1 = Format(Time, "long time")
              gValidBeginTime2 = Format(Time, "long time")
              gValidEndTime2 = Format(Time, "long time")
              gValidBeginTime3 = Format(Time, "long time")
              gValidEndTime3 = Format(Time, "long time")
              gHotelName = ""
              gRegisterNo = "12345678"
              gRunCount = 0
        End If
       End With
End Sub
'******************************
'  功能：获得系统保密数据
'  编者：韩国栋
'  时间：2000-03-02
'  返回：TRUE READ SUCCESS，FALSE FAITURE
'******************************
Function ReadSecrecyData() As Boolean
   Dim i As Integer
   Dim sTmp As String
   On Error GoTo ErrHand:
     Open App.Path & "\Secrecy.Dat" For Random As #1 Len = Len(gSecrecyData)
     ' 使用 Get 语句来读样本文件。
     Get #1, 1, gSecrecyData
     Close #1    ' 关闭文件。
     '系统升迁日期，发卡最迟到该日期
     sTmp = Format("" & gSecrecyData.ValidYear & "-" & gSecrecyData.ValidMonth & "-" & gSecrecyData.ValidDay, "yyyy-mm-dd")
     If Not IsDate(sTmp) Then
        gUserValidDate = Date - 10
        Else
        gUserValidDate = sTmp
     End If
   ReadSecrecyData = True
   Exit Function
ErrHand:

   ReadSecrecyData = False
End Function
'******************************
'  功能：写系统保密数据
'  编者：韩国栋
'  时间：2000-03-02
'  返回：TRUE READ SUCCESS，FALSE FAITURE
'******************************
Function WriteSecrecyData() As Boolean
   Dim i As Integer
   On Error GoTo ErrHand:
     If Not IsDate(gUserValidDate) Then
        gUserValidDate = Date - 1
     End If

  '   gSecrecyData.ValidYear = Year(gUserValidDate) - 2000
    ' gSecrecyData.ValidMonth = Month(gUserValidDate)
    ' gSecrecyData.ValidDay = Day(gUserValidDate)
     
     Open App.Path & "\Secrecy.Dat" For Random As #1 Len = Len(gSecrecyData)
     ' 使用 Get 语句来读样本文件。
     Put #1, 1, gSecrecyData
     Close #1    ' 关闭文件。
   WriteSecrecyData = True
   Exit Function
ErrHand:
   WriteSecrecyData = False
End Function
Function UnLockSomeOne(pICNumber As String) As String
    Dim sTmp As String
    Dim sResult As String
  On Error GoTo ErrHand:
    sResult = ""
    sTmp = "ICNumber='" & pICNumber & "'"
    With RC_ICCard
         If Not (.BOF And .EOF) Then
                .MoveFirst
                .FindLast sTmp
                If Not .NoMatch Then
                   sResult = .Fields("name")
                End If
         End If
    End With
    UnLockSomeOne = sResult
    Exit Function
ErrHand:
    UnLockSomeOne = ""
End Function