Attribute VB_Name = "Module1"
'############################################
'# External
'############################################
Option Explicit

Public Declare Function TcrOpenReader Lib "TcrDrv.dll" (ByVal iNo As Long) As Long
Public Declare Function TcrCloseReader Lib "TcrDrv.dll" (ByVal hTcr As Long) As Long
Public Declare Function TcrEnableRead Lib "TcrDrv.dll" (ByVal hTcr As Long, ByVal bEnable As Long) As Long
Public Declare Function TcrGetCardData Lib "TcrDrv.dll" (ByVal hTcr As Long, ptcr As TCR_CARD) As Long
Public Declare Function TcrControlLED Lib "TcrDrv.dll" (ByVal hTcr As Long, ByVal iOnoff As Long) As Long
Public Declare Function TcrControlBZ Lib "TcrDrv.dll" (ByVal hTcr As Long, ByVal iOnoff As Long) As Long

'*******************************************
'* Define card data storage structure.
'*******************************************
Type TCR_CARD
    JIS2Status As Byte          '// Status of JIS2 track
    JIS2Data(68) As Byte        '// Buffer of JIS2 track data
    ISO1Status As Byte          '// Status of ISO1 track
    ISO1Data(75) As Byte        '// Buffer of ISO1 track data
    ISO2Status As Byte          '// Status of ISO2 track
    ISO2Data(36) As Byte        '// Buffer of ISO2 track data
    ISO3Status As Byte          '// Status of ISO3 track
    ISO3Data(103) As Byte       '// Buffer of ISO3 track data
End Type

'*******************************************
'* Global
'*******************************************
Public GA_hTcr As Long          'Handle to card reader.
Public GA_Tcr As TCR_CARD		'Card data storage structure.
Public GA_bAbort As Boolean

'**********************************************
'* Clear
'**********************************************
Public Sub ClearItem()
    Form1.Label6.Caption = ""
    Form1.Label7.Caption = ""
    Form1.Label8.Caption = ""
    Form1.Label9.Caption = ""
    Form1.Label10.Caption = ""
    Form1.Label11.Visible = False
End Sub

'**********************************************
'* Displaying acquired card data.
'**********************************************
Public Function SetCardData(sts As Byte, card_dt() As Byte, b_max As Integer, offset As Integer) As Long
    Dim temp As Integer
    Dim errflg As Integer
    Dim i As Integer
    Dim idx As Integer
    Dim ret As Long
    Dim szAscii As String
    Dim szErr As String
    
    On Error GoTo ErrSetCard
    errflg = 0
    szErr = ""
    If (sts = 0) Then
        Call Err_proc
        temp = MsgBox("No card data.", vbOKOnly, "Error")
        Call Err_end_proc
    ElseIf (sts = 255) Then
        Call Err_proc
        temp = MsgBox("Not used.", vbOKOnly, "Error")
        Call Err_end_proc
    ElseIf (sts And 128) Then
        Call Err_proc
        If (sts And 1) Then
            szErr = szErr & "  STX error  " & Chr(13)
            errflg = 1
        End If
        
        If (sts And 2) Then
            szErr = szErr & "  Parity error  " & Chr(13)
            errflg = 1
        End If
        
        If (sts And 4) Then
            szErr = szErr & "  ETX error  " & Chr(13)
            errflg = 1
        End If
        
        If (sts And 8) Then
            szErr = szErr & "  LRC error  " & Chr(13)
            errflg = 1
        End If
        
        If (sts And 16) Then
            szErr = szErr & "  Overrun error" & Chr(13)
            errflg = 1
        End If
        
        If (sts And 32) Then
            szErr = szErr & "  Card error" & Chr(13)
            errflg = 1
        End If
        
        If (sts And 64) Then
            szErr = szErr & "  Other error" & Chr(13)
            errflg = 1
        End If
        
        If (errflg = 0) Then
            temp = MsgBox("The card data is invalid.", vbOKOnly, "Error")
        Else
            temp = MsgBox(szErr, vbOKOnly, "Read error")
        End If
        Call Err_end_proc
        
    ElseIf ((sts > 0) And (sts <= b_max)) Then
        For idx = 0 To (sts - 1)
            card_dt(idx) = card_dt(idx) + offset
        Next idx
        
        '*** Employee code ***
        szAscii = ""
        For i = 1 To 8
            szAscii = szAscii & Chr(card_dt(i))
        Next i
        Form1.Label6.Caption = szAscii
        
        '*** Name ***
        szAscii = ""
        For i = 9 To 28
            szAscii = szAscii & Chr(card_dt(i))
        Next i
        Form1.Label7.Caption = szAscii
      
        '*** Sex ***
        szAscii = ""
        If (card_dt(29) = 77) Then
            szAscii = "Male"
        ElseIf (card_dt(29) = 70) Then
            szAscii = "Female"
        Else
            szAscii = "Unknown"
        End If
        Form1.Label8.Caption = szAscii
        
        '*** Date of birth ***
        szAscii = ""
        szAscii = szAscii & Chr(card_dt(34))    'month
        szAscii = szAscii & Chr(card_dt(35))
        szAscii = szAscii & "/"
        szAscii = szAscii & Chr(card_dt(36))    'day
        szAscii = szAscii & Chr(card_dt(37))
        szAscii = szAscii & " "
        For i = 30 To 33                        'year
            szAscii = szAscii & Chr(card_dt(i))
        Next i
        Form1.Label9.Caption = szAscii
        
        '*** Term of validity ***
        szAscii = ""
        szAscii = szAscii & Chr(card_dt(42))    'month
        szAscii = szAscii & Chr(card_dt(43))
        szAscii = szAscii & "/"
        szAscii = szAscii & Chr(card_dt(44))    'day
        szAscii = szAscii & Chr(card_dt(45))
        szAscii = szAscii & " "
        For i = 38 To 41                        'year
            szAscii = szAscii & Chr(card_dt(i))
        Next i
        Form1.Label10.Caption = szAscii
        Form1.Label11.Visible = False
        ret = TcrControlLED(GA_hTcr, 5)       'Light PWR and OK lamps.
        ret = TcrControlBZ(GA_hTcr, 3)    'Sound OK buzzer.
    Else
        Call Err_proc
        temp = MsgBox("The card data is invalid.", vbOKOnly, "Error")
        Call Err_end_proc
    End If
    SetCardData = 0
    Exit Function
    
ErrSetCard:
    Call Err_proc
    temp = MsgBox("The card data is invalid.", vbOKOnly, "Error")
    Call Err_end_proc
    SetCardData = 0
    Exit Function
End Function

'**********************************************
'* Light BUSY lamp.
'**********************************************
Public Sub Led_busy_on()
    Dim temp_L As Long
    
    If (GA_hTcr >= 0) Then
        temp_L = TcrControlLED(GA_hTcr, 3)
    End If
End Sub

'**********************************************
'* Light PWR lamp.
'**********************************************
Public Sub Led_power_on()
    Dim temp_L As Long
    
    If (GA_hTcr >= 0) Then
        temp_L = TcrControlLED(GA_hTcr, 1)
    End If
End Sub

'**********************************************
'* Light PWR and ERR lamps and sound ERROR buzzer.
'**********************************************
Public Sub Led_error_on()
    Dim temp_L As Long
    
    If (GA_hTcr >= 0) Then
        temp_L = TcrControlLED(GA_hTcr, 11)  'Light PWR and ERR lamps.
        temp_L = TcrControlBZ(GA_hTcr, 4)    'Sound ERROR buzzer.
    End If
End Sub

'**********************************************
'* Start reading card.
'**********************************************
Public Function Card_reader_start() As Integer
    Dim temp_i As Integer
    Dim rtn As Integer
    
    rtn = 0
    If (GA_hTcr >= 0) Then
        If (TcrEnableRead(GA_hTcr, True) <> 0) Then
            temp_i = MsgBox("Cannot read.", vbOKOnly, "Error")
            Led_busy_on
            rtn = 1    'error
        End If
    End If
    Card_reader_start = rtn
End Function

'**********************************************
'* Stop reading card.
'**********************************************
Public Function Card_reader_stop() As Integer
    Dim rtn As Integer
    
    rtn = 0
    If (GA_hTcr >= 0) Then
        If (TcrEnableRead(GA_hTcr, False) <> 0) Then
            rtn = 1    'error
        End If
    End If
    Card_reader_stop = rtn
End Function

'**********************************************
'* 
'**********************************************
Public Function Reader_data_get() As Integer
    Dim ans_L As Long
    Dim temp_L As Long
    Dim temp_i As Integer
    Dim rtn As Integer
    Dim i As Integer
    
    rtn = 0
    If (GA_hTcr < 0) Then
        Reader_data_get = rtn	'Wait for another card read.
        Exit Function
    End If
    
    GA_Tcr.ISO1Status = 0
    For i = 0 To 75
        GA_Tcr.ISO1Data(i) = 0
    Next i

    ans_L = TcrGetCardData(GA_hTcr, GA_Tcr)
    If (ans_L = 0) Then
        If (GA_bAbort = False) Then
            GA_bAbort = True
            Form1.Command1.Enabled = True
        End If
        Reader_data_get = rtn	'Wait for another card read.
        Exit Function
    End If
    
    ClearItem
    If (ans_L > 0) Then
        temp_L = SetCardData(GA_Tcr.ISO1Status, GA_Tcr.ISO1Data, 76, 32)
        rtn = 1		'Success
    Else
        Call Err_proc
        temp_i = MsgBox("Error occurred in card reader.", vbOKOnly, "Error")
        rtn = 2		'Error
    End If
    Reader_data_get = rtn
End Function

'**********************************************
'* 
'**********************************************
Public Sub Err_proc()
    Dim ret As Long
    
    If (GA_hTcr >= 0) Then
        ret = TcrControlLED(GA_hTcr, 11)  'Light PWR and ERR lamps.
        ret = TcrControlBZ(GA_hTcr, 4)    'Sound ERROR buzzer.
        ret = TcrEnableRead(GA_hTcr, False)
    End If
End Sub

'**********************************************
'* 
'**********************************************
Public Sub Err_end_proc()
    Dim ret As Long
    
    If (GA_hTcr >= 0) Then
        ret = TcrControlLED(GA_hTcr, 1) 	'Light PWR lamp.
        ret = TcrEnableRead(GA_hTcr, True)
    End If
End Sub