scardapi.bas

一个完整的非接触IC卡会员管理系统

' This implies that the card in the reader is unresponsive or not
' supported by the reader or software.
Public Const SCARD_STATE_MUTE        As Long = &H200

' This implies that the card in the reader has not been powered up.
Public Const SCARD_STATE_UNPOWERED   As Long = &H400

' types for providing access to the I/O capabilities of the reader drivers

' I/O request control
Type SCARD_IO_REQUEST
    ' Protocol identifier
    dwProtocol As Long
    ' Protocol Control Information Length
    dbPciLength As Long
End Type

' T=0 command
Type SCARD_T0_Command
    ' the instruction class
    bCla As Byte
    ' the instruction code within the instruction class
    bIns As Byte
    ' first parameter of the function
    bP1 As Byte
    ' second parameter of the function
    bP2 As Byte
    ' size of the I/O transfer
    bP3 As Byte
End Type

' T=0 request
Type SCARD_T0_REQUEST
    ' I/O request control
    ioRequest As SCARD_IO_REQUEST
    ' first return code from the instruction
    bSw1 As Byte
    ' second return code from the instruction
    bSw2 As Byte
    ' I/O command
    CmdBytes As SCARD_T0_Command
End Type

' T=1 request
Type SCARD_T1_REQUEST
    ' I/O request control
    ioRequest As SCARD_IO_REQUEST
End Type

' smart card dialog definitions

' show UI only if required to select card
Public Const SC_DLG_MINIMAL_UI      As Long = 1

' do not show UI in any case
Public Const SC_DLG_NO_UI           As Long = 2

' show UI in every case
Public Const SC_DLG_FORCE_UI        As Long = 4

' dialog error returns
Public Const SCERR_NOCARDNAME       As Long = &H4000
Public Const SCERR_NOGUIDS          As Long = &H8000


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Functions

Public Declare Function SCardEstablishContext Lib "winscard.dll" (ByVal dwScope As Long, ByVal pvReserved1 As Any, ByVal pvReserved2 As Any, ByRef phContext As Long) As Long

Public Declare Function SCardReleaseContext Lib "winscard.dll" (ByVal hContext As Long) As Long

Public Declare Function SCardFreeMemory Lib "winscard.dll" (ByVal hContext As Long, ByVal pvMem As Long) As Long
    
Public Declare Function SCardCancel Lib "winscard.dll" (ByVal hContext As Long) As Long
    
Public Declare Function SCardReconnect Lib "winscard.dll" (ByVal hCard As Long, ByVal dwShareMode As Long, ByVal dwPreferredProtocols As Long, ByVal dwInitialization As Long, ByRef pdwActiveProtocol) As Long
    
Public Declare Function SCardDisconnect Lib "winscard.dll" (ByVal hCard As Long, ByVal dwDisposition As Long) As Long

Public Declare Function SCardBeginTransaction Lib "winscard.dll" (ByVal hCard As Long) As Long

Public Declare Function SCardEndTransaction Lib "winscard.dll" (ByVal hCard As Long, ByVal dwDisposition As Long) As Long

Public Declare Function SCardTransmit Lib "winscard.dll" (ByVal hCard As Long, ByRef pioSendPci As SCARD_IO_REQUEST, ByRef pbSendBuffer As Byte, ByVal cbSendLength As Long, ByRef pioRecvPci As SCARD_IO_REQUEST, ByRef pbRecvBuffer As Byte, ByRef pcbRecvLength As Long) As Long

Public Declare Function SCardControl Lib "winscard.dll" (ByVal hCard As Long, ByVal dwControlCode As Long, ByRef pvInBuffer As Byte, ByVal cbInBufferSize As Long, ByRef pvOutBuffer As Byte, ByVal cbOutBufferSize As Long, ByRef pcbBytesReturned As Long) As Long

Public Declare Function SCardGetAttrib Lib "winscard.dll" (ByVal hCard As Long, ByVal dwAttrId As Long, ByRef pbAttr As Byte, ByRef pcbAttrLen As Long) As Long

Public Declare Function SCardSetAttrib Lib "winscard.dll" (ByVal hCard As Long, ByVal dwAttrId As Long, ByRef pbAttr As Byte, ByVal cbAttrLen As Long) As Long
    
