mdlic.bas

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

Attribute VB_Name = "MdlIC"
'********************************
'*   功能：通讯部分全程变量定义
'*   作者：韩国栋
'*   时间：2000-3-1
'********************************
Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SystemTime)
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Be Use to delay time for comm
Type SystemTime   '定义输入系统时间结构
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
Type SecrecyType    '保密数据，以便存入BIN FILE 内
     ValidOldYear                   As Integer '将存上一次升迁，同一天只能升迁一次
     ValidOldMonth                  As Integer
     ValidOldDay                    As Integer
     ValidYear                      As Integer '将有效的年、月、日以TYPE STRUCTURE 存入BIN FILE 内
     ValidMonth                     As Integer
     ValidDay                       As Integer
End Type
Global gSecrecyData   As SecrecyType
Global Const SuccessConst = &H55 '操作成功
Global Const FailureConst = &H56 ''操作失败
Global Const SpaceICConst = &H1C ' 新卡
Global Const InValidICConst = &H1D ' 非法卡
Global Const BadICConst = &H1E '坏卡,请插卡
Global Const NoICConst = &H1F '无卡,请插卡
Global Const DelaySecondConst = 1 ' receive delay 5秒
Global Const DelayMillsConst = 1 'SEND DELAY 100毫秒
Global gCommVariant As Variant
Global gUserValidDate               As Date   '全程变量存放用户使用有效最迟日期

Global gComN As Integer
Global gHotelName As String
Global gRegisterNo As String
Global gRunCount As Integer
Type SendBufferType       '通讯，发送BUFFER STRUCTURE
     ArrayLen                     As Integer   'BUFFER LENGHT
     SendBuffer_Array(25)         As Byte  'BUFFER CONTEXT
End Type
Global gSendBuffer                As SendBufferType  '通讯，发送BUFFER STRUCTURE全程变量
Global gReceiveBuffer             As SendBufferType  '通讯，接收BUFFER STRUCTURE全程变量
Global gReceiveData_Array()       As Byte '通讯，接收字符
'********************************
'*   功能：数据库部分全程变量定义
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Global Const ICTypeConst = 13 '0~12种卡
Global Const DelIntervalMonthConst = 2
Type ICType
     ICTypeCode         As Byte 'IC代码
     ICTypeName         As String 'IC名字
End Type
Type ICProperty
     ICType             As String 'f
     LossLog            As Integer  'f１　挂失，０未挂失
     ICNumber           As String 'ffff
     PutOutSDate        As String
     CancelSDate        As String
     CancelReason       As String
     CancelLog          As Boolean
     ValidBeginDate     As Date 'FFFFFFFFFF
     ValidEndDate       As Date 'FFFFFFFFFF
     ValidBeginTime1    As Date
     ValidEndTime1      As Date
     ValidBeginTime2    As Date
     ValidEndTime2      As Date
     ValidBeginTime3    As Date
     ValidEndTime3      As Date
     OperatorCancel     As String
     OperatorOut        As String
     BuildingNumber     As String
     FloorNumber        As String
     RoomNumber    As String
     ShortRoomNumber    As String
     SectNumber         As String
     Account            As String '帐号ffffff
     IDCard             As String
     Name               As String
     Remark             As String
End Type
'0+卡类+卡号+开门时间
'采集操作时间(FFFFFFFFFF) +楼号(FF)+楼层(FF)+房间(FF) +[开门记录]n
Type LockRecord
     ShortRoomNumber          As String
     UnLockDate               As Date '开锁日期
     UnLockTime               As Date '开锁时间
     ICType                   As String
     CollectionDate           As Date
     CollectionTime           As Date
End Type
Global gICProperty                  As ICProperty
Global gICType_Array(ICTypeConst)   As ICType 'IC类型数组
Global gLockRecord_Array()          As LockRecord '开锁记录
Global SystemDir                    As String  '系统目录
Global gUserName                    As String '当前用户
Global gUserCode                    As String '当前用户代码
Global gPassWord                    As String '用户密码
Global gLoginSuccess                As Boolean '系统登录判断

Global gRoomICCount                 As Integer '系统默认房间发卡数
Global gCheckOutTime                As Date '客人退房时间
Global gBuildingLog                 As Boolean 'True 有楼号，FALSE 无楼号
Global gValidBeginDate              As Date
Global gValidEndDate                As Date
Global gValidBeginTime1             As Date
Global gValidEndTime1               As Date
Global gValidBeginTime2             As Date
Global gValidEndTime2               As Date
Global gValidBeginTime3             As Date
Global gValidEndTime3               As Date
Global DB_ICData                     As Database
Global RC_Operator                   As Recordset
Global RC_OperatorDate               As Recordset
Global RC_Building                   As Recordset
Global RC_Floor                      As Recordset
Global RC_Room                       As Recordset
Global RC_Client                     As Recordset
Global RC_ICCard                     As Recordset
Global RC_LockedRecord               As Recordset
Global RC_AllLockedRecord            As Recordset
Global RC_SysPara                    As Recordset
Global RC_Sect                       As Recordset
Global RC_EventLog                   As Recordset
'********************************
'*   功能：数据库初始化
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Sub Main()
   Dim sTmp As String
   
   SystemDir = App.Path & "\"
   
   ICTypeInit
   If Not InitDao() Then
           tmp = MsgBox("系统数据库打开失败，请与开发商人联系？", vbInformation + vbOKOnly, "提示")
           Exit Sub
    End If
  SysParaRead
  ReadSecrecyData
  If gRunCount = 0 Then
          FrmHotel.Show vbModal
      sTmp = ReadRegisterNo()
   End If
  gLoginSuccess = False
  FrmLogin.Show vbModal
  If gLoginSuccess Then
       FrmMain.Show modal
  End If
End Sub
'********************************
'*   功能：数据库初始化
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Function InitDao() As Boolean
  On Error GoTo ErrorHandlerDao:
   Set DB_ICData = OpenDatabase(SystemDir & "ICData.mdb", False, False)
   Set RC_Operator = DB_ICData.OpenRecordset("operator", dbOpenDynaset)
   Set RC_OperatorDate = DB_ICData.OpenRecordset("operatordate", dbOpenDynaset)
   Set RC_Building = DB_ICData.OpenRecordset("building", dbOpenDynaset)
   Set RC_Floor = DB_ICData.OpenRecordset("Floor", dbOpenDynaset)
   Set RC_Room = DB_ICData.OpenRecordset("room", dbOpenDynaset)
   Set RC_Client = DB_ICData.OpenRecordset("client", dbOpenDynaset)
   Set RC_ICCard = DB_ICData.OpenRecordset("Iccard", dbOpenDynaset)
   Set RC_LockedRecord = DB_ICData.OpenRecordset("LockedRecord", dbOpenDynaset)
   Set RC_AllLockedRecord = DB_ICData.OpenRecordset("AllLockedRecord", dbOpenDynaset)
   Set RC_SysPara = DB_ICData.OpenRecordset("syspara", dbOpenDynaset)
   Set RC_Sect = DB_ICData.OpenRecordset("Sect", dbOpenDynaset)
   Set RC_EventLog = DB_ICData.OpenRecordset("EventLog", dbOpenDynaset)
   InitDao = True
   Exit Function
ErrorHandlerDao:
   InitDao = False
End Function
'********************************
'*   功能：初始化卡名和代码
'*   作者：韩国栋
'*   时间：2000-1-14
'********************************
Sub ICTypeInit()
    Dim i As Integer
    gICType_Array(1).ICTypeName = "清除卡"
    gICType_Array(1).ICTypeCode = &H1
    gICType_Array(2).ICTypeName = "校时卡"
    gICType_Array(2).ICTypeCode = &H2
    gICType_Array(3).ICTypeName = "终止卡"
    gICType_Array(3).ICTypeCode = &H3
    gICType_Array(4).ICTypeName = "应急卡"
    gICType_Array(4).ICTypeCode = &H4
    gICType_Array(5).ICTypeName = "总控卡"
    gICType_Array(5).ICTypeCode = &H5
    gICType_Array(6).ICTypeName = "楼号卡"
    gICType_Array(6).ICTypeCode = &H6
    gICType_Array(7).ICTypeName = "楼层卡"
    gICType_Array(7).ICTypeCode = &H7
    gICType_Array(8).ICTypeName = "客人卡"
    gICType_Array(8).ICTypeCode = &H8
    gICType_Array(9).ICTypeName = "区域卡"
    gICType_Array(9).ICTypeCode = &H9
    gICType_Array(10).ICTypeName = "维修卡"
    gICType_Array(10).ICTypeCode = &HA
    gICType_Array(11).ICTypeName = "会议卡"
    gICType_Array(11).ICTypeCode = &HB
    gICType_Array(12).ICTypeName = "通道卡"
    gICType_Array(12).ICTypeCode = &HC
    gICType_Array(13).ICTypeName = "采集卡"
    gICType_Array(13).ICTypeCode = &HD

