tm04.cls

这是一个银行IC卡门禁系统软件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "GuestCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Private mvarbuilding As Byte '局部复制
Private mvarcardno As Long '局部复制
Private mvarcardpwd As Long '局部复制
Private mvarcardtype As JalTMCardType  '局部复制
Private mvarfloor As Byte '局部复制
Private mvarhotelcode As Long '局部复制
Private mvarhotelpwd As Long '局部复制

Private mvaroperatorid As Long '局部复制
Private mvarromid As String '局部复制
Private mvaruserid As Long '局部复制
Private mvarbegindatetime As Date '局部复制
Private mvarconsumefare As Currency '局部复制
Private mvarenddatetime As Date '局部复制
Private mvarguestaccountid As Long '局部复制
Private mvarisvip As Boolean '局部复制
Private mvarnormalorhourcard As TGuestCardType  '局部复制
Private mvarprepay As Currency '局部复制
Private mvarroom As Byte '局部复制
Private mvarroomprice As Currency '局部复制
Private mvarMainOrSubCard As TGuestCardType1

Public Enum TGuestCardType1
    tSubCard = 1
    tMainCard = 2
End Enum


Public Enum TGuestCardType
    tNormalCard = 1
    tHourCard = 2
End Enum

Public Function tClear() As Boolean
    Dim ptemp As String
    Dim temp As String
    Dim ntemp As String
    Dim i As Integer
    Dim card1 As New tmreadtype
    Set card1 = New tmreadtype
    
    With card1
        
        .treadtype
        temp = .romid
        i = CLng("&H" + Mid(temp, 15, 2))

        If i <> 2 Then

            Err.Raise 600091, , GetError(91)

            Exit Function

        End If
        
    End With
    
    ptemp = ""
    
    temp = Hex(cardtype)

    While Len(temp) < 2

        temp = "0" + temp

    Wend

    ptemp = ptemp + temp
    
    temp = Hex(cardno)

    While Len(temp) < 4

        temp = "0" + temp

    Wend

    ptemp = ptemp + temp
    
    ptemp = ptemp + "0101010101"
    
    For i = 0 To 6

        ptemp = ptemp + "0000000000000000"

    Next i
    
    tClear = writesub1(ptemp)

End Function

Public Function twrite() As Boolean

    Dim ptemp As String
    Dim temp As String
    Dim ntemp As String
    Dim i As Integer
    Dim thisdatetime As Date
    Dim prepaydatetime As Date
    
    Dim card1 As New tmreadtype
    Set card1 = New tmreadtype
    
    With card1
        
        .treadtype
        temp = .romid
        i = CLng("&H" + Mid(temp, 15, 2))

        If i <> 2 Then

            Err.Raise 60091, , GetError(91)
            twrite = False

            Exit Function

        End If
    
    End With
    
    ptemp = ""
    
    temp = Hex(1)      '卡类为01H

    While Len(temp) < 2

        temp = "0" + temp

    Wend

    ptemp = ptemp + temp
    
    temp = Hex(65535)

    While Len(temp) < 4

        temp = "0" + temp

    Wend

    ptemp = ptemp + temp
    
    ptemp = ptemp + "FFFFFFFFFF"
    
    ptemp = ptemp + "0103020513250809"
    
    temp = DateToBCD(begindatetime) '秒+分+时+日+月+星期+年
    ptemp = ptemp + temp
    
    ptemp = ptemp + "00"
    
    temp = Hex(hotelcode)
    While Len(temp) < 4
         temp = "0" + temp
    Wend
    ptemp = ptemp + temp
    
    For i = 0 To 37
       temp = temp + "00"
    Next i
    ptemp = ptemp + temp
    twrite = tm91.writesub1(ptemp)
    
End Function

Public Function tread() As Boolean

    Dim ptemp As String
    Dim temp As String
    Dim i As Integer
    Dim card1 As New tmreadtype
    Set card1 = New tmreadtype
    
    With card1
        
        .treadtype
        temp = .romid
        i = CLng("&H" + Mid(temp, 15, 2))

        If i <> 2 Then

            Err.Raise 60091, , GetError(91)
            tread = False

            Exit Function

        End If
        
    
    End With
    
    temp = ""
    ptemp = ""
    temp = "01030205"
    ptemp = tm91.readsub1(temp)
    
    If (ptemp = "") Or (Len(ptemp) <> 128) Then
        
        tread = False
        Err.Raise 60012, "guestcard.readsub", GetError(12)
    
    Else
        
        tread = True
        
        
        
        temp = Mid(ptemp, 33, 14)
        begindatetime = BCDToDate(temp)
        
        temp = Mid(ptemp, 49, 4)
        hotelcode = CLng("&h" & temp)
    End If

End Function

Public Property Let MainOrSubCard(ByVal vData As TGuestCardType1)

    If Not (vData = tMainCard Or vData = tSubCard) Then

        Err.Raise 60012, "NewGuestCard.MainOrSubCard", GetError(12)
        Exit Property

    End If

    mvarMainOrSubCard = vData

    If vData = tMainCard Then

        mvarMSFlag = 1

    Else

        mvarMSFlag = 2

    End If

End Property

Public Property Get MainOrSubCard() As TGuestCardType1

    MainOrSubCard = mvarMainOrSubCard

End Property

Public Property Let roomprice(ByVal vData As Currency)

    mvarroomprice = vData

End Property

Public Property Get roomprice() As Currency

    roomprice = mvarroomprice

End Property

Public Property Let room(ByVal vData As Byte)

    mvarroom = vData

End Property