Public Declare Function SCardListReaderGroupsA Lib "winscard.dll" (ByVal hContext As Long, ByVal mszGroups As String, ByRef pcchGroups As Long) As Long
    
Public Declare Function SCardListReadersA Lib "winscard.dll" (ByVal SCARDCONTEXT As Long, ByVal mszGroups As String, ByVal mszReaders As String, ByRef pcchReaders As Long) As Long

Public Declare Function SCardListCardsA Lib "winscard.dll" (ByVal hContext As Long, ByRef pbAtr As Byte, ByRef rgguidInterfaces As GUID, ByVal cguidInterfaceCount As Long, ByVal mszCards As String, ByRef pcchCards As Long) As Long

' second declaration for passing NULL through ATR and GUID parameters
Public Declare Function SCardListCardsA2 Lib "winscard.dll" Alias "SCardListCardsA" (ByVal hContext As Long, ByVal pbAtr As Long, ByVal rgguidInterfaces As Long, ByVal cguidInterfaceCount As Long, ByVal mszCards As String, ByRef pcchCards As Long) As Long

' third declaration for passing NULL through ATR and GUID parameters, BYTE name parameter
Public Declare Function SCardListCardsA3 Lib "winscard.dll" Alias "SCardListCardsA" (ByVal hContext As Long, ByVal pbAtr As Long, ByVal rgguidInterfaces As Long, ByVal cguidInterfaceCount As Long, ByRef mszCards As Byte, ByRef pcchCards As Long) As Long

Public Declare Function SCardListInterfacesA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCard As String, ByRef pguidInterfaces As GUID, ByRef pcguidInterfaces As Long) As Long
    
Public Declare Function SCardGetProviderIdA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCard As String, ByRef pguidProviderId As GUID) As Long
    
Public Declare Function SCardGetCardTypeProviderNameA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCardName As String, ByVal dwProviderId As Long, ByVal szProvider As String, ByRef pcchProvider As Long) As Long

Public Declare Function SCardIntroduceReaderGroupA Lib "winscard.dll" (ByVal hContext As Long, ByVal szGroupName As String) As Long
    
Public Declare Function SCardForgetReaderGroupA Lib "winscard.dll" (ByVal hContext As Long, ByVal szGroupName As String) As Long
    
Public Declare Function SCardIntroduceReaderA Lib "winscard.dll" (ByVal hContext As Long, ByVal szReadeName As String, ByVal szDeviceName As String) As Long
    
Public Declare Function SCardForgetReaderA Lib "winscard.dll" (ByVal hContext As Long, ByVal szReaderName As String) As Long
    
Public Declare Function SCardAddReaderToGroupA Lib "winscard.dll" (ByVal hContext As Long, ByVal szReaderName As String, ByVal szGroupName As String) As Long
    
Public Declare Function SCardRemoveReaderFromGroupA Lib "winscard.dll" (ByVal hContext As Long, ByVal szReaderName As String, ByVal szGroupName As String) As Long
    
Public Declare Function SCardIntroduceCardTypeA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCardName As String, ByRef pguidPrimaryProvider As GUID, ByRef pguidInterfaces As GUID, ByVal dwInterfaceCount As Long, ByVal pbAtr As String, ByVal pbAtrMask As String, ByVal cbAtrLen As Long) As Long

Public Declare Function SCardSetCardTypeProviderNameA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCardName As String, ByVal dwProviderId As Long, ByVal szProvider As String) As Long

Public Declare Function SCardForgetCardTypeA Lib "winscard.dll" (ByVal hContext As Long, ByVal szCardName As String) As Long
    
Public Declare Function SCardLocateCardsA Lib "winscard.dll" (ByVal hContext As Long, ByVal mszCards As String, ByRef rgReaderStates As SCARD_READERSTATEA, ByVal cReaders As Long) As Long

Public Declare Function SCardGetStatusChangeA Lib "winscard.dll" (ByVal hContext As Long, ByVal dwTimeout As Long, ByRef rgReaderStates As SCARD_READERSTATEA, ByVal cReaders As Long) As Long
 
Public Declare Function SCardConnectA Lib "winscard.dll" (ByVal hContext As Long, ByVal szReader As String, ByVal dwShareMode As Long, ByVal dwPreferredProtocols As Long, ByRef phCard As Long, ByRef pdwActiveProtocol As Long) As Long
    