End Sub


'********************************
'*   功能：由代码代码找卡名
'*   作者：韩国栋
'*   时间：2000-1-14
'********************************
Function CodeToIC(pICCode As Integer) As String
    Dim i As Integer
    CodeToIC = ""
    For i = 0 To ICTypeConst
        If pICCode = gICType_Array(i).ICTypeCode Then
           CodeToIC = gICType_Array(i).ICTypeName
           i = ICTypeConst + 2
        End If
    Next
End Function
'********************************
'*   功能：由卡名找代码
'*   作者：韩国栋
'*   时间：2000-1-14
'********************************
Function ICNameToCode(pICName As String) As Byte
    Dim i As Integer
    ICNameToCode = 0
    For i = 0 To ICTypeConst
        If StrComp(pICName, gICType_Array(i).ICTypeName, vbTextCompare) = 0 Then
           ICNameToCode = gICType_Array(i).ICTypeCode
           i = ICTypeConst + 2
        End If
    Next
End Function

'********************************
'*   功能：用户权限判断,记录交接班
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Function UserCheck(pUserName, pPassWord) As Boolean
On Error GoTo ErrorOperator:
   Dim sTmp As String
       UserCheck = False
       With RC_Operator
             If .EOF And .BOF Then
                 MsgBox "Sorry,无用户记录？", vbInformation + vbOKOnly, "提示"
                 Exit Function
              End If
             'by username find
             sTmp = "UserName='" & pUserName & "' and password='" & pPassWord & "'"
             .MoveFirst
             .FindLast sTmp
             If Not .NoMatch Then
                   gUserName = .Fields("userName")
                   gUserCode = .Fields("usercode")
                   gPassWord = .Fields("password")
                   UserCheck = True
               Else
                   'by username find
                    sTmp = "UserCode='" & pUserName & "' and password='" & pPassWord & "'"
                    .MoveFirst
                    .FindLast sTmp
                    If Not .NoMatch Then
                         gUserName = .Fields("userName")
                         gUserCode = .Fields("usercode")
                         UserCheck = True
                    End If
              End If
        End With
   Exit Function
ErrorOperator:
   UserCheck = False
End Function
'********************************
'*   功能：用户密码修改
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Function ReplPWD(pUserName As String, pUserCode As String, pPassWord As String) As Boolean
On Error GoTo ErrorOperator:
   Dim sTmp As String
       ReplPWD = False
       sTmp = "UserName='" & pUserName & "' and UserCode='" & pUserCode & "'"
       With RC_Operator
         If Not (.EOF And .BOF) Then
             .MoveFirst
             .FindLast sTmp
             If Not .NoMatch Then
                   .Edit
                   .Fields("password") = pPassWord
                   .UpDate
                   ReplPWD = True
             End If
          End If
        End With
   Exit Function
   ReplPWD = False
ErrorOperator:
   ReplPWD = False
End Function
'********************************
'*   功能：记录接班或第一次系统登录用户和时间
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Function OperatorDate_Add(pUserName As String, pCode As String) As Boolean
  On Error GoTo ErrHand:
    With RC_OperatorDate
         .AddNew
         .Fields("UserName") = pUserName
         .Fields("UserCode") = pCode
         .Fields("WorkBeginSDate") = "" & Year(Date) & "年" & Right("00" & Month(Date), 2) & "月" & Right("00" & Day(Date), 2) & "日" & Time
         .Fields("OperatorLog") = True
'         .Fields("WorkEndDate") = pDate1
 '        .Fields("WorkEndTime") = pTime1
         .UpDate
    End With
    OperatorDate_Add = True
    Exit Function
ErrHand:
    OperatorDate_Add = False
End Function
'********************************
'*   功能：记录交班或系统退出记录（用户和时间)，Use to remember log record
'*   作者：韩国栋
'*   时间：2000-1-17
'********************************
Function OperatorDate_Edit(pUserName As String, pCode As String) As Boolean
  On Error GoTo ErrHand:
    Dim sTmp As String
       OperatorDate_Edit = False
    sTmp = "OperatorLog=true"
    With RC_OperatorDate
         If Not (.BOF And .EOF) Then
            .MoveFirst
            .FindLast sTmp
            If Not .NoMatch Then
               .Edit
               .Fields("UserName") = pUserName