VERSION 5.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "MCARD VB Sample"
ClientHeight = 2940
ClientLeft = 3630
ClientTop = 2070
ClientWidth = 10710
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 2940
ScaleWidth = 10710
ShowInTaskbar = 0 'False
Begin VB.TextBox Text1
Height = 375
Left = 2880
TabIndex = 3
Text = "SCM Microsystems Inc. SCR33x USB Smart Card Reader 0"
Top = 120
Width = 7695
End
Begin VB.Frame Frame1
Caption = "Data OUT"
Height = 1935
Left = 3840
TabIndex = 1
Top = 840
Width = 6735
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Caption = "Data"
Height = 1575
Left = 120
TabIndex = 2
Top = 240
Width = 6495
End
End
Begin VB.CommandButton Command1
Caption = "Test"
Height = 420
Left = 120
TabIndex = 0
Top = 120
Width = 1335
End
Begin VB.Label Label5
Caption = "Label5"
Height = 255
Left = 120
TabIndex = 8
Top = 1800
Width = 2895
End
Begin VB.Label Label4
Caption = "Label4"
Height = 255
Left = 120
TabIndex = 7
Top = 1440
Width = 2895
End
Begin VB.Label LabelReader
Caption = "Reader: "
Height = 255
Left = 1920
TabIndex = 6
Top = 240
Width = 855
End
Begin VB.Label Label3
Caption = "Label3"
Height = 255
Left = 120
TabIndex = 5
Top = 1080
Width = 2895
End
Begin VB.Label Label2
Caption = "Label2"
Height = 375
Left = 120
TabIndex = 4
Top = 720
Width = 2895
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'**
'** MCARD
API Visual Basic Sample
'**
'** (c) SCM Microsystems, 2003
'**
'** http://www.scmmicro.de
'**
'*********************************************************************
Const MCARDTYPE_SLE4428 = &H3
Const MCARDTYPE_SLE4442 = &H6
Const MCARD_ATTR_TYPE = &H0
' Memory card specific error codes
Const SCARD_CODE_BASE = &H80100000
Const COSTOMER_CODE_FLAG = &H20000000
Const MCARD_OFFSET = &H800
Const MCARD_E_OFFSET = &H0
Const MCARD_W_OFFSET = &H65
Const MCARD_CODE_BASE = ((SCARD_CODE_BASE + COSTOMER_CODE_FLAG) + MCARD_OFFSET)
Const MCARD_E_CODE_BASE = (MCARD_CODE_BASE + MCARD_E_OFFSET)
Const MCARD_W_CODE_BASE = (MCARD_CODE_BASE + MCARD_W_OFFSET)
' success code
Const MCARD_S_SUCCESS = &H0
' MCARD_E_xxx error codes (indicate the "bad" errors)
' 0xA0100801: an internal error has occured
Const MCARD_E_INTERNAL_ERROR = MCARD_E_CODE_BASE + &H1
' 0xA0100802: function not implemented
Const MCARD_E_NOT_IMPLEMENTED = MCARD_E_CODE_BASE + &H2
' 0xA0100803: MCardInitialize not called
Const MCARD_E_NOT_INITIALIZED = MCARD_E_CODE_BASE + &H3
' 0xA0100804: this
DLL does not work with the specified reader
Const MCARD_E_INCOMPATIBLE_READER = MCARD_E_CODE_BASE + &H4
' 0xA0100805: could not identify card
Const MCARD_E_UNKNOWN_CARD = MCARD_E_CODE_BASE + &H5
' 0xA0100811: the buffer for return daa is too small
Const MCARD_E_BUFFER_TOO_SMALL = MCARD_E_CODE_BASE + &H11
' 0xA0100812: one or more parameters are invalid
Const MCARD_E_INVALID_PARAMETER = MCARD_E_CODE_BASE + &H12
' 0xA0100821: protocoll error while connecting to card
Const MCARD_E_PROTO_MISMATCH = MCARD_E_CODE_BASE + &H21
' 0xA0100822: protocol error during card
access
Const MCARD_E_PROTOCOL_ERROR = MCARD_E_CODE_BASE + &H22
' 0xA0100827: Challenge Response Failed
Const MCARD_E_CHAL_RESP_FAILED = MCARD_E_CODE_BASE + &H23
' 0xA0100826: Invalid memory range
Const MCARD_E_INVALID_MEMORY_RANGE = MCARD_E_CODE_BASE + &H24
' 0xA0100831: specified memory zone ID is invalid for current card
Const MCARD_E_INVALID_MEMORY_ZONE_ID = MCARD_E_CODE_BASE + &H31
' 0xA0100832: specified PIN ID is invalid for current card
Const MCARD_E_INVALID_PIN_ID = MCARD_E_CODE_BASE + &H32
' 0xA0100833: spezcified challenge/response ID is invalid for current card
Const MCARD_E_INVALID_CHAL_RESP_ID = MCARD_E_CODE_BASE + &H33
' MCARD_W_xxx warning codes (a problem occured, but it's up to the
' application to decide how bad it is)
' 0xA0100866: could not read all data from card
Const MCARD_W_NOT_ALL_DATA_READ = MCARD_W_CODE_BASE + &H1
' 0xA0100867: could not write all data to card
Const MCARD_W_NOT_ALL_DATA_WRITTEN = MCARD_W_CODE_BASE + &H2
' 0xA0100876: PIN must be verified before
access is possible
Const MCARD_W_PIN_VERIFY_NEEDED = MCARD_W_CODE_BASE + &H11
' 0xA0100877: PIN verification failed
Const MCARD_W_PIN_VERIFY_FAILED = MCARD_W_CODE_BASE + &H12
' 0xA0100878: no PIN verification attempts left, card probably locked
Const MCARD_W_NO_PIN_ATTEMPTS_LEFT = MCARD_W_CODE_BASE + &H13
' 0xA0100879: no units left in the card to decrement
Const MCARD_W_NO_UNITS_TO_DECREMENT = MCARD_W_CODE_BASE + &H14
'*********************************************************************
Private Declare Function SCardEstablishContext Lib "WINSCARD.DLL" ( _
ByVal swScope As Long, _
ByVal pvReserved1 As Long, _
ByVal pvReserved2 As Long, _
ByRef phSCardContext As Long _
) As Long
'*********************************************************************
Private Declare Function SCardReleaseContext Lib "WINSCARD.DLL" ( _
ByVal hSCardContext As Long _
) As Long
'*********************************************************************
Private Declare Function MCardInitialize Lib "MCSCM.DLL" ( _
ByVal hSCardContext As Long, _
ByVal scReaderName As String, _
ByRef phMCardContext As Long, _
ByRef pdwDLLVersion As Long _
) As Long
'*********************************************************************
Private Declare Function MCardShutdown Lib "MCSCM.DLL" ( _
ByVal hMCardContext As Long _
) As Long
'*********************************************************************
Private Declare Function MCardConnect Lib "MCSCM.DLL" ( _
ByVal hMCardContext As Long, _
ByVal dwConnectMode As Long, _
ByVal byCardType As Byte, _
ByRef phMCard As Long _
) As Long
'*********************************************************************
Private Declare Function MCardDisconnect Lib "MCSCM.DLL" ( _
ByVal hMCardContext As Long, _
ByVal dwDisposition As Long _
) As Long
'*********************************************************************
Private Declare Function MCardGetAttrib Lib "MCSCM.DLL" ( _
ByVal hMCardContext As Long, _
ByVal dwAttrId As Long, _
ByVal pbAttr As String, _
ByRef pcbAttrLen As Long _
) As Long
'*********************************************************************
Private Declare Function MCardReadMemory Lib "MCSCM.DLL" ( _
ByVal hMCard As Long, _
ByVal bMemZone As Byte, _
ByVal dwOffset As Long, _
ByVal pbReadBuffer As String, _
ByRef pbReadLen As Long _
) As Long
'*********************************************************************
Private Declare Function MCardWriteMemory Lib "MCSCM.DLL" ( _
ByVal hMCard As Long, _
ByVal bMemZone As Byte, _
ByVal dwOffset As Long, _
ByVal pbWriteBuffer As String, _
ByRef pcbWriteLen As Long _
) As Long
'*********************************************************************
Private Declare Function MCardVerifyPIN Lib "MCSCM.DLL" ( _
ByVal hMCard As Long, _
ByVal bPinNumber As Byte, _
ByVal dataPIN As String, _
ByVal cbLen As Byte _
) As Long
'*********************************************************************
Private Declare Function MCardChangePIN Lib "MCSCM.DLL" ( _
ByVal hMCard As Long, _
ByVal bPinNumber As Byte, _
ByVal dataOldPIN As String, _
ByVal cbLenOldPin As Byte, _
ByVal dataNewPIN As String, _
ByVal cbNewOldPin As Byte _
) As Long
Private Sub DisplayErr( _
ByVal S As String, _
ByVal L As Long _
)
Label1.Caption = Label1.Caption & S & " returned " & MCardErrToStr(L) & Chr(10) & Chr(13)
End Sub
Private Sub AddLog( _
ByVal S As String _
)
Label1.Caption = Label1.Caption & S & Chr(10) & Chr(13)
End Sub
Function MCardGetAttribLong( _
ByVal hMCardContext As Long, _
ByVal dwAttrId As Long, _
ByRef pbAttr As Long _
) As Long
Dim S As String
Dim lSize As Long
Dim bData As Byte
Dim lReturn As Long
S = String(100, 0)
lSize = 4
lReturn = MCardGetAttrib(hMCardContext, dwAttrId, S, lSize)
If (lReturn <> 0) Then
DisplayErr "MCardGetAttrib", lReturn
MCardGetAttribLong = lReturn
Exit Function
End If
pbAttr = Asc(S)
S = Right(S, Len(S) - 1)
pbAttr = pbAttr + (Asc(S) * &HFF)
S = Right(S, Len(S) - 1)
pbAttr = pbAttr + (Asc(S) * &HFFFF)
S = Right(S, Len(S) - 1)
pbAttr = pbAttr + (Asc(S) * &HFFFFFF)
End Function
Private Function MCardErrToStr( _
ByVal Err As Long _
) As String
Select Case Err
Case MCARD_S_SUCCESS
MCardErrToStr = "MCARD_S_SUCCESS"
Case MCARD_E_INTERNAL_ERROR
MCardErrToStr = "MCARD_E_INTERNAL_ERROR"
Case MCARD_E_NOT_IMPLEMENTED
MCardErrToStr = "MCARD_E_NOT_IMPLEMENTED"
Case MCARD_E_NOT_INITIALIZED
MCardErrToStr = "MCARD_E_NOT_INITIALIZED"
Case MCARD_E_INCOMPATIBLE_READER
MCardErrToStr = "MCARD_E_INCOMPATIBLE_READER"
Case MCARD_E_UNKNOWN_CARD
MCardErrToStr = "MCARD_E_UNKNOWN_CARD"
Case MCARD_E_BUFFER_TOO_SMALL
MCardErrToStr = "MCARD_E_BUFFER_TOO_SMALL"
Case MCARD_E_INVALID_PARAMETER
MCardErrToStr = "MCARD_E_INVALID_PARAMETER"
Case MCARD_E_PROTO_MISMATCH
MCardErrToStr = "MCARD_E_PROTO_MISMATCH"
Case MCARD_E_PROTOCOL_ERROR
MCardErrToStr = "MCARD_E_PROTOCOL_ERROR"
Case MCARD_E_CHAL_RESP_FAILED
MCardErrToStr = "MCARD_E_CHAL_RESP_FAILED"
Case MCARD_E_INVALID_MEMORY_RANGE
MCardErrToStr = "MCARD_E_INVALID_MEMORY_RANGE"
Case MCARD_E_INVALID_MEMORY_ZONE_ID
MCardErrToStr = "MCARD_E_INVALID_MEMORY_ZONE_ID"
Case MCARD_E_INVALID_PIN_ID
MCardErrToStr = "MCARD_E_INVALID_PIN_ID"
Case MCARD_E_INVALID_CHAL_RESP_ID
MCardErrToStr = "MCARD_E_INVALID_CHAL_RESP_ID"
Case MCARD_W_NOT_ALL_DATA_READ
MCardErrToStr = "MCARD_W_NOT_ALL_DATA_READ"
Case MCARD_W_NOT_ALL_DATA_WRITTEN
MCardErrToStr = "MCARD_W_NOT_ALL_DATA_WRITTEN"
Case MCARD_W_PIN_VERIFY_NEEDED
MCardErrToStr = "MCARD_W_PIN_VERIFY_NEEDED"
Case MCARD_W_PIN_VERIFY_FAILED
MCardErrToStr = "MCARD_W_PIN_VERIFY_FAILED"
Case MCARD_W_NO_PIN_ATTEMPTS_LEFT
MCardErrToStr = "MCARD_W_NO_PIN_ATTEMPTS_LEFT"
Case MCARD_W_NO_UNITS_TO_DECREMENT
MCardErrToStr = "MCARD_W_NO_UNITS_TO_DECREMENT"
Case Else
MCardErrToStr = "unknown error"
End Select
MCardErrToStr = MCardErrToStr + " (0x" + Hex(Err) + ")"
End Function
Private Sub Command1_Click()
TestFunc (Text1.Text)
End Sub
Private Sub TestFunc( _
ReaderName As String _
)
Dim hSCardCtx As Long
Dim lReturn As Long
Label1.Caption = "Test..." & Chr(10) & Chr(13)
lReturn = SCardEstablishContext(0, 0, 0, hSCardCtx)
If (lReturn <> 0) Then
DisplayErr "SCardEstablishContext", lReturn
Exit Sub
End If
Label2.Caption = "hSCardCtx: 0x" + Hex(hSCardCtx)
DoMCardTest hSCardCtx
lReturn = SCardReleaseContext(hSCardCtx)
If (lReturn <> 0) Then
DisplayErr "SCardReleaseContext", lReturn
Exit Sub
End If
Label1.Caption = Label1.Caption & Chr(10) & Chr(13) & "test ok"
End Sub
Private Sub DoMCardTest( _
hSCardCtx As Long _
)
Dim hMCardCtx As Long
Dim dwDLLVersion As Long
Dim lReturn As Long
Dim ReaderName As String
ReaderName = Text1.Text
lReturn = MCardInitialize(hSCardCtx, ReaderName, hMCardCtx, dwDLLVersion)
If (lReturn <> 0) Then
DisplayErr "MCardInitialize", lReturn
Exit Sub
End If
Label3.Caption = "hMCardCtx: 0x" + Hex(hMCardCtx)
DoConnectToMemCard hSCardCtx, hMCardCtx
lReturn = MCardShutdown(hMCardCtx)
If (lReturn <> 0) Then
DisplayErr "MCardShutdown", lReturn
Exit Sub
End If
End Sub
Private Sub DoConnectToMemCard( _
hSCardCtx As Long, _
hMCardCtx As Long _
)
Dim hMCard As Long
Dim lAttr As Long
lReturn = MCardConnect(hMCardCtx, 1, 0, hMCard)
If (lReturn <> 0) Then
DisplayErr "MCardConnect", lReturn
Exit Sub
End If
Label4.Caption = "hMCard: 0x" + Hex(hMCard)
DoCardTest hSCardCtx, hMCardCtx, hMCard
lReturn = MCardDisconnect(hMCard, 0)
If (lReturn <> 0) Then
DisplayErr "MCardDisconnect", lReturn
Exit Sub
End If
End Sub
Private Sub DoCardTest( _
hSCardCtx As Long, _
hMCardCtx As Long, _
hMCard As Long _
)
Dim lReturn As Long
Dim lAttr As Long
lReturn = MCardGetAttribLong(hMCard, MCARD_ATTR_TYPE, lAttr)
If (lReturn <> 0) Then
DisplayErr "MCardGetAttrib", lReturn
Exit Sub
End If
Label5.Caption = "Type: 0x" + Hex(lAttr)
Dim strPin As String
Dim strPinNew As String
If (lAttr = MCARDTYPE_SLE4428) Then
AddLog "MCARDTYPE_SLE4428"
strPin = Chr(&H0) & Chr(&H0)
strPinNew = Chr(&H12) & Chr(&H34)
DoPinTest hMCard, strPin, strPinNew, 2
End If
If (lAttr = MCARDTYPE_SLE4442) Then
AddLog "MCARDTYPE_SLE4442"
strPin = Chr(&H0) & Chr(&H0) & Chr(&H0)
strPinNew = Chr(&H12) & Chr(&H34) & Chr(&H56)
DoPinTest hMCard, strPin, strPinNew, 3
End If
End Sub
Private Sub DoPinTest( _
hMCard As Long, _
strPin As String, _
strPinNew As String, _
lLen As Long _
)
Dim lReturn As Long
lReturn = MCardVerifyPIN(hMCard, 0, strPin, lLen)
If (lReturn <> 0) Then
DisplayErr "MCardVerifyPIN", lReturn
Exit Sub
End If
lReturn = MCardChangePIN(hMCard, 0, strPin, lLen, strPinNew, lLen)
If (lReturn <> 0) Then
DisplayErr "MCardChangePIN (1)", lReturn
Exit Sub
End If
lReturn = MCardChangePIN(hMCard, 0, strPinNew, lLen, strPin, lLen)
If (lReturn <> 0) Then
DisplayErr "MCardChangePIN (2)", lReturn
Exit Sub
End If
AddLog "PIN Test end"
End Sub