Public Declare Function SCardStatusA Lib "winscard.dll" (ByVal hCard As Long, ByVal mszReaderNames As String, ByRef pcchReaderLen As Long, ByRef pdwState As Long, ByRef pdwProtocol As Long, ByRef pbAtr As Byte, ByRef pcbAtrLen As Long) As Long
    

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Helper Defines

' Null value suitable for passing in as parameter
Public Const lngNull As Long = 0

' GUID data type
Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

' flags for API error message reporting
Enum EFORMAT_MESSAGE
    FORMAT_MESSAGE_NONE = &H0
    FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
    FORMAT_MESSAGE_IGNORE_INSERTS = &H200
    FORMAT_MESSAGE_FROM_STRING = &H400
    FORMAT_MESSAGE_FROM_HMODULE = &H800
    FORMAT_MESSAGE_FROM_SYSTEM = &H1000
    FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
    FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
End Enum


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Helper Functions

' pull an error message from a system image
Public Declare Function FormatMessageA Lib "kernel32" (ByVal dwFlags As Long, ByVal lpSources As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByVal Arguments As Long) As Long

' ApiErrorMessage
'
' returns the message associated with an error code
'
' assumptions:
'
'   error code is a system error
'
' arguments:
'
'   lngError - supplies the error code
'
' return value:
'
'   string - contains the system message of the error, or
'            the empty string if no message could be found
'
Public Function ApiErrorMessage(ByVal lngError As Long) As String
    ' length of message
    Dim lngMessageLen   As Long
    ' message holder
    Dim strMessage      As String
    ' initialize message holder
    strMessage = String(256, vbNullChar)
    
    ' look up error from system
    lngMessageLen = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, lngNull, lngError, 0&, strMessage, Len(strMessage), lngNull)
                      
    If lngMessageLen Then
        ' truncate message to reported length, less c-style null terminator
        ApiErrorMessage = Left$(strMessage, lngMessageLen - 1)
    Else
        ' return empty string
        ApiErrorMessage = ""
    End If
End Function


' ParseMultistring
'
' converts C++ type multistring to VB type array of strings
' and reports the number of strings in array
'
' assumptions:
'
'   first parameter actually contains a good format multistring
'   no checking is done for bad format, empty string, or null pointer
'
' arguments:
'
'   strMultistring - supplies the multistring to be converted,
'       whose format is concatenated null terminated strings, with an
'       additional null terminator at the end of the last string
'
'   intReaderCount - returns the number of strings in the array
'       note that an array with 4 strings will have indexes 0 to 3
'
' return value:
'
'   an array of strings - can contain one empty element if no readers found
'   indirectly through second parameter, the count of strings in the array
'
Public Function ParseMultistring(ByRef strMultistring As String, ByRef intReaderCount As Integer) As Variant
    
    ' string parsed out from multistring
    Dim strCurrent As String
    ' copy of multistring, so that calling program still has a good copy
    Dim strWorking As String
    ' reader names in array of strings
    Dim arrReaderNames() As String
    ' position of first null terminator within the multistring
    Dim lngNullPosition As Long
    
    ' initialize current string to empty
    strCurrent = ""
    ' make a copy of the input multistring
    strWorking = strMultistring
    ' set count of readers to zero
    intReaderCount = 0
    ' get position of first null terminator
    lngNullPosition = InStr(strWorking, vbNullChar)
    
    ' when all strings and their individual null terminators have been
    ' parsed out of the multistring, only the final null terminator will remain
    While (lngNullPosition > 1)
        ' resize the array to add another element, preserving old elements
        ReDim Preserve arrReaderNames(intReaderCount)
        ' parse out the first string in the multistring
    strCurrent = Left(strWorking, lngNullPosition - 1)
        ' copy this string into the array
        arrReaderNames(intReaderCount) = strCurrent
        ' delete this string from the multistring
        strWorking = Right(strWorking, Len(strWorking) - (lngNullPosition + 1) + 1)
        ' get position of the first null terminator
        lngNullPosition = InStr(strWorking, vbNullChar)
        ' increase the string count by one for the string just parsed
        intReaderCount = intReaderCount + 1
    Wend
    
    ' return the completed array
    ParseMultistring = arrReaderNames
    
End Function ' ParseMultistring