VERSION 5.00
Begin VB.Form ContactLessDemoVB 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "ContactLessDemoVB (Erweitert)"
   ClientHeight    =   10500
   ClientLeft      =   750
   ClientTop       =   195
   ClientWidth     =   11295
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   10500
   ScaleWidth      =   11295
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.CommandButton KeysToReaderCommand 
      Caption         =   "Multible Keys To Reader"
      Height          =   615
      Left            =   5160
      TabIndex        =   61
      Top             =   840
      Width           =   1095
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   10800
      Top             =   3960
   End
   Begin VB.CommandButton SniffCommand 
      Caption         =   "Sniff Cards"
      Height          =   615
      Left            =   9840
      TabIndex        =   60
      Top             =   4560
      Width           =   1335
   End
   Begin VB.CommandButton DumpButton 
      Caption         =   "Dump Card"
      Height          =   615
      Left            =   8280
      TabIndex        =   58
      Top             =   4560
      Width           =   1335
   End
   Begin VB.TextBox NowAt 
      Height          =   285
      Left            =   5760
      MaxLength       =   12
      TabIndex        =   54
      Top             =   3480
      Width           =   1575
   End
   Begin VB.TextBox iCLASSReceivedText 
      Height          =   285
      Left            =   6360
      MultiLine       =   -1  'True
      TabIndex        =   48
      Top             =   6360
      Width           =   4095
   End
   Begin VB.TextBox iCLASSSendText 
      Height          =   285
      Left            =   2040
      TabIndex        =   47
      Top             =   6360
      Width           =   4095
   End
   Begin VB.CommandButton iCLASSTransmit 
      Caption         =   "iCLASS Transmit"
      Height          =   375
      Left            =   120
      TabIndex        =   46
      Top             =   6360
      Width           =   1695
   End
   Begin VB.TextBox StatusText 
      Alignment       =   2  'Zentriert
      Height          =   285
      Left            =   3600
      TabIndex        =   44
      Top             =   7320
      Width           =   2535
   End
   Begin VB.CommandButton DisConnectCard 
      Caption         =   "Disconnect Card "
      Height          =   375
      Left            =   120
      TabIndex        =   43
      Top             =   7200
      Width           =   2055
   End
   Begin VB.CommandButton RefreshOutput 
      Caption         =   "Refresh Output Screen"
      Height          =   375
      Left            =   6720
      TabIndex        =   42
      Top             =   7200
      Width           =   2055
   End
   Begin VB.TextBox DecermentValText 
      Height          =   285
      Left            =   6840
      MaxLength       =   8
      TabIndex        =   34
      Top             =   5400
      Width           =   2775
   End
   Begin VB.TextBox IncrementValText 
      Height          =   285
      Left            =   1800
      MaxLength       =   8
      TabIndex        =   33
      Top             =   5400
      Width           =   2535
   End
   Begin VB.CommandButton Decrement 
      Caption         =   "Decrement"
      Height          =   375
      Left            =   5160
      TabIndex        =   32
      Top             =   5400
      Width           =   1095
   End
   Begin VB.CommandButton Increment 
      Caption         =   "Increment"
      Height          =   375
      Left            =   120
      TabIndex        =   31
      Top             =   5400
      Width           =   1095
   End
   Begin VB.Frame AuthenticationMode 
      Caption         =   "Authentication Mode"
      Height          =   735
      Left            =   8640
      TabIndex        =   28
      Top             =   2880
      Width           =   2055
      Begin VB.OptionButton ModeOptionB 
         Caption         =   "Mode B"
         Height          =   375
         Left            =   1080
         TabIndex        =   30
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton ModeOptionA 
         Caption         =   "Mode A"
         Height          =   375
         Left            =   120
         TabIndex        =   29
         Top             =   240
         Width           =   855
      End
   End
   Begin VB.Frame AccessOption 
      Caption         =   "Access Option"
      Height          =   1335
      Left            =   1560
      TabIndex        =   23
      Top             =   2880
      Width           =   6855
      Begin VB.OptionButton OptionKeyGuess 
         Caption         =   "RND"
         Height          =   255
         Left            =   6000
         TabIndex        =   57
         Top             =   240
         Width           =   735
      End
      Begin VB.OptionButton OptionKeyBr 
         Caption         =   "Brutefoce from"
         Height          =   255
         Left            =   4200
         TabIndex        =   55
         Top             =   240
         Width           =   1575
      End
      Begin VB.OptionButton OptionKey 
         Caption         =   "Key will be supplied"
         Height          =   255
         Left            =   2280
         TabIndex        =   40
         Top             =   240
         Width           =   1695
      End
      Begin VB.OptionButton OptionKeyNr 
         Caption         =   "Key Nr will be supplied"
         Height          =   255
         Left            =   240
         TabIndex        =   39
         Top             =   240
         Width           =   2415
      End
      Begin VB.TextBox MifAuthentKeyText 
         Height          =   285
         Left            =   2280
         MaxLength       =   12
         TabIndex        =   26
         Top             =   600
         Width           =   1695
      End
      Begin VB.TextBox AuthenKeyNrText 
         Height          =   285
         Left            =   240
         TabIndex        =   24
         Top             =   600
         Width           =   855
      End
      Begin VB.Label Label22 
         Caption         =   "Key ( 6 byte hex )"
         Height          =   255
         Left            =   4320
         TabIndex        =   56
         Top             =   960
         Width           =   1575
      End
      Begin VB.Label Label11 
         Caption         =   "Key ( 6 byte hex )"
         Height          =   255
         Index           =   0
         Left            =   2280
         TabIndex        =   27
         Top             =   960
         Width           =   1335
      End
      Begin VB.Label Label10 
         Caption         =   "Key Nr (0-1F)"
         Height          =   255
         Left            =   240
         TabIndex        =   25
         Top             =   960
         Width           =   1095
      End
   End
   Begin VB.CommandButton Authenticate 
      Caption         =   "Authenticate"
      Height          =   495
      Left            =   8640
      TabIndex        =   22
      Top             =   3720
      Width           =   2055
   End
   Begin VB.TextBox DataWriteText 
      Height          =   285
      Left            =   4200
      MaxLength       =   32
      TabIndex        =   20
      Top             =   4560
      Width           =   3135
   End
   Begin VB.CommandButton Write 
      Caption         =   "Write"
      Height          =   375
      Left            =   7440
      TabIndex        =   19
      Top             =   4560
      Width           =   615
   End
   Begin VB.TextBox DataReadText 
      Height          =   285
      Left            =   120
      TabIndex        =   16
      Top             =   4560
      Width           =   3135
   End
   Begin VB.TextBox BlockNrText 
      Alignment       =   2  'Zentriert
      Height          =   285
      Left            =   480
      TabIndex        =   15
      Text            =   "00"
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Read 
      Caption         =   "Read"
      Height          =   375
      Left            =   3360
      TabIndex        =   14
      Top             =   4560
      Width           =   615
   End
   Begin VB.TextBox MifKeyToReaderNrText 
      Height          =   285
      Left            =   6360
      MaxLength       =   2
      TabIndex        =   13
      Text            =   "00"
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox MifareKeyToReaderText 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   7680
      MaxLength       =   12
      TabIndex        =   11
      Top             =   840
      Width           =   2055
   End
   Begin VB.TextBox CardNameText 
      Height          =   285
      Left            =   6600
      TabIndex        =   6
      Top             =   2040
      Width           =   3495
   End
   Begin VB.TextBox UIDText 
      Height          =   285
      Left            =   6600
      TabIndex        =   5
      Top             =   1680
      Width           =   3495
   End
   Begin VB.TextBox ATRText 
      Height          =   525
      Left            =   120
      TabIndex        =   4
      Top             =   1680
      Width           =   5415
   End
   Begin VB.CommandButton WriteMifKeyToReader 
      Caption         =   "Write Mifare Key To Reader"
      Height          =   615
      Left            =   9840
      TabIndex        =   3
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton ConnectCard 
      Caption         =   "Connect Card "
      Height          =   615
      Left            =   10200
      TabIndex        =   2
      Top             =   1680
      Width           =   975
   End
   Begin VB.ListBox OutPutList 
      Height          =   2595
      Left            =   120
      MultiSelect     =   1  '1 -Einfach
      TabIndex        =   1
      Top             =   7800
      Width           =   11055
   End
   Begin VB.ListBox ReaderList 
      Height          =   1230
      Left            =   120
      MultiSelect     =   1  '1 -Einfach
      TabIndex        =   0
      Top             =   240
      Width           =   4815
   End
   Begin VB.Line Line9 
      X1              =   8160
      X2              =   8160
      Y1              =   4560
      Y2              =   5160
   End
   Begin VB.Label Label23 
      Caption         =   "Read Data"
      Height          =   255
      Left            =   1680
      TabIndex        =   59
      Top             =   4920
      Width           =   855
   End
   Begin VB.Line Line8 
      X1              =   6240
      X2              =   6240
      Y1              =   6360
      Y2              =   6960
   End
   Begin VB.Line Line7 
      X1              =   5040
      X2              =   5040
      Y1              =   5400
      Y2              =   6000
   End
   Begin VB.Line Line6 
      X1              =   4080
      X2              =   4080
      Y1              =   4560
      Y2              =   5160
   End
   Begin VB.Line Line5 
      X1              =   120
      X2              =   11160
      Y1              =   4440
      Y2              =   4440
   End
   Begin VB.Line Line4 
      X1              =   120
      X2              =   11160
      Y1              =   5280
      Y2              =   5280
   End
   Begin VB.Label Label21 
      Alignment       =   2  'Zentriert
      Caption         =   "iCLASS Functionalities"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   53
      Top             =   6000
      Width           =   2055
   End
   Begin VB.Label Label20 
      Caption         =   "Mifare Functionalities"
      Height          =   255
      Left            =   0
      TabIndex        =   52
      Top             =   0
      Width           =   1575
   End
   Begin VB.Label Label19 
      Alignment       =   2  'Zentriert
      Caption         =   "Mifare Functionalities"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   51
      Top             =   2520
      Width           =   1935
   End
   Begin VB.Label Label18 
      Alignment       =   2  'Zentriert
      Caption         =   "Bytes (hex) received"
      Height          =   255
      Left            =   7680
      TabIndex        =   50
      Top             =   6720
      Width           =   1695
   End
   Begin VB.Label Label17 
      Alignment       =   2  'Zentriert
      Caption         =   "Bytes to send(hex)"
      Height          =   255
      Left            =   3360
      TabIndex        =   49
      Top             =   6720
      Width           =   1455
   End
   Begin VB.Line Line3 
      X1              =   120
      X2              =   11160
      Y1              =   7080
      Y2              =   7080
   End
   Begin VB.Label Label16 
      Alignment       =   2  'Zentriert
      Caption         =   "Status"
      Height          =   255
      Left            =   2520
      TabIndex        =   45
      Top             =   7320
      Width           =   855
   End
   Begin VB.Shape Shape1 
      Height          =   495
      Left            =   2400
      Top             =   7200
      Width           =   4095
   End
   Begin VB.Line Line2 
      BorderWidth     =   2
      X1              =   120
      X2              =   11160
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   120
      X2              =   11160
      Y1              =   6120
      Y2              =   6120
   End
   Begin VB.Label Label15 
      Alignment       =   2  'Zentriert
      Caption         =   $"ContactLessDemoVB.frx":0000
      Height          =   615
      Left            =   5280
      TabIndex        =   41
      Top             =   120
      Width           =   5055
   End
   Begin VB.Label Label14 
      Alignment       =   2  'Zentriert
      Caption         =   "4-byte hex data"
      Height          =   255
      Left            =   7560
      TabIndex        =   38
      Top             =   5760
      Width           =   1455
   End
   Begin VB.Label Label8 
      Alignment       =   2  'Zentriert
      Caption         =   "4-byte hex data"
      Height          =   255
      Left            =   1920
      TabIndex        =   37
      Top             =   5760
      Width           =   2295
   End
   Begin VB.Label Label13 
      Caption         =   "by"
      Height          =   375
      Left            =   6480
      TabIndex        =   36
      Top             =   5520
      Width           =   255
   End
   Begin VB.Label Label12 
      Caption         =   "by"
      Height          =   375
      Left            =   1440
      TabIndex        =   35
      Top             =   5520
      Width           =   375
   End
   Begin VB.Label Label9 
      Alignment       =   2  'Zentriert
      Caption         =   "Data to be Writen"
      Height          =   255
      Left            =   5040
      TabIndex        =   21
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Zentriert
      Caption         =   "Data read"
      Height          =   255
      Left            =   1680
      TabIndex        =   18
      Top             =   4680
      Width           =   855
   End
   Begin VB.Label Label6 
      Caption         =   "Block Nr"
      Height          =   255
      Left            =   480
      TabIndex        =   17
      Top             =   3600
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "6-Byte Mifare Key (hex)"
      Height          =   255
      Left            =   7800
      TabIndex        =   12
      Top             =   1200
      Width           =   1815
   End
   Begin VB.Label Label4 
      Caption         =   "Key Nr  ( 0 - 1F)"
      Height          =   255
      Left            =   6360
      TabIndex        =   10
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "Card Name"
      Height          =   255
      Left            =   5640
      TabIndex        =   9
      Top             =   2040
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "UID"
      Height          =   255
      Left            =   6120
      TabIndex        =   8
      Top             =   1680
      Width           =   375
   End
   Begin VB.Label Label1 
      Caption         =   "ATR"
      Height          =   255
      Left            =   2160
      TabIndex        =   7
      Top             =   2280
      Width           =   735
   End
End
Attribute VB_Name = "ContactLessDemoVB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hContext As Long
Dim hCard As Long
Dim isContext As Boolean
Dim SelectedReader As String
Dim rc As Long
Dim ATR(64) As Byte
Dim ATRLen As Long
Dim MifKeyNrToReaderStr As String
Dim MifKeyToReader As String
Dim fCardConnected As Boolean
Dim fLookForCard As Boolean
Dim sniffing As Boolean
Dim saveNR As Integer


' for Bruteforce hex2double
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long _
)

Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)

Private Function HEXtoDouble(hNumber As String) As Double
Dim HexBytes(0 To 7) As Byte
Dim i As Integer
Dim x As String
    If Len(hNumber) < 16 Then
        MsgBox "Hex Value too big"
        Exit Function
    End If
    For i = 0 To 7
        HexBytes(i) = Val("&H" & Mid(hNumber, (8 - i) * 2 - 1, 2))
    Next i
    CopyMemory HEXtoDouble, HexBytes(0), 8
End Function

Private Sub Authenticate_Click()
Dim BlockNr As Long
Dim MifareKey(6) As Byte
Dim KeyLen As Long
Dim AccessOption As Byte
Dim Mode As Byte
Dim MifKeyNr As Byte
Dim key As String
Dim i As Integer
MifKeyNr = 0


If fCardConnected = False Then
    OutPutList.AddItem " At first Card has to be connected"
    StatusText.Text = " ERROR"
    GoTo EXITSUB
End If

BlockNr = HexStrToInt(BlockNrText.Text)
NumofDataLen = 16


If OptionKeyNr.value = True Then
    AccessOption = 1
    MifKeyNr = HexStrToInt(AuthenKeyNrText.Text)
ElseIf OptionKey.value = True Then
    AccessOption = 0
    KeyLen = StrToArray(MifareKey, 6, MifAuthentKeyText.Text)
ElseIf OptionKeyBr = True Then
    AccessOption = 0
End If

If OptionKey.value = False Then
    If OptionKeyNr.value = False Then
        If OptionKeyBr.value = False Then
            If OptionKeyGuess.value = False Then
                OutPutList.AddItem " One Access Option must be selected"
                StatusText.Text = " ERROR"
                GoTo EXITSUB
            End If
        End If
    End If
End If

If ModeOptionA.value = True Then
    Mode = 96
End If
If ModeOptionB.value = True Then
    Mode = 97
End If

If OptionKeyBr = True Then
    KeyLen = StrToArray(MifareKey, 6, NowAt.Text)
    Do
        key = ""
        For i = 0 To 5
            key = Hex(MifareKey(i)) & key
        Next i
        NowAt.Text = key
        DoEvents
        rc = SCardCLMifareStdAuthent(hCard, BlockNr, Mode, AccessOption, MifKeyNr, MifareKey(LBound(MifareKey)), KeyLen)
        If rc <> 0 Then
            '### increment
            If MifareKey(0) < 255 Then
                MifareKey(0) = MifareKey(0) + 1
            Else
                MifareKey(0) = 0
                If MifareKey(1) < 255 Then
                    MifareKey(1) = MifareKey(1) + 1
                Else
                    MifareKey(1) = 0
                    If MifareKey(2) < 255 Then
                        MifareKey(2) = MifareKey(3) + 1
                    Else
                        MifareKey(2) = 0
                        If MifareKey(3) < 255 Then
                            MifareKey(3) = MifareKey(4) + 1
                        Else
                            MifareKey(3) = 0
                            If MifareKey(4) < 255 Then
                                MifareKey(4) = MifareKey(1) + 1
                            Else
                                MifareKey(4) = 0
                                If MifareKey(5) < 255 Then
                                    MifareKey(5) = MifareKey(5) + 1
                                Else
                                    MifareKey(5) = 0
                                    OutPutList.AddItem " Bruteforce is finished"
                                    Exit Do
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
        '###########
    Loop While rc <> 0
Else
    rc = SCardCLMifareStdAuthent(hCard, BlockNr, Mode, AccessOption, MifKeyNr, MifareKey(LBound(MifareKey)), KeyLen)
End If

If OptionKeyGuess.value = True Then
    AccessOption = 0
    KeyLen = 6
    Randomize
    Do
        For i = 0 To 5
            MifareKey(i) = Rnd * 255
        Next i
        
        key = ""
        For i = 0 To 5
            key = Hex(MifareKey(i)) & key
        Next i
        NowAt.Text = key
        DoEvents
        rc = SCardCLMifareStdAuthent(hCard, BlockNr, Mode, AccessOption, MifKeyNr, MifareKey(LBound(MifareKey)), KeyLen)
    Loop While rc <> 0
End If


If rc = 0 Then
    key = ""
    For i = 0 To 5
        key = Hex(MifareKey(i)) & key
    Next i
    OutPutList.AddItem " Authentication has been written successfully (" & key & ")"
    StatusText.Text = " SUCCESS"
End If

If rc <> 0 Then
    OutPutList.AddItem " Error in Authentication "
    OutPutList.AddItem HandleError(rc)
    StatusText.Text = " ERROR"
End If

EXITSUB:
OutPutList.ListIndex = OutPutList.ListCount - 1

End Sub

Private Sub ConnectCard_Click()
Dim i As Integer
Dim curReader As String

Dim myByte As Byte
Dim dwShareMode As Long
Dim dwPreferredProtocols As Long
Dim dwActiveProtocol As Long
Dim UID(12) As Byte
Dim UIDLen As Long

ATRText = ""
UIDText = ""
CardNameText = ""

' get selected Readername from ReaderList
If ReaderList.Text = "" Then
    OutPutList.AddItem "No Reader Selected"
    Exit Sub
Else
    curReader = ReaderList.Text
End If

' Set Mode (see Scard.bas "Modes")
dwShareMode = SCARD_SHARE_SHARED
' Set preferred Protocol (see Scard.bas "Protocols")
dwPreferredProtocols = SCARD_PROTOCOL_T1

' Connect
rc = SCardConnect(hContext, curReader, dwShareMode, dwPreferredProtocols, hCard, dwActiveProtocol)
If rc = 0 Then
OutPutList.AddItem " Card has been connected Succesfully"
StatusText.Text = " SUCCESS"
fCardConnected = True
ATRLen = 64
rc = SCardGetAttrib(hCard, SCARD_ATTR_ATR_STRING, ATR(LBound(ATR)), ATRLen)
If rc = 0 Then
ATRText = ATRText + HexDump(ATR, ATRLen)
UIDLen = 12
rc = SCardCLGetUID(hCard, UID(LBound(UID)), 12, UIDLen)
If rc = 0 Then
UIDText = UIDText + HexDump(UID, UIDLen)
CardNameText = GetCardName()
End If
If rc <> 0 Then
OutPutList.AddItem " Error in SCardCLGetUID"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"

End If
End If
If rc <> 0 Then
OutPutList.AddItem "Error in SCardGetAttrib"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"

End If
End If
If rc <> 0 Then
OutPutList.AddItem "Error in SCardConnect"
OutPutList.AddItem HandleError(rc)
fCardConnected = False
StatusText.Text = " ERROR"

End If
OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Sub Decrement_Click()
Dim ucData(4) As Byte
Dim DataLen As Long
Dim BlockNr As Long

If fCardConnected = False Then
OutPutList.AddItem "Card is not Connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If


BlockNr = HexStrToInt(BlockNrText.Text)
DataLen = StrToArray(ucData, 4, DecermentValText.Text)
rc = SCardCLMifareStdDecrementVal(hCard, BlockNr, ucData(LBound(ucData)), DataLen)
If rc = 0 Then
OutPutList.AddItem "Value has been decremented  successfully"
StatusText.Text = " SUCCESS"
End If

If rc <> 0 Then
OutPutList.AddItem "Error in  SCardCLMifareStdDecrementVal"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"
End If

EXITSUB:
OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Sub DisConnectCard_Click()

If fCardConnected = False Then
OutPutList.AddItem "Card is not Connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If

 rc = SCardDisconnect(hCard, SCARD_RESET_CARD)
If rc = 0 Then
OutPutList.AddItem "Card has bee disconnected successfully"
fCardConnected = False
ATRText = ""
UIDText = ""
CardNameText = ""
StatusText.Text = " SUCCESS"
End If

If rc <> 0 Then
OutPutList.AddItem "Error in  SCardDisconnect"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"

End If

EXITSUB:
OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Sub DumpButton_Click()
    Dim i As Integer
    Dim Dump As String
    OptionKeyNr.value = True
    ModeOptionA.value = True
    i = 0
    RefreshOutput_Click
    Do While i < 64 And StatusText.Text = " SUCCESS"
        BlockNrText.Text = Hex(i)
        If i Mod 4 = 0 Then
            'authenticate
            Dump = Dump + "s" + Format(i / 4, "00") + vbNewLine
            AuthenKeyNrText.Text = Hex(i / 4)
            Authenticate_Click
        End If
        DoEvents
        Read_Click
        Dump = Dump + DataReadText.Text + vbNewLine
        i = i + 1
    Loop
    If sniffing = True Then
        DisConnectCard_Click
        If i = 64 Then
            Save_Dump Dump, False
        Else
            Save_Dump Dump, True
        End If
        saveNR = saveNR + 1
    Else
        DumpForm.CardDump.Text = Dump
        DumpForm.Show
    End If
End Sub

Private Sub Save_Dump(Dump As String, Error As Boolean)
    On Error Resume Next
    Dim F As Integer
    F = FreeFile()
    MkDir "dumps"
    If Error = True Then
        Open "dumps\dump-" & saveNR & "-error.txt" For Output As #F
    Else
        Open "dumps\dump-" & saveNR & ".txt" For Output As #F
    End If
    Print #F, Dump
    Close #F
End Sub


Private Sub Form_Initialize()
Dim rc As Long
Dim dwScope As Long
Dim mszReaders(2048) As Byte
Dim mszGroup(1024) As Byte
Dim pcchReaders As Long
Dim curReader As String
Dim i As Integer
hCard = 0
hContext = 0
fLookForCard = True

' Set Scope (see Scard.bas "Scopes")
dwScope = SCARD_SCOPE_USER

' Establish Context
rc = SCardEstablishContext(dwScope, 0, 0, hContext)

' Set maximum Length of mszReaders
pcchReaders = 2048

' Create a Multistring (terminated with two '\0's)
mszGroup(0) = &H0
mszGroup(1) = &H0

rc = SCardListReaders(hContext, mszGroup(LBound(mszGroup)), mszReaders(LBound(mszReaders)), pcchReaders)
    
ReaderList.Clear


' Split multistring and add single Readers to list
For i = 0 To pcchReaders - 2 Step 1
      curReader = curReader + GetString(mszReaders(i))
    
      If mszReaders(i) = &H0 And i <> 0 Then
        ReaderList.AddItem (curReader)
        curReader = ""
    End If
  
Next i


For i = 0 To ReaderList.ListCount - 1 Step 1
ReaderList.ListIndex = i
If ReaderList.Text = "OMNIKEY CardMan 5121 0" Then
SelectedReader = ReaderList.Text
End If
Next i
   
   
   
End Sub
Private Function HexDump(response() As Byte, ByVal lenr As Long) As String

Dim OUT As String
Dim count As Integer
Dim value As Integer

For count = 0 To lenr - 1 Step 1
    value = response(count)
   
    ifvalue = Fix(value / 16)
    If ifvalue > -1 And ifvalue < 10 Then
        OUT = OUT + String(1, ifvalue + 48)
    Else
        If ifvalue > 9 And ifvalue < 16 Then
            OUT = OUT + String(1, ifvalue + 55)
        End If
    End If
    
    value = Fix(value Mod 16)
        
    If value > -1 And value < 10 Then
        OUT = OUT + String(1, value + 48)
    Else
        If value > 9 And value < 16 Then
            OUT = OUT + String(1, value + 55)
        End If
    End If
     
    OUT = OUT + "" 'Trennzeichen
Next count

HexDump = OUT

End Function
'
' Convert 1 Byte to String
'
Private Function GetString(ByVal curByte As Byte) As String

GetString = String(1, curByte)

End Function

Private Function HexStrToInt(ByVal str As String) As Integer

Dim i As Integer
Dim iTmp As Integer
Dim sTmp As String

iStrLen = Len(str)

iTmp = 0
For i = 1 To Len(str)
    iTmp = iTmp * 16
    sTmp = Mid$(str, i, 1)
    iTmp = iTmp + Switch(sTmp = "A", 10, _
                         sTmp = "a", 10, _
                         sTmp = "B", 11, _
                         sTmp = "b", 11, _
                         sTmp = "C", 12, _
                         sTmp = "c", 12, _
                         sTmp = "D", 13, _
                         sTmp = "d", 13, _
                         sTmp = "E", 14, _
                         sTmp = "e", 14, _
                         sTmp = "F", 15, _
                         sTmp = "f", 15, _
                         1 = 1, sTmp _
                         )
Next

HexStrToInt = iTmp

End Function

Private Function StrToArray(ByRef ucBuffer() As Byte, ByVal BufferLen As Integer, ByVal str As String) As Integer

Dim i As Integer
Dim iStrLen As Integer
Dim iTmp As Integer
Dim sTmp As String
Dim temp(64) As Byte
iStrLen = Len(str)

If (iStrLen Mod 2) <> 0 Then
OutPutList.AddItem "Invalid String"
Exit Function
End If

If BufferLen <> iStrLen / 2 Then
OutPutList.AddItem "Buffer size and string size does not match"
Exit Function
End If

iTmp = 0
For i = 1 To iStrLen
    sTmp = Mid$(str, i, 1)
    iTmp = iTmp + Switch(sTmp = "A", 10, _
                         sTmp = "a", 10, _
                         sTmp = "B", 11, _
                         sTmp = "b", 11, _
                         sTmp = "C", 12, _
                         sTmp = "c", 12, _
                         sTmp = "D", 13, _
                         sTmp = "d", 13, _
                         sTmp = "E", 14, _
                         sTmp = "e", 14, _
                         sTmp = "F", 15, _
                         sTmp = "f", 15, _
                         1 = 1, sTmp _
                         )
  
    If (i Mod 2) = 0 Then
        temp((i / 2)) = iTmp
        iTmp = 0
    End If
    iTmp = iTmp * 16
Next


For i = 0 To BufferLen - 1 Step 1
ucBuffer(i) = temp(i + 1)
Next



StrToArray = iStrLen / 2


End Function

Private Sub iCLASSTransmit_Click()
Dim ucSendData(64) As Byte
Dim lSendDataLen As Long
Dim ucReceivedData(64) As Byte
Dim lReceivedDataLen As Long
Dim iStrLen As Integer

lReceivedDataLen = 64
If fCardConnected = False Then
OutPutList.AddItem " At first Card has to be connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If

iStrLen = Len(iCLASSSendText.Text)
lSendDataLen = StrToArray(ucSendData, iStrLen / 2, iCLASSSendText.Text)

rc = SCardCLICCTransmit(hCard, ucSendData(LBound(ucSendData)), lSendDataLen, ucReceivedData(LBound(ucReceivedData)), lReceivedDataLen)
If rc <> 0 Then
OutPutList.AddItem "Error in  SCardCLICCTransmit"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " SUCCESS"
End If

If rc = 0 Then
OutPutList.AddItem "SCardCLICCTransmit has been performed successfully"
StatusText.Text = " SUCCESS"
iCLASSReceivedText = HexDump(ucReceivedData, lReceivedDataLen)
End If







EXITSUB:
End Sub

Private Sub Increment_Click()
Dim ucData(4) As Byte
Dim DataLen As Long
Dim BlockNr As Long


If fCardConnected = False Then
OutPutList.AddItem "Card is not Connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If

BlockNr = HexStrToInt(BlockNrText.Text)
DataLen = StrToArray(ucData, 4, IncrementValText.Text)
rc = SCardCLMifareStdIncrementVal(hCard, BlockNr, ucData(LBound(ucData)), DataLen)
If rc = 0 Then
OutPutList.AddItem "Value has been incremented  Successfully"
StatusText.Text = " SUCCESS"

End If

If rc <> 0 Then
OutPutList.AddItem "Error in  SCardCLMifareStdIncrementVal"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"

End If

EXITSUB:

OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Sub KeysToReaderCommand_Click()
    MultiKeyForm.Show
End Sub

Private Sub OptionKey_Click()
AuthenKeyNrText.Text = ""
End Sub

Private Sub OptionKeyNr_Click()
AuthenKeyNrText.Text = "00"
End Sub

Private Sub Read_Click()

Dim BlockNr As Long
Dim ucData(16) As Byte
Dim NumofDataLen As Long

If fCardConnected = False Then
OutPutList.AddItem " At first Card has to be connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If



BlockNr = HexStrToInt(BlockNrText.Text)
NumofDataLen = 16
rc = SCardCLMifareStdRead(hCard, BlockNr, ucData(LBound(ucData)), 16, NumofDataLen)

If rc = 0 Then
OutPutList.AddItem "Reading has been done successfully"
StatusText.Text = " SUCCESS"
DataReadText = HexDump(ucData, NumofDataLen)
End If

If rc <> 0 Then
OutPutList.AddItem "Error in  SCardCLMifareStdRead"
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"

End If

EXITSUB:
OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Sub ReaderList_Click()
Dim i As Integer

OutPutList.AddItem "Selected Reader is "
OutPutList.AddItem ReaderList.Text
SelectedReader = ReaderList.Text
End Sub
Private Function GetCardName() As String

CardNameText = "UNKNOWN CARD"
' atr with old driver
If ATRLen = 17 Then
If ATR(1) = 15 Then
If ATR(16) = 17 Then
CardNameText = "Mifare Standard 1K"
End If
If ATR(16) = 33 Then
CardNameText = "Mifare Standard 4K"
End If
If ATR(16) = 49 Then
CardNameText = "Mifare Ultra Light"
End If
If ATR(16) = 22 Then
CardNameText = "AT88RF020"
End If
If ATR(16) = 38 Then
CardNameText = "AT88SC6416CRF"
End If
If ATR(16) = 229 Then
CardNameText = "STm SR176"
End If
If ATR(16) = 245 Then
CardNameText = "STm SRI X4K"
End If
If ATR(16) = 24 Then
CardNameText = "I.CODE 1"
End If
If ATR(16) = 131 Then
CardNameText = "iClass"
End If
If ATR(16) = 212 Then
CardNameText = "KSW TempSens"
End If
If ATR(16) = 20 Then
CardNameText = "SRF55V10P"
End If
If ATR(16) = 180 Then
CardNameText = "I.CODE SLI"
End If
If ATR(16) = 148 Then
CardNameText = "Tag It"
End If
If ATR(16) = 164 Then
CardNameText = "X-ident STm LRI 512"
End If
If ATR(16) = 195 Then
CardNameText = "iCLASS 2K"
End If
If ATR(16) = 147 Then
CardNameText = "iCLASS 2KS"
End If
If ATR(16) = 211 Then
CardNameText = "iCLASS 16K"
End If
If ATR(16) = 163 Then
CardNameText = "iCLASS 16KS"
End If
If ATR(16) = 227 Then
CardNameText = "iCLASS 8x2K"
End If
If ATR(16) = 179 Then
CardNameText = "iCLASS 8x2KS"
End If

End If
End If



' atr with new driver Pc/Sc

If ATRLen = 20 Then
If ATR(13) = 0 Then
If ATR(14) = 1 Then
CardNameText = "Mifare Standard 1K"
End If
If ATR(14) = 2 Then
CardNameText = "Mifare Standard 4K"
End If
If ATR(14) = 3 Then
CardNameText = "Mifare Ultra Light"
End If
If ATR(14) = 4 Then
CardNameText = "SLE55R_XXXX"
End If
If ATR(14) = 6 Then
CardNameText = "SR176"
End If
If ATR(14) = 7 Then
CardNameText = "SRI_X4K"
End If
If ATR(14) = 8 Then
CardNameText = "AT88RF020"
End If
If ATR(14) = 9 Then
CardNameText = "AT88SC0204CRF"
End If
If ATR(14) = 10 Then
CardNameText = "AT88SC0808CRF"
End If
If ATR(14) = 11 Then
CardNameText = "AT88SC1616RF"
End If
If ATR(14) = 12 Then
CardNameText = "AT88SC3216CRF"
End If
If ATR(14) = 13 Then
CardNameText = "AT88SC6416CRF"
End If
If ATR(14) = 14 Then
CardNameText = "SRF55V10P"
End If
If ATR(14) = 15 Then
CardNameText = "SRF55V02P"
End If
If ATR(14) = 16 Then
CardNameText = "SRF55V10S"
End If
If ATR(14) = 17 Then
CardNameText = "SRF55V02S"
End If
If ATR(14) = 18 Then
CardNameText = "TAG_IT"
End If
If ATR(14) = 19 Then
CardNameText = "LRI512"
End If
If ATR(14) = 20 Then
CardNameText = "ICODE.SII"
End If
If ATR(14) = 21 Then
CardNameText = "TEMPSENS"
End If
If ATR(14) = 22 Then
CardNameText = "i.CODE1"
End If
If ATR(14) = 24 Then
CardNameText = "iCLASS2KS"
End If
If ATR(14) = 26 Then
CardNameText = "iCLASS16KS"
End If
If ATR(14) = 28 Then
CardNameText = "iCLASS8x2KS"
End If
If ATR(14) = 29 Then
CardNameText = "iCLASS32KS_16_16"
End If
If ATR(14) = 30 Then
CardNameText = "iCLASS32KS_16_8x2"
End If
If ATR(14) = 31 Then
CardNameText = "iCLASS32KS_8x2_16"
End If
If ATR(14) = 32 Then
CardNameText = "iCLASS32KS_8x2_8x2"
End If

End If
End If

GetCardName = CardNameText
End Function


Private Sub RefreshOutput_Click()
OutPutList.Clear

End Sub

Private Sub SniffCommand_Click()
    If SniffCommand.Caption = "Sniff Cards" Then
        SniffCommand.Caption = "Stop Sniffing"
        sniffing = True
        DisConnectCard_Click
        Timer1.Enabled = True
    Else
        SniffCommand.Caption = "Sniff Cards"
        Timer1.Enabled = False
        sniffing = False
    End If
    
    
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    ConnectCard_Click
    
    If OutPutList.ListCount > 100 Then
        RefreshOutput_Click
    End If
    
    If StatusText.Text = " SUCCESS" Then
        DumpButton_Click
        DisConnectCard_Click
    End If
    Timer1.Enabled = True
End Sub

Private Sub Write_Click()

Dim BlockNr As Long
Dim ucData(16) As Byte
Dim DataLen As Long
BlockNr = HexStrToInt(BlockNrText.Text)

If fCardConnected = False Then
OutPutList.AddItem " At first Card has to be connected"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If

If BlockNr < 128 Then
If ((BlockNr + 1) Mod 4) = 0 Then
OutPutList.AddItem " Sector block cannot be written with this applpication"
StatusText.Text = " ERROR"
GoTo EXITSUB
End If
End If
If BlockNr > 128 Then
If ((BlockNr + 1) Mod 16) = 0 Then
OutPutList.AddItem " Sector block cannot be written with this applpication "
StatusText.Text = " ERROR"
GoTo EXITSUB
End If
End If


DataLen = StrToArray(ucData, 16, DataWriteText.Text)

rc = SCardCLMifareStdWrite(hCard, BlockNr, ucData(LBound(ucData)), DataLen)
If rc = 0 Then
OutPutList.AddItem " Data has been written successfully"
StatusText.Text = " SUCCESS"
End If
If rc <> 0 Then
OutPutList.AddItem " Error in writting Data "
StatusText.Text = " ERROR"
OutPutList.AddItem HandleError(rc)
End If

EXITSUB:
OutPutList.ListIndex = OutPutList.ListCount - 1

End Sub

Public Sub WriteMifKeyToReader_Click()
Dim MifKeyToReader(6) As Byte
Dim MifKeyNr As Long
Dim KeyLen As Long

MifKeyNr = HexStrToInt(MifKeyToReaderNrText.Text)
KeyLen = StrToArray(MifKeyToReader, 6, MifareKeyToReaderText.Text)

rc = SCardCLWriteMifareKeyToReader(hCard, hContext, SelectedReader, MifKeyNr, KeyLen, MifKeyToReader(LBound(MifKeyToReader)), False, 0)

If rc = 0 Then
OutPutList.AddItem " Mifare key has been writen to the reader successfully"
StatusText.Text = " SUCCESS"
End If
If rc <> 0 Then
OutPutList.AddItem " Error in writting Mifare key to the reader "
OutPutList.AddItem HandleError(rc)
StatusText.Text = " ERROR"
End If

OutPutList.ListIndex = OutPutList.ListCount - 1
End Sub

Private Function HandleError(ByVal rc As Long) As String

HandleError = "Unknown Error"
If rc = OKERR_OK Then HandleError = "No Error"
If rc = OKERR_SCARD__E_CANCELLED Then HandleError = "The action was cancelled by an SCardCancel request"
If rc = OKERR_SCARD__E_INVALID_HANDLE Then HandleError = "The supplied handle was invalid"
If rc = OKERR_SCARD__E_INVALID_PARAMETER Then HandleError = "One or more of the supplied parameters could not be properly interpreted"
If rc = OKERR_SCARD__E_INVALID_TARGET Then HandleError = "Registry startup information is missing or invalid"
If rc = OKERR_SCARD__E_NO_MEMORY Then HandleError = "Not enough memory available to complete this command"
If rc = OKERR_SCARD__F_WAITED_TOO_LONG Then HandleError = "An internal consistency timer has expired"
If rc = OKERR_SCARD__E_INSUFFICIENT_BUFFER Then HandleError = "The data buffer to receive returned data is too small for the returned data"
If rc = OKERR_SCARD__E_UNKNOWN_READER Then HandleError = "The specified reader name is not recognized"
If rc = OKERR_SCARD__E_TIMEOUT Then HandleError = "The user-specified timeout value has expired"
If rc = OKERR_SCARD__E_SHARING_VIOLATION Then HandleError = "The smart card cannot be accessed because of other connections outstanding"
If rc = OKERR_SCARD__E_NO_SMARTCARD Then HandleError = "The operation requires a Smart Card, but no Smart Card is currently in the device"
If rc = OKERR_SCARD__E_UNKNOWN_CARD Then HandleError = "The specified smart card name is not recognized"
If rc = OKERR_SCARD__E_CANT_DISPOSE Then HandleError = "The system could not dispose of the media in the requested manner"
If rc = OKERR_SCARD__E_PROTO_MISMATCH Then HandleError = "The requested protocols are incompatible with the protocol currently in use with the smart card"
If rc = OKERR_SCARD__E_NOT_READY Then HandleError = "The reader or smart card is not ready to accept commands"
If rc = OKERR_SCARD__E_INVALID_VALUE Then HandleError = "One or more of the supplied parameters values could not be properly interpreted"
If rc = OKERR_SCARD__E_SYSTEM_CANCELLED Then HandleError = "The action was cancelled by the system, presumably to log off or shut down"
If rc = OKERR_SCARD__F_COMM_ERROR Then HandleError = "An internal communications error has been detected"
If rc = OKERR_SCARD__F_UNKNOWN_ERROR Then HandleError = "An internal error has been detected, but the source is unknown"
If rc = OKERR_SCARD__E_INVALID_ATR Then HandleError = "An ATR obtained from the registry is not a valid ATR string"
If rc = OKERR_SCARD__E_NOT_TRANSACTED Then HandleError = "An attempt was made to end a non-existent transaction"
If rc = OKERR_SCARD__E_READER_UNAVAILABLE Then HandleError = "The specified reader is not currently available for use"
If rc = OKERR_SCARD__P_SHUTDOWN Then HandleError = "The operation has been aborted to allow the server application to exit"
If rc = OKERR_SCARD__E_PCI_TOO_SMALL Then HandleError = "The PCI Receive buffer was too small"
If rc = OKERR_SCARD__E_READER_UNSUPPORTED Then HandleError = "The reader driver does not meet minimal requirements for support"
If rc = OKERR_SCARD__E_DUPLICATE_READER Then HandleError = "The reader driver did not produce a unique reader name"
If rc = OKERR_SCARD__E_CARD_UNSUPPORTED Then HandleError = "The smart card does not meet minimal requirements for support"
If rc = OKERR_SCARD__E_NO_SERVICE Then HandleError = "The Smart card resource manager is not running"
If rc = OKERR_SCARD__E_SERVICE_STOPPED Then HandleError = "The Smart card resource manager has shut down"
If rc = OKERR_SCARD__E_UNEXPECTED Then HandleError = "An unexpected card error has occurred"
If rc = OKERR_SCARD__E_ICC_INSTALLATION Then HandleError = "No Primary Provider can be found for the smart card"
If rc = OKERR_SCARD__E_ICC_CREATEORDER Then HandleError = "The requested order of object creation is not supported"
If rc = OKERR_SCARD__E_UNSUPPORTED_FEATURE Then HandleError = "This smart card does not support the requested feature"
If rc = OKERR_SCARD__E_DIR_NOT_FOUND Then HandleError = "The identified directory does not exist in the smart card"
If rc = OKERR_SCARD__E_FILE_NOT_FOUND Then HandleError = "The identified file does not exist in the smart card"
If rc = OKERR_SCARD__E_NO_DIR Then HandleError = "The supplied path does not represent a smart card directory"
If rc = OKERR_SCARD__E_NO_FILE Then HandleError = "The supplied path does not represent a smart card file"
If rc = OKERR_SCARD__E_NO_ACCESS Then HandleError = "Access is denied to this file"
If rc = OKERR_SCARD__E_WRITE_TOO_MANY Then HandleError = "An attempt was made to write more data than would fit in the target object"
If rc = OKERR_SCARD__E_BAD_SEEK Then HandleError = "There was an error trying to set the smart card file object pointer"
If rc = OKERR_SCARD__E_INVALID_CHV Then HandleError = "The supplied PIN is incorrect"
If rc = OKERR_SCARD__E_UNKNOWN_RES_MNG Then HandleError = "An unrecognized error code was returned from a layered component"
If rc = OKERR_SCARD__E_NO_SUCH_CERTIFICATE Then HandleError = "The requested certificate does not exist"
If rc = OKERR_SCARD__E_CERTIFICATE_UNAVAILABLE Then HandleError = "The requested certificate could not be obtained"
If rc = OKERR_SCARD__E_NO_READERS_AVAILABLE Then HandleError = "Cannot find a smart card reader"
If rc = OKERR_SCARD__E_COMM_DATA_LOST Then HandleError = "A communications error with the smart card has been detected"
If rc = OKERR_SCARD__W_UNSUPPORTED_CARD Then HandleError = "The reader cannot communicate with the smart card, due to ATR configuration conflicts"
If rc = OKERR_SCARD__W_UNRESPONSIVE_CARD Then HandleError = "The smart card is not responding to a reset"
If rc = OKERR_SCARD__W_UNPOWERED_CARD Then HandleError = "Power has been removed from the smart card, so that further communication is not possible"
If rc = OKERR_SCARD__W_RESET_CARD Then HandleError = "The smart card has been reset, so any shared state information is invalid"
If rc = OKERR_SCARD__W_REMOVED_CARD Then HandleError = "The smart card has been removed, so that further communication is not possible"
If rc = OKERR_SCARD__W_SECURITY_VIOLATION Then HandleError = "Access was denied because of a security violation"
If rc = OKERR_SCARD__W_WRONG_CHV Then HandleError = "The card cannot be accessed because the wrong PIN was presented"
If rc = OKERR_SCARD__W_CHV_BLOCKED Then HandleError = "The card cannot be accessed because the maximum number of PIN entry attempts has been reached"
If rc = OKERR_SCARD__W_EOF Then HandleError = "The end of the smart card file has been reached"
If rc = OKERR_SCARD__W_CANCELLED_BY_USER Then HandleError = "The action was cancelled by the user"

If rc = OKERR_PARM1 Then HandleError = "Error in parameter 1"
If rc = OKERR_PARM2 Then HandleError = "Error in parameter 2"
If rc = OKERR_PARM3 Then HandleError = "Error in parameter 3"
If rc = OKERR_PARM4 Then HandleError = "Error in parameter 4"
If rc = OKERR_PARM5 Then HandleError = "Error in parameter 5"
If rc = OKERR_PARM6 Then HandleError = "Error in parameter 6"
If rc = OKERR_PARM7 Then HandleError = "Error in parameter 7"
If rc = OKERR_PARM8 Then HandleError = "Error in parameter 8"
If rc = OKERR_PARM9 Then HandleError = "Error in parameter 9"
If rc = OKERR_PARM10 Then HandleError = "Error in parameter 10"
If rc = OKERR_PARM11 Then HandleError = "Error in parameter 11"
If rc = OKERR_PARM12 Then HandleError = "Error in parameter 12"
If rc = OKERR_PARM13 Then HandleError = "Error in parameter 13"
If rc = OKERR_PARM14 Then HandleError = "Error in parameter 14"
If rc = OKERR_PARM15 Then HandleError = "Error in parameter 15"
If rc = OKERR_PARM16 Then HandleError = "Error in parameter 16"
If rc = OKERR_PARM17 Then HandleError = "Error in parameter 17"
If rc = OKERR_PARM18 Then HandleError = "Error in parameter 18"
If rc = OKERR_PARM19 Then HandleError = "Error in parameter 19"
If rc = OKERR_INSUFFICIENT_PRIV Then HandleError = "You currently do not have the rights to execute the requested action. Usually a password has to be presented in advance."
If rc = OKERR_PW_WRONG Then HandleError = "The presented password is wrong"
If rc = OKERR_PW_LOCKED Then HandleError = "The password has been presented several times wrong and is therefore locked. Usually use some administrator tool to unblock it."
If rc = OKERR_PW_TOO_SHORT Then HandleError = "The lenght of the password was too short."
If rc = OKERR_PW_TOO_LONG Then HandleError = "The length of the password was too long."
If rc = OKERR_PW_NOT_LOCKED Then HandleError = "The password is not locked"
If rc = OKERR_ITEM_NOT_FOUND Then HandleError = "An item (e.g. a key of a specific name) could not be found"
If rc = OKERR_ITEMS_LEFT Then HandleError = "There are still items left, therefore e.g. the directory / structure etc. can't be deleted."
If rc = OKERR_INVALID_CFG_FILE Then HandleError = "Invalid configuration file"
If rc = OKERR_SECTION_NOT_FOUND Then HandleError = "Section not found"
If rc = OKERR_ENTRY_NOT_FOUND Then HandleError = "Entry not found"
If rc = OKERR_NO_MORE_SECTIONS Then HandleError = "No more sections"
If rc = OKERR_ITEM_ALREADY_EXISTS Then HandleError = "The specified item alread exists."
If rc = OKERR_ITEM_EXPIRED Then HandleError = "Some item (e.g. a certificate) has expired."
If rc = OKERR_UNEXPECTED_RET_VALUE Then HandleError = "Unexpected return value"
If rc = OKERR_COMMUNICATE Then HandleError = "General communication error"
If rc = OKERR_NOT_ENOUGH_MEMORY Then HandleError = "Not enough memory"
If rc = OKERR_BUFFER_OVERFLOW Then HandleError = "Buffer overflow"
If rc = OKERR_TIMEOUT Then HandleError = "A timeout has occurred"
If rc = OKERR_NOT_SUPPORTED Then HandleError = "The requested functionality is not supported at this time / under this OS / in this situation etc."
If rc = OKERR_ILLEGAL_ARGUMENT Then HandleError = "Illegal argument"
If rc = OKERR_READ_FIO Then HandleError = "File IO read error"
If rc = OKERR_WRITE_FIO Then HandleError = "File IO write error"
If rc = OKERR_INVALID_HANDLE Then HandleError = "Invalid handle"
If rc = OKERR_GENERAL_FAILURE Then HandleError = "General failure."
If rc = OKERR_FILE_NOT_FOUND Then HandleError = "File not found"
If rc = OKERR_OPEN_FILE Then HandleError = "File opening failed"
If rc = OKERR_SEM_USED Then HandleError = "The semaphore is currently use by an other process"
If rc = OKERR_NOP Then HandleError = "No operation done"
If rc = OKERR_NOK Then HandleError = "Function not executed"
If rc = OKERR_FWBUG Then HandleError = "Internal error detected"
If rc = OKERR_INIT Then HandleError = "Module not initialized"
If rc = OKERR_FIO Then HandleError = "File IO error detected"
If rc = OKERR_ALLOC Then HandleError = "Cannot allocate memory"
If rc = OKERR_SESSION_ERR Then HandleError = "General error"
If rc = OKERR_ACCESS_ERR Then HandleError = "Access not allowed"
If rc = OKERR_OPEN_FAILURE Then HandleError = "An open command was not successful"
If rc = OKERR_CARD_NOT_POWERED Then HandleError = "Card is not powered"
If rc = OKERR_ILLEGAL_CARDTYPE Then HandleError = "Illegal cardtype"
If rc = OKERR_CARD_NOT_INSERTED Then HandleError = "Card not inserted"
If rc = OKERR_NO_DRIVER Then HandleError = "No device driver installed"
If rc = OKERR_OUT_OF_SERVICE Then HandleError = "The service is currently not available"
If rc = OKERR_EOF_REACHED Then HandleError = "End of file reached"
If rc = OKERR_ON_BLACKLIST Then HandleError = "The ID is on a blacklist, the requested action is therefore not allowed."
If rc = OKERR_CONSISTENCY_CHECK Then HandleError = "Error during consistency check"
If rc = OKERR_IDENTITY_MISMATCH Then HandleError = "The identity does not match a defined cross-check identity"
If rc = OKERR_MULTIPLE_ERRORS Then HandleError = "Multiple errors have occurred. Use this if there is only the possibility to return one error code, but there happened different errors before (e.g. each thread returned a different error and the controlling thread may only report one)."
If rc = OKERR_ILLEGAL_DRIVER Then HandleError = "Illegal driver"
If rc = OKERR_ILLEGAL_FW_RELEASE Then HandleError = "The connected hardware whose firmware is not useable by this software"
If rc = OKERR_NO_CARDREADER Then HandleError = "No cardreader attached"
If rc = OKERR_IPC_FAULT Then HandleError = "General failure of inter process communication"
If rc = OKERR_WAIT_AND_RETRY Then HandleError = "The service currently does not take calls. The task has to go back to the message loop and try again at a later time (Windows 3.1 only). The code may also be used, in every situation where a ‘  wait and retry ’  action is requested."

End Function




