scardapi.bas

IC卡讀取系統原始程式

    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
    
Public Declare Function des _
Lib "des.dll" _
( _
    ByVal mflag As Long, _
    ByRef Key As Byte, _
    ByRef Data As Byte, _
    ByRef edata As Byte _
    ) As Long


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

' Null value suitable for passing in as parameter


' 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



'add by tarzan
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2



' 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