Public Property Get room() As Byte

    room = mvarroom

End Property

Public Property Let prepay(ByVal vData As Currency)

    mvarprepay = vData

End Property

Public Property Get prepay() As Currency

    prepay = mvarprepay

End Property

Public Property Let normalorhourcard(ByVal vData As TGuestCardType)

    mvarnormalorhourcard = vData

End Property

Public Property Get normalorhourcard() As TGuestCardType

    normalorhourcard = mvarnormalorhourcard

End Property

Public Property Let isvip(ByVal vData As Boolean)

    mvarisvip = vData

End Property

Public Property Get isvip() As Boolean

    isvip = mvarisvip

End Property

Public Property Let guestaccountid(ByVal vData As Long)

    If vData < 0 Then

        Err.Raise 60012, "guestcard.guestaccountid", GetError(12)
        Exit Property

    End If

    mvarguestaccountid = vData

End Property

Public Property Get guestaccountid() As Long

    guestaccountid = mvarguestaccountid

End Property

Public Property Let enddatetime(ByVal vData As Date)

    mvarenddatetime = vData

End Property

Public Property Get enddatetime() As Date

    enddatetime = mvarenddatetime

End Property

Public Property Let consumefare(ByVal vData As Currency)

    mvarconsumefare = vData

End Property

Public Property Get consumefare() As Currency

    consumefare = mvarconsumefare

End Property

Public Property Let begindatetime(ByVal vData As Date)

    mvarbegindatetime = vData

End Property

Public Property Get begindatetime() As Date

    begindatetime = mvarbegindatetime

End Property

Public Property Let userid(ByVal vData As Long)

    If vData > 65535 Or vData < 0 Then

        Err.Raise 60012, "guestcard.userid", GetError(12)
        Exit Property

    End If

    mvaruserid = vData

End Property

Public Property Get userid() As Long

    userid = mvaruserid

End Property

Public Property Let romid(ByVal vData As String)

    mvarromid = vData

End Property

Public Property Get romid() As String

    romid = mvarromid

End Property

Public Property Let operatorid(ByVal vData As Long)

    If vData > 65535 Or vData < 0 Then

        Err.Raise 60012, "guestcard.operatorid", GetError(12)
        Exit Property

    End If

    mvaroperatorid = vData

End Property

Public Property Get operatorid() As Long

    operatorid = mvaroperatorid

End Property

Public Property Let hotelpwd(ByVal vData As Long)

    If vData > 65535 Or vData < 0 Then

        Err.Raise 60012, "guestcard.hotelpwd", GetError(12)
        Exit Property

    End If

    mvarhotelpwd = vData

End Property

Public Property Get hotelpwd() As Long

    hotelpwd = mvarhotelpwd

End Property

Public Property Let hotelcode(ByVal vData As Long)

    If vData > 65535 Or vData < 0 Then

        Err.Raise 60012, "guestcard.hotelcode", GetError(12)
        Exit Property

    End If

    mvarhotelcode = vData

End Property

Public Property Get hotelcode() As Long

    hotelcode = mvarhotelcode

End Property

Public Property Let floor(ByVal vData As Byte)

    mvarfloor = vData

End Property

Public Property Get floor() As Byte

    floor = mvarfloor

End Property

Public Property Let cardtype(ByVal vData As JalTMCardType)

    mvarcardtype = vData

End Property

Public Property Get cardtype() As JalTMCardType

    cardtype = mvarcardtype

End Property

Public Property Let cardpwd(ByVal vData As Long)

    If vData > 65534 Or vData < 1 Then

        Err.Raise 60012, "guestcard.cardpwd", GetError(12)
        Exit Property

    End If

    mvarcardpwd = vData

End Property

Public Property Get cardpwd() As Long

    cardpwd = mvarcardpwd

End Property

Public Property Let cardno(ByVal vData As Long)

    If vData > 65535 Or vData < 0 Then

        Err.Raise 60012, "guestcard.cardno", GetError(12)
        Exit Property

    End If

    mvarcardno = vData

End Property

Public Property Get cardno() As Long

    cardno = mvarcardno

End Property

Public Property Let building(ByVal vData As Byte)

    mvarbuilding = vData

End Property

Public Property Get building() As Byte

    building = mvarbuilding

End Property

Public Function CardInfo() As String

    Dim Info As String
    
    If (building = 0 And floor = 0 And room = 0) Or (building = 255 And floor = 255 And room = 255) Then

        Info = "空客人卡"
        CardInfo = Info
        Exit Function

    End If

    If normalorhourcard = tNormalCard Then

        Info = "普通客人卡，"

    Else

        Info = "钟点客人卡，"

    End If

    Info = Info & "幢号=" & building
    Info = Info & "，层号=" & floor
    Info = Info & "，房号=" & room
    Info = Info & "，进入时间=" & begindatetime
    Info = Info & "，离开时间=" & enddatetime
    Info = Info & "，预付=" & prepay
    Info = Info & "，房价=" & roomprice
    Info = Info & "，消费金额=" & consumefare
    Info = Info & "，客人帐号=" & Me.guestaccountid

    If isvip Then

        Info = Info & "，贵宾卡=" & "是"

    Else

        Info = Info & "，贵宾卡=" & "否"

    End If

    If MainOrSubCard = tMainCard Then

        Info = Info & "，客人卡卡类=" & "主卡"

    Else

        Info = Info & "，客人卡卡类=" & "副卡"

    End If

    CardInfo = Info

End Function

Private Sub Class_Initialize()
ReDim state_buffer(15360)
End Sub