⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 mdlic.bas

📁 智能门锁的程序,用于控制门锁发卡程序,是科布尔的
💻 BAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
               .Fields("UserCode") = pCode
               .Fields("WorkEndSDate") = "" & Year(Date) & "年" & Right("00" & Month(Date), 2) & "月" & Right("00" & Day(Date), 2) & "日" & Time
               .Fields("OperatorLog") = False
               .UpDate
               OperatorDate_Edit = True
             End If
           End If
    End With
    Exit Function
ErrHand:
    OperatorDate_Edit = False
End Function

'********************************
'*   功能：对gICProperty全程变量进行初始化
'*   作者：韩国栋
'*   时间：2000-1-29
'********************************
Sub gICProperty_Init()
    With gICProperty
     .ICNumber = "NO"
     .ICType = "NO"
     .PutOutSDate = ""
     .CancelSDate = "NO"
     .CancelReason = "NO"
     .CancelLog = True
     .ValidBeginDate = 0
     .ValidEndDate = 0
     .ValidBeginTime1 = 0
     .ValidEndTime1 = 0
     .ValidBeginTime2 = 0
     .ValidEndTime2 = 0
     .ValidBeginTime3 = 0
     .ValidEndTime3 = 0
     .OperatorOut = "NO"
     .OperatorCancel = "NO"
     .BuildingNumber = "00"
     .FloorNumber = "00"
     .ShortRoomNumber = "00"
     .SectNumber = "00"
     .IDCard = "00"
     .Name = "NO"
     .Remark = "NO"
     .LossLog = 0 '未挂失
  End With
End Sub
'********************************
'*   功能：发放各种IC操作添加入数据库
'*   作者：韩国栋
'*   时间：2000-1-29
'********************************
Function ICCard_Add() As Boolean
On Error GoTo ErrHand:
   With RC_ICCard
     .AddNew
     .Fields("ICNumber") = gICProperty.ICNumber
     .Fields("ICType") = gICProperty.ICType
     .Fields("PutOutSDate") = gICProperty.PutOutSDate
     .Fields("CancelSDate") = gICProperty.CancelSDate
     .Fields("CancelReason") = gICProperty.CancelReason
     .Fields("CancelLog") = True '处于发行状态
     .Fields("ValidBeginDate") = gICProperty.ValidBeginDate
     .Fields("ValidEndDate") = gICProperty.ValidEndDate
     .Fields("ValidBeginTime1") = gICProperty.ValidBeginTime1
     .Fields("ValidEndTime1") = gICProperty.ValidEndTime1
     .Fields("ValidBeginTime2") = gICProperty.ValidBeginTime2
     .Fields("ValidEndTime2") = gICProperty.ValidEndTime2
     .Fields("ValidBeginTime3") = gICProperty.ValidBeginTime3
     .Fields("ValidEndTime3") = gICProperty.ValidEndTime3
     .Fields("OperatorCancel") = gICProperty.OperatorCancel
     .Fields("OperatorOut") = gICProperty.OperatorOut
     .Fields("BuildingNumber") = gICProperty.BuildingNumber
     .Fields("FloorNumber") = gICProperty.FloorNumber
     .Fields("RoomNumber") = gICProperty.RoomNumber
     .Fields("ShortRoomNumber") = gICProperty.ShortRoomNumber
     .Fields("SectNumber") = gICProperty.SectNumber
     .Fields("IDCard") = gICProperty.IDCard
     .Fields("Name") = gICProperty.Name
     .Fields("Remark") = gICProperty.Remark
     .UpDate
     End With
     ICCard_Add = True
     Exit Function
ErrHand:
     ICCard_Add = False
End Function
'********************************
'*   功能：取消各种IC操作添加入数据库
'*   作者：韩国栋
'*   时间：2000-1-29
'********************************
Function ICCardCancel(pICType As String) As Boolean
On Error GoTo ErrHand:
   Dim sTmp As String
   ICCardCancel = False
       sTmp = "ICNumber='" & gICProperty.ICNumber & "' and CancelLog=true"
       With RC_ICCard
        If Not (.BOF And .EOF) Then
            .MoveFirst
            .FindLast sTmp
            If Not .NoMatch Then
                   .Edit
                   .Fields("CancelsDate") = gICProperty.CancelSDate
                   .Fields("CancelReason") = gICProperty.CancelReason
                   .Fields("OperatorCancel") = gICProperty.OperatorCancel
                   .Fields("CancelLog") = False '处于注销状态
                   .UpDate
                   ICCardCancel = True
            End If
         End If
      End With

    Exit Function
ErrHand:
     ICCardCancel = False
End Function
'********************************
'*   功能：由房间号简称找楼号
'*   作者：韩国栋
'*   返回空错误
'*   时间：2000-1-29
'********************************
Function GetBuildingNumber(pShortRoomNumber As String) As String
      Dim sTmp As String
On Error GoTo ErrHand:
      sTmp = "ShortRoomnumber='" & pShortRoomNumber & "'"
      With RC_Room
           If Not (.EOF And .BOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 GetBuildingNumber = .Fields("BuildingNumber")
                 Exit Function
              End If
           End If
      End With
      GetBuildingNumber = ""
      Exit Function
ErrHand:
      GetBuildingNumber = ""
End Function
'********************************
'*   功能：由房间号简称找楼层
'*   作者：韩国栋
'*   返回空错误
'*   时间：2000-1-29
'********************************
Function GetFloorNumber(ByRef pShortRoomNumber As String) As String
      Dim sTmp As String
On Error GoTo ErrHand:
      sTmp = "ShortRoomNumber='" & pShortRoomNumber & "'"
      With RC_Room
           If Not (.EOF And .BOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 GetFloorNumber = .Fields("FloorNumber")
                 Exit Function
              End If
           End If
      End With
      GetFloorNumber = ""
      Exit Function
ErrHand:
      GetFloorNumber = ""
End Function
'********************************
'*   功能：由房间号简称找房号RoomNumber
'*   作者：韩国栋
'*   返回空错误
'*   时间：2000-1-29
'********************************
Function GetRoomNumber(pShortRoomNumber As String) As String
      Dim sTmp As String
On Error GoTo ErrHand:
      sTmp = "ShortRoomNumber='" & pShortRoomNumber & "'"
      With RC_Room
           If Not (.EOF And .BOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 GetRoomNumber = .Fields("RoomNumber")
                 Exit Function
              End If
           End If
      End With
      GetRoomNumber = ""
      Exit Function
ErrHand:
      GetRoomNumber = ""
End Function
'********************************
'*   功能：判断该IC发行或取消,true putout,false cancel
'*   作者：韩国栋
'*   时间：2000-2-13
'********************************
Function ICHavePutOut(pICNumber As String) As Boolean
    Dim sTmp As String
    sTmp = "ICNumber='" & pICNumber & "' and CancelLog=True"
    With RC_ICCard
         If Not (.BOF And .EOF) Then
            .MoveFirst
            .FindLast sTmp
            If Not .NoMatch Then
               ICHavePutOut = True
               Exit Function
            End If
         End If
         ICHavePutOut = False
    End With
End Function
'********************************
'*   功能：添加事件日志
'*   作者：韩国栋
'*   时间：2000-2-13
'********************************
Function RC_EventLog_Add(pEventContext As String, pByOperator As String, pRemark As String) As Boolean
  On Error GoTo ErrHand:
     With RC_EventLog
          .AddNew
          .Fields("eventcontext") = pEventContext
          .Fields("EventSDate") = "" & Year(Date) & "年" & Right("00" & Month(Date), 2) & "月" & Right("00" & Day(Date), 2) & "日" & Time
          .Fields("ByOperator") = pByOperator
          .Fields("Remark") = pRemark
          .UpDate
     End With
     RC_EventLog_Add = True
     Exit Function
ErrHand:
     RC_EventLog_Add = False
End Function
'******************************
'  功能：当发行各种卡，获得公共X，X+A+B，X+C+D，和各种卡发送信息,存入
'         数组中gSendBuffer结构的gSendBuffer.SendBuffer_Array,
'         并设置该数组的位数，gSendBuffer.ArrayLen
'
'  编者：韩国栋
'  时间：2000-03-02
'  参数：pICTypeName  确定发送哪种卡
'******************************
Function GetSendCommonMSG(ByRef pICTypeName As String)
   Dim iArrayCount As Integer
   '获得通讯头X的数值
   gSendBuffer.ArrayLen = 0
   iArrayCount = 0
   gSendBuffer.SendBuffer_Array(iArrayCount) = &HA '命令字0A
   iArrayCount = iArrayCount + 1
   gSendBuffer.SendBuffer_Array(iArrayCount) = &HB '命令字0A
   '卡类型+挂失（1byte）
   iArrayCount = iArrayCount + 1
   gSendBuffer.SendBuffer_Array(iArrayCount) = (ICNameToCode(pICTypeName) * 16) Or gICProperty.LossLog '未挂失为0、默认; 挂失为1，
   '卡号（低1byte）+卡号（高1byte）
   iArrayCount = iArrayCount + 1
   gSendBuffer.SendBuffer_Array(iArrayCount) = Int(Val(gICProperty.ICNumber) / 256)
   iArrayCount = iArrayCount + 1
   gSendBuffer.SendBuffer_Array(iArrayCount) = Val(gICProperty.ICNumber) Mod 256
   '起始年(1)月(1)日(1)
   '年（FFF）月（F）日（FF）时（FF）分（FF）
   iArrayCount = iArrayCount + 1
   'gSendBuffer.SendBuffer_Array(iArrayCount + 0) = Year(gICProperty.ValidBeginDate) / 256
   'gSendBuffer.SendBuffer_Array(iArrayCount + 1) = Int(Year(gICProperty.ValidBeginDate) / 256) * 16 Or Month(gICProperty.ValidBeginDate)
   gSendBuffer.SendBuffer_Array(iArrayCount + 0) = Abs(Year(gICProperty.ValidBeginDate) - 2000)
   gSendBuffer.SendBuffer_Array(iArrayCount + 1) = Month(gICProperty.ValidBeginDate)
   gSendBuffer.SendBuffer_Array(iArrayCount + 2) = Day(gICProperty.ValidBeginDate)
   gSendBuffer.SendBuffer_Array(iArrayCount + 3) = Hour(Time)  '当前时间
   gSendBuffer.SendBuffer_Array(iArrayCount + 4) = Minute(Time)
   '校时卡总控卡楼号卡楼层卡楼层卡客人卡区域卡
   
   '系统升迁判断，实际发卡时间不能超过升迁时间，但数据库内存放的是用户设置的时间。
   If gUserValidDate < gICProperty.ValidEndDate Then
      gICProperty.ValidEndDate = gUserValidDate
   End If
   
   iArrayCount = iArrayCount + 5
   If pICTypeName = "校时卡" Or pICTypeName = "总控卡" Or pICTypeName = "楼号卡" Or pICTypeName = "楼层卡" Or pICTypeName = "客人卡" Or pICTypeName = "区域卡" Or pICTypeName = "维修卡" Then
               '终止年(1)月(1)日(1)
               gSendBuffer.SendBuffer_Array(iArrayCount + 0) = Year(gICProperty.ValidEndDate) - 2000
               gSendBuffer.SendBuffer_Array(iArrayCount + 1) = Month(gICProperty.ValidEndDate)
               gSendBuffer.SendBuffer_Array(iArrayCount + 2) = Day(gICProperty.ValidEndDate)
               gSendBuffer.SendBuffer_Array(iArrayCount + 3) = Hour(gICProperty.ValidEndTime1)
               gSendBuffer.SendBuffer_Array(iArrayCount + 4) = Minute(gICProperty.ValidEndTime1)
          Else
               '终止年(1)月(1)日(1)
               gSendBuffer.SendBuffer_Array(iArrayCount + 0) = &HFF
               gSendBuffer.SendBuffer_Array(iArrayCount + 1) = &HFF
               gSendBuffer.SendBuffer_Array(iArrayCount + 2) = &HFF
               gSendBuffer.SendBuffer_Array(iArrayCount + 3) = &HFF
               gSendBuffer.SendBuffer_Array(iArrayCount + 4) = &HFF
   End If
   
   '区域卡"
   iArrayCount = iArrayCount + 5
   If pICTypeName = "区域卡" Then
         gSendBuffer.SendBuffer_Array(iArrayCount) = Val(gICProperty.SectNumber)
     Else
         gSendBuffer.SendBuffer_Array(iArrayCount) = 0
   End If
   
   iArrayCount = iArrayCount + 1
   If pICTypeName = "楼号卡" Or pICTypeName = "楼层卡" Or pICTypeName = "客人卡" Or pICTypeName = "维修卡" Or pICTypeName = "通道卡" Then
        gSendBuffer.SendBuffer_Array(iArrayCount) = Val(gICProperty.BuildingNumber)
      Else
        gSendBuffer.SendBuffer_Array(iArrayCount) = 0
   End If
   If pICTypeName = "楼层卡" Or pICTypeName = "客人卡" Or pICTypeName = "维修卡" Or pICTypeName = "通道卡" Then
        gSendBuffer.SendBuffer_Array(iArrayCount + 1) = Val(gICProperty.FloorNumber)
      Else
        gSendBuffer.SendBuffer_Array(iArrayCount + 1) = 0
   End If
   If pICTypeName = "客人卡" Or pICTypeName = "维修卡" Then
        gSendBuffer.SendBuffer_Array(iArrayCount + 2) = Val(gICProperty.RoomNumber)
      Else
        gSendBuffer.SendBuffer_Array(iArrayCount + 2) = 0
   End If
   
   '客人卡
   iArrayCount = iArrayCount + 3
   If gICProperty.Account <> "" Then
        gICProperty.Account = Right("000000" & gICProperty.Account, 6)
        gSendBuffer.SendBuffer_Array(iArrayCount) = Val("&h" & Mid(gICProperty.Account, 1, 2))
        gSendBuffer.SendBuffer_Array(iArrayCount + 1) = Val("&h" & Mid(gICProperty.Account, 3, 2))
        gSendBuffer.SendBuffer_Array(iArrayCount + 2) = Val("&h" & Mid(gICProperty.Account, 5, 2))
      Else
        gSendBuffer.SendBuffer_Array(iArrayCount) = 0
        gSendBuffer.SendBuffer_Array(iArrayCount + 1) = 0
        gSendBuffer.SendBuffer_Array(iArrayCount + 2) = 0
   End If
   iArrayCount = iArrayCount + 3
   gSendBuffer.SendBuffer_Array(iArrayCount) = &HF
End Function
'******************************
'  功能：获得各种IC卡信息，
'  编者：韩国栋
'  时间：2000-03-02
'  参数：pICTypeName  确定发送哪种卡
'******************************
Function GetICMSG(pICNumber As String) As String
   Dim iTmp As Integer
   Dim sResult, sTmp, sICTypeName   As String
    '【卡类】
    sICTypeName = CodeToIC((gReceiveBuffer.SendBuffer_Array(1) / 16))
    FrmCancelIC.TxtICType = sICTypeName
    
    
    iTmp = gReceiveBuffer.SendBuffer_Array(1) And &HF
    If iTmp = 1 Then
         FrmCancelIC.TxtLoss.Text = "已挂失！"
       Else
         FrmCancelIC.TxtLoss.Text = "未挂失！"
    End If
    
    '起始年(1)月(1)日(1) 入住时间
    sTmp = "" & (gReceiveBuffer.SendBuffer_Array(4) + 2000) & "年" & Right("00" & gReceiveBuffer.SendBuffer_Array(5), 2) & "月" & Right("00" & gReceiveBuffer.SendBuffer_Array(6), 2) & "日"
    sTmp = sTmp & Right("00" & gReceiveBuffer.SendBuffer_Array(7), 2) & "时" & Right("00" & gReceiveBuffer.SendBuffer_Array(8), 2) & "分"
    FrmCancelIC.TxtValidBeginDate = sTmp
    
    '终止年(1)月(1)日(1)
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -