VERSION 5.00 Begin VB.Form Form1 Caption = "PC/SC API Test" ClientHeight = 7560 ClientLeft = 60 ClientTop = 450 ClientWidth = 8145 Icon = "Form1.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7560 ScaleWidth = 8145 StartUpPosition = 2 'CenterScreen Begin VB.TextBox txtCardData Height = 1815 Left = 240 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 6 Top = 4560 Width = 7575 End Begin VB.CommandButton btnReadCard Caption = "SCardTransmit()" Height = 615 Left = 240 TabIndex = 5 Top = 3840 Width = 2655 End Begin VB.TextBox txtCardAttributes Height = 1815 Left = 240 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 4 Top = 1800 Width = 7575 End Begin VB.CommandButton btnGetCardAttributes Caption = "Get Card Attributes" Height = 615 Left = 240 TabIndex = 3 Top = 1080 Width = 2655 End Begin VB.ComboBox cmbReaderList Height = 315 ItemData = "Form1.frx":0442 Left = 960 List = "Form1.frx":0444 Locked = -1 'True TabIndex = 1 Top = 525 Width = 6495 End Begin VB.CommandButton btnExit Caption = "E&xit" Default = -1 'True Height = 735 Left = 2032 TabIndex = 0 Top = 6600 Width = 4080 End Begin VB.Label lblSelectReader AutoSize = -1 'True Caption = "Select a card reader:" Height = 195 Left = 960 TabIndex = 2 Top = 240 Width = 1485 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private context_handle As Long Private card_handle As Long Private currently_active_protocol As Long Private reader_is_connected As Boolean Private current_reader_name As String Private SCARD_PCI_T0 As SCARD_IO_REQUEST Private SCARD_PCI_T1 As SCARD_IO_REQUEST Private SCARD_PCI_RAW As SCARD_IO_REQUEST Private Sub btnReadCard_Click() If (reader_is_connected = True) And (card_handle <> 0) Then Dim scard_begin_transaction_result As Long scard_begin_transaction_result = SCardBeginTransaction(card_handle) If scard_begin_transaction_result = SCARD_S_SUCCESS Then 'SCardTransmit 'http://msdn.microsoft.com/en-us/library/aa379804.aspx Dim scard_end_transaction_result As Long Dim scard_transmit_result As Long Dim send_length As Long Dim receive_length As Long Dim send_pci As SCARD_IO_REQUEST Dim recv_pci As SCARD_IO_REQUEST 'CLA INS P1 P2 [Lc field] [Data field] [Le field] 'Lc is the number of bytes in the data field. 'Le is the maximum number of bytes expected in the data field of the response. 'When Le is 0 the maximum number of available data bytes is requested. '---------------- 'CLA Codes '---------------- 'Hex Description '---------------- '0X Structure and coding of command and response according to this part of ISO/IEC 7816 '10 to 7F RFU '8X, 9X Structure of command and response according to this part of ISO/IEC 7816 'AX Unless otherwise specified by the application context, structure and coding of command and response according to this part of ISO/IEC 7816 'B0 to CF Structure of command and response according to this part of ISO/IEC 7816 'D0 to FE Proprietary structure and coding of command and response 'FF Reserved for PTS '---------------- 'INS Codes '---------------- 'Hex Description '---------------- '0E ERASE BINARY '20 VERIFY '70 MANAGE CHANNEL '82 EXTERNAL AUTHENTICATE '84 GET CHALLENGE '88 INTERNAL AUTHENTICATE 'A4 SELECT FILE 'B0 READ BINARY 'B2 READ RECORD(S) 'C0 GET RESPONSE 'C2 ENVELOPE 'CA GET DATA 'D0 WRITE BINARY 'D2 WRITE RECORD 'D6 UPDATE BINARY 'DA PUT DATA 'DC UPDATE DATA 'E2 APPEND RECORD '---------------- Dim send_bytes(0 To 4) As Byte Dim receive_bytes(0 To 257) As Byte 'SCARD_PROTOCOL_T0 'SCARD_PROTOCOL_T1 'SCARD_PROTOCOL_RAW send_pci.dwProtocol = SCARD_PROTOCOL_T0 send_pci.dbPciLength = Len(send_pci) recv_pci.dwProtocol = SCARD_PROTOCOL_T0 recv_pci.dbPciLength = Len(recv_pci) '5 (0x05): SCARD_E_COMM_DATA_LOST '7 (0x07): SCARD_E_COMM_DATA_LOST '14 (0x0E): SCARD_E_COMM_DATA_LOST '18 (0x12): SCARD_E_COMM_DATA_LOST send_bytes(0) = &H0 'CLA - the instruction class send_bytes(1) = &HA4 'INS - the instruction code send_bytes(2) = &H0 'P1 - parameter to the instruction send_bytes(3) = &H0 'P2 - parameter to the instruction send_bytes(4) = &H0 'Lc - Number of bytes present in the Data Field 'send_bytes(5) = &H3F 'Data - Data Field 'send_bytes(6) = &H0 'Le - Maximum number of bytes expected in the response 'For T=0, in the special case where no data is sent to the card and no data 'expected in return, this length must reflect that the bP3 member is not being 'sent; the length should be 4. send_length = UBound(send_bytes) - LBound(send_bytes) + 1 receive_length = UBound(receive_bytes) - LBound(receive_bytes) + 1 'The parameter bytes P1-P2 of a command may have any value. If a parameter byte 'provides no further qualification, then it shall be set to '00'. 'Lc field Length Number of bytes present in the data field of the command 'Data field Data String of bytes sent in the data field of the command 'Le field Length Maximum number of bytes expected in the data field of the response to the command 'Case 1: Command with no incoming or outgoing data byte: CLA INS P1 P2 'Case 2: Command with outgoing data bytes: CLA INS P1 P2 Le 'Case 3: Command with incoming data bytes: CLA INS P1 P2 Lc [Data bytes] 'An incoming order with no data byte « CLA INS P1 P2 00 » should be sent to the 'card as TPDU through a case 1 APDU. 'hCard - A reference value returned from the SCardConnect function. 'pioSendPci - A pointer to the protocol header structure for the instruction. 'This buffer is in the format of an SCARD_IO_REQUEST structure, followed by the 'specific protocol control information (PCI). 'pbSendBuffer - A pointer to the actual data to be written to the card. 'cbSendLength - The length, in bytes, of the pbSendBuffer parameter. scard_transmit_result = SCardTransmitLong(card_handle, send_pci, send_bytes(0), send_length, 0&, receive_bytes(0), receive_length) If scard_transmit_result = SCARD_S_SUCCESS Then txtCardData.Text = txtCardData.Text & "Received Protocol: " & recv_pci.dwProtocol & vbNewLine txtCardData.Text = txtCardData.Text & "Received Protocol Length: " & recv_pci.dbPciLength & vbNewLine txtCardData.Text = txtCardData.Text & "Receive Buffer: " & vbNewLine Dim i As Integer For i = 0 To (receive_length - 1) 'If (receive_bytes(i) < 16) Then ' txtCardData.Text = txtCardData.Text & "0" 'End If txtCardData.Text = txtCardData.Text & CStr(receive_bytes(i)) & " " Next 'SW1 SW2 'The status values returned from command execution in SW1-SW2 can be 'interpreted according to the following: 'Code Meaning '90 00 No further qualification - command successful '61 xx SW2 indicates the number of response bytes still available. Use GET RESPONSE to access this data. '62 xx Warning - state unchanged '62 00 Warning - no information provided '62 81 Warning - part of returned data may be corrupt '62 82 Warning - end of file/record reached (bad cmd) '62 83 Warning - selected file invalidated '62 84 Warning - bad file control information format '63 xx Warning - state unchanged '63 00 Warning - no information provided '63 81 Warning - file filled up with last write '63 Cx Warning - counter value is x '64 xx Error - state unchanged '65 xx Error - state changed '65 00 Error - no information provided '65 81 Error - memory failure '66 xx Security Error '67 00 Check Error - wrong length '68 xx Check Error - CLA function not supported '68 00 Check Error - no information provided '68 81 Check Error - logical channel not supported '68 82 Check Error - secure messaging not supported '69 xx Check Error - command not allowed '69 00 Check Error - no information provided '69 81 Check Error - command incompatible with file structure '69 82 Check Error - security status not satisfied '69 83 Check Error - authentication method blocked '69 84 Check Error - referenced data invalidated '69 85 Check Error - conditions of use not satisfied '69 86 Check Error - command not allowed (no current EF) '69 87 Check Error - expected SM data objects missing '69 88 Check Error - SM data objects incorrect '6A xx Check Error - wrong parameters '6A 00 Check Error - no information provided '6A 80 Check Error - incorrect parameters in data field '6A 81 Check Error - function not supported '6A 82 Check Error - file not found '6A 83 Check Error - record not found '6A 84 Check Error - not enough memory space in the file '6A 85 Check Error - Lc inconsistant with TLV structure '6A 86 Check Error - inconsistant parameters P1-P2 '6A 87 Check Error - Lc inconsistant with P1-P2 '6A 88 Check Error - referenced data not found '6B 00 Check Error - wrong parameters '6C xx Check Error - wrong length - xx is the correct length '6D 00 Check Error - instruction code not supported or invalid '6E 00 Check Error - Class not supported '6F 00 Check Error - no precise diagnosis txtCardData.SetFocus Else Call print_winscard_error("SCardTransmit", scard_transmit_result) End If scard_end_transaction_result = SCardEndTransaction(card_handle, SCARD_LEAVE_CARD) If scard_end_transaction_result <> SCARD_S_SUCCESS Then Call print_winscard_error("SCardEndTransaction", scard_end_transaction_result) End If Else Call print_winscard_error("SCardBeginTransaction", scard_begin_transaction_result) End If Else MsgBox "There is no card in the reader.", vbInformation + vbOKOnly, "Read Card Data" End If End Sub Private Sub btnGetCardAttributes_Click() If (reader_is_connected = True) And (card_handle <> 0) Then Dim attribute_list(0 To 31) As SCARD_ATTRIBUTE 'Answer to reset (ATR) string 'TS (Initial Character, mandatory) ' 0x3B = Direct Convention (0011 1011) ' 0x3F = Inverse Convention (0011 1111) 'T0 (Format Character, mandatory) ' The Format Character tells how many bytes will follow for interface characters ' and for historical characters. ' The T0 character contains two parts: ' - The most significant half byte (b5,b6,b7,b8) is named Y1 and indicates with a logic level ONE the presence of subsequent characters TA1, TB1, TC1, TD1 respectively. ' - The least significant half byte (b4 to b1) is named K and indicates the number (0 to 15) of historical characters. attribute_list(0).id = SCARD_ATTR_ATR_STRING attribute_list(0).name = "Answer to reset (ATR) string: " attribute_list(0).display_mode = SHOW_AS_HEX 'Channel ID attribute_list(1).id = SCARD_ATTR_CHANNEL_ID attribute_list(1).name = "Channel ID: " attribute_list(1).display_mode = SHOW_AS_CHANNEL_ID 'Mechanical Characteristics attribute_list(2).id = SCARD_ATTR_CHARACTERISTICS attribute_list(2).name = "Mechanical Characteristics: " attribute_list(2).display_mode = SHOW_AS_MECH 'Current block waiting time attribute_list(3).id = SCARD_ATTR_CURRENT_BWT attribute_list(3).name = "Current block waiting time (BWT): " attribute_list(3).display_mode = SHOW_AS_LONG 'Current clock rate (kHz) attribute_list(4).id = SCARD_ATTR_CURRENT_CLK attribute_list(4).name = "Current clock rate (kHz): " attribute_list(4).display_mode = SHOW_AS_LONG 'Current character waiting time attribute_list(5).id = SCARD_ATTR_CURRENT_CWT attribute_list(5).name = "Current character waiting time (CWT): " attribute_list(5).display_mode = SHOW_AS_LONG 'Bit rate conversion factor attribute_list(6).id = SCARD_ATTR_CURRENT_D attribute_list(6).name = "Bit rate conversion factor (D): " attribute_list(6).display_mode = SHOW_AS_LONG 'Current error block control encoding. ' 0 = longitudinal redundancy check (LRC) ' 1 = cyclical redundancy check (CRC) attribute_list(7).id = SCARD_ATTR_CURRENT_EBC_ENCODING attribute_list(7).name = "Current error block control encoding: " attribute_list(7).display_mode = SHOW_AS_ERROR_ENCODING 'Clock conversion factor attribute_list(8).id = SCARD_ATTR_CURRENT_F attribute_list(8).name = "Clock conversion factor (F): " attribute_list(8).display_mode = SHOW_AS_LONG 'Current Information Field Size (card) attribute_list(9).id = SCARD_ATTR_CURRENT_IFSC attribute_list(9).name = "Current Information Field Size (in bytes) (card): " attribute_list(9).display_mode = SHOW_AS_LONG 'Current Information Field Size (device) attribute_list(10).id = SCARD_ATTR_CURRENT_IFSD attribute_list(10).name = "Current Information Field Size (in bytes) (device): " attribute_list(10).display_mode = SHOW_AS_LONG 'Current guard time attribute_list(11).id = SCARD_ATTR_CURRENT_N attribute_list(11).name = "Current guard time (N): " attribute_list(11).display_mode = SHOW_AS_LONG 'Current Protocol Type 'DWORD encoded as 0x0rrrpppp where rrr is RFU and should be 0x000. 'pppp encodes the current protocol type. 'Whichever bit has been set indicates which ISO protocol is currently in use. 'For example, if bit zero is set, T=0 protocol is in effect. attribute_list(12).id = SCARD_ATTR_CURRENT_PROTOCOL_TYPE attribute_list(12).name = "Current Protocol Type: " attribute_list(12).display_mode = SHOW_AS_CURRENT_PROTOCOL 'Current work waiting time attribute_list(13).id = SCARD_ATTR_CURRENT_W attribute_list(13).name = "Current work waiting time: " attribute_list(13).display_mode = SHOW_AS_LONG 'Default clock rate (kHz) attribute_list(14).id = SCARD_ATTR_DEFAULT_CLK attribute_list(14).name = "Default clock rate (kHz): " attribute_list(14).display_mode = SHOW_AS_LONG 'Default data rate (bps) attribute_list(15).id = SCARD_ATTR_DEFAULT_DATA_RATE attribute_list(15).name = "Default data rate (bps): " attribute_list(15).display_mode = SHOW_AS_LONG 'Reader's display name attribute_list(16).id = SCARD_ATTR_DEVICE_FRIENDLY_NAME attribute_list(16).name = "Reader's display name: " attribute_list(16).display_mode = SHOW_AS_CHARS 'Device in use (Reserved for future use) attribute_list(17).id = SCARD_ATTR_DEVICE_IN_USE attribute_list(17).name = "Device in use (Reserved for future use): " attribute_list(17).display_mode = SHOW_AS_LONG 'Reader's system name attribute_list(18).id = SCARD_ATTR_DEVICE_SYSTEM_NAME attribute_list(18).name = "Reader's system name: " attribute_list(18).display_mode = SHOW_AS_CHARS 'Instance of this vendor's reader attached to the computer. 'The first instance will be device unit 0, the next will be unit 1 (if it is the 'same brand of reader) and so on. Two different brands of readers will both have 'zero for this value. attribute_list(19).id = SCARD_ATTR_DEVICE_UNIT attribute_list(19).name = "Instance of this vendor's reader attached to the computer: " attribute_list(19).display_mode = SHOW_AS_LONG 'Interface Status 'Single byte. 'Zero if smart card electrical contact is not active. 'Nonzero if contact is active. attribute_list(20).id = SCARD_ATTR_ICC_INTERFACE_STATUS attribute_list(20).name = "Smart Card Electrical Contact Active: " attribute_list(20).display_mode = SHOW_AS_YES_NO 'Smart Card Presence '0 = not present '1 = card present but not swallowed (applies only if reader supports smart card swallowing) '2 = card present (and swallowed if reader supports smart card swallowing) '4 = card confiscated attribute_list(21).id = SCARD_ATTR_ICC_PRESENCE attribute_list(21).name = "Smart Card Presence: " attribute_list(21).display_mode = SHOW_AS_CARD_PRESENCE 'Smart Card Type: '0 = unknown type '1 = 7816 Asynchronous '2 = 7816 Synchronous 'Other values RFU. attribute_list(22).id = SCARD_ATTR_ICC_TYPE_PER_ATR attribute_list(22).name = "Smart Card Type: " attribute_list(22).display_mode = SHOW_AS_CARD_TYPE 'Maximum clock rate (kHz) attribute_list(23).id = SCARD_ATTR_MAX_CLK attribute_list(23).name = "Maximum clock rate (kHz): " attribute_list(23).display_mode = SHOW_AS_LONG 'Maximum data rate (bps) attribute_list(24).id = SCARD_ATTR_MAX_DATA_RATE attribute_list(24).name = "Maximum data rate (bps): " attribute_list(24).display_mode = SHOW_AS_LONG 'Maximum bytes for information file size device attribute_list(25).id = SCARD_ATTR_MAX_IFSD attribute_list(25).name = "Maximum bytes for information file size device: " attribute_list(25).display_mode = SHOW_AS_LONG 'Power Management Support 'Zero if device does not support power down while smart card is inserted. 'Nonzero otherwise. attribute_list(26).id = SCARD_ATTR_POWER_MGMT_SUPPORT attribute_list(26).name = "Supports power down while smart card is inserted: " attribute_list(26).display_mode = SHOW_AS_YES_NO 'Supported Protocol Types 'DWORD encoded as 0x 0r rr pp pp where rrr is RFU and should be 0x000. 'pppp encodes the supported protocol types. 'A '1' in a given bit position indicates support for the associated ISO protocol, 'so if bits zero and one are set, both T=0 and T=1 protocols are supported. attribute_list(27).id = SCARD_ATTR_PROTOCOL_TYPES attribute_list(27).name = "Supported Protocol Types: " attribute_list(27).display_mode = SHOW_AS_PROTOCOL_TYPES 'Serial Number attribute_list(28).id = SCARD_ATTR_VENDOR_IFD_SERIAL_NO attribute_list(28).name = "Vendor-supplied interface device serial number: " attribute_list(28).display_mode = SHOW_ACTUAL_BYTES 'Interface Device Type attribute_list(29).id = SCARD_ATTR_VENDOR_IFD_TYPE attribute_list(29).name = "Vendor-supplied interface device type (model designation of reader): " attribute_list(29).display_mode = SHOW_AS_CHARS 'Vendor-supplied interface device version 'DWORD in the form 0x MMmm bbbb 'MM = major version 'mm = minor version 'bbbb = build number attribute_list(30).id = SCARD_ATTR_VENDOR_IFD_VERSION attribute_list(30).name = "Vendor-supplied interface device version: " attribute_list(30).display_mode = SHOW_AS_IFD_VERSION 'Vendor Name attribute_list(31).id = SCARD_ATTR_VENDOR_NAME attribute_list(31).name = "Vendor name: " attribute_list(31).display_mode = SHOW_AS_CHARS 'The SCardGetAttrib() function gets the current reader attributes for the given 'handle. It does not affect the state of the reader, driver, or card. ' hCard = Reference value returned from SCardConnect. ' dwAttrId = Identifier for the attribute to get. ' pbAttr = Pointer to a buffer that receives the attribute whose ID is supplied in ' dwAttrId. If this value is NULL, SCardGetAttrib ignores the buffer length supplied ' in pcbAttrLen, writes the length of the buffer that would have been returned if ' this parameter had not been NULL to pcbAttrLen, and returns a success code. ' pcbAttrLen = Length of the pbAttr buffer in bytes, and receives the actual length ' of the received attribute. If the buffer length is specified as SCARD_AUTOALLOCATE, ' then pbAttr is converted to a pointer to a byte pointer, and receives the address ' of a block of memory containing the attribute. This block of memory must be ' deallocated with SCardFreeMemory. Dim attribute_byte_array As ByteArray Dim attribute_length As Long Dim get_attribute_result As Long Dim big_string As String Dim show_spaces As Boolean Dim i As Integer For i = LBound(attribute_list) To UBound(attribute_list) If attribute_list(i).display_mode = SHOW_AS_HEX Then show_spaces = True Else show_spaces = False End If attribute_length = DEFAULT_BUFFER_SIZE get_attribute_result = SCardGetAttrib(card_handle, attribute_list(i).id, attribute_byte_array, attribute_length) If get_attribute_result = SCARD_S_SUCCESS Then big_string = big_string & attribute_list(i).name & show_byte_array_as(attribute_byte_array, attribute_length, attribute_list(i).display_mode, show_spaces) & vbNewLine Else big_string = big_string & attribute_list(i).name & print_winscard_error("SCardGetAttrib", get_attribute_result, True) & vbNewLine End If Next 'SCardStatus big_string = big_string & "--------------------------" & vbNewLine big_string = big_string & "CARD STATUS" & vbNewLine big_string = big_string & "--------------------------" & vbNewLine Dim scard_status_result As Long Dim readers_display_names As String Dim readers_display_names_length As Long Dim card_state As Long Dim card_protocol As Long Dim atr_string_byte_array As ByteArray Dim atr_string_byte_array_length As Long readers_display_names_length = DEFAULT_BUFFER_SIZE atr_string_byte_array_length = DEFAULT_BUFFER_SIZE readers_display_names = String(readers_display_names_length, vbNullChar) scard_status_result = SCardStatus(card_handle, readers_display_names, readers_display_names_length, card_state, card_protocol, atr_string_byte_array, atr_string_byte_array_length) If scard_status_result = SCARD_S_SUCCESS Then 'Display Reader Name readers_display_names = Mid$(readers_display_names, 1, readers_display_names_length - 2) readers_display_names = Replace$(readers_display_names, vbNullChar, vbNewLine) big_string = big_string & "Reader Name: " & readers_display_names & vbNewLine 'Display Card State Select Case card_state Case SCARD_ABSENT big_string = big_string & "Card State: There is no card in the reader." & vbNewLine Case SCARD_PRESENT big_string = big_string & "Card State: There is a card in the reader, but it has not been moved into position for use." & vbNewLine Case SCARD_SWALLOWED big_string = big_string & "Card State: There is a card in the reader in position for use. The card is not powered." & vbNewLine Case SCARD_POWERED big_string = big_string & "Card State: Power is being provided to the card, but the reader driver is unaware of the mode of the card." & vbNewLine Case SCARD_NEGOTIABLE big_string = big_string & "Card State: The card has been reset and is awaiting PTS negotiation." & vbNewLine Case SCARD_SPECIFIC big_string = big_string & "Card State: The card has been reset and specific communication protocols have been established." & vbNewLine Case Else big_string = big_string & "Card State: Unknown (" & card_state & ")" & vbNewLine End Select 'Display Card Protocol Select Case card_protocol Case SCARD_PROTOCOL_DEFAULT big_string = big_string & "Card Protocol: Default." & vbNewLine Case SCARD_PROTOCOL_RAW big_string = big_string & "Card Protocol: The Raw Transfer protocol is in use." & vbNewLine Case SCARD_PROTOCOL_T0 big_string = big_string & "Card Protocol: The ISO 7816/3 T=0 protocol is in use." & vbNewLine Case SCARD_PROTOCOL_T1 big_string = big_string & "Card Protocol: The ISO 7816/3 T=1 protocol is in use." & vbNewLine Case SCARD_PROTOCOL_UNDEFINED big_string = big_string & "Card Protocol: Undefined." & vbNewLine Case Else big_string = big_string & "Card Protocol: Unknown (" & card_protocol & ")" & vbNewLine End Select 'Display ATR big_string = big_string & "ATR (Answer to Reset): " & show_byte_array_as(atr_string_byte_array, atr_string_byte_array_length, SHOW_AS_HEX, True) & vbNewLine Else Call print_winscard_error("SCardStatus", scard_status_result) End If txtCardAttributes.Text = big_string txtCardAttributes.SetFocus Else MsgBox "There is no card in the reader.", vbInformation + vbOKOnly, "Get Card Attributes" End If 'End If (card_handle <> 0) End Sub Private Sub btnExit_Click() Unload Me End Sub Public Sub LoadReaderListInDropDown(ByVal ReaderList As String) Dim one_reader_name As String Dim i As Integer i = 1 cmbReaderList.Clear While (Mid(ReaderList, i, 1) <> vbNullChar) While (Mid(ReaderList, i, 1) <> vbNullChar) one_reader_name = one_reader_name + Mid(ReaderList, i, 1) i = i + 1 Wend i = i + 1 cmbReaderList.AddItem one_reader_name one_reader_name = "" Wend End Sub Private Sub cmbReaderList_Change() current_reader_name = cmbReaderList.Text End Sub Private Sub Form_Load() 'The SCardEstablishContext() function establishes the resource manager context '(the scope) within which database operations are performed. 'dwScope = Scope of the resource manager context '(SCARD_SCOPE_USER or SCARD_SCOPE_SYSTEM) 'pvReserved1 = Reserved for future use and must be NULL. 'pvReserved2 = Reserved for future use and must be NULL. 'phContext = A handle to the established resource manager context. This handle can 'now be supplied to other functions attempting to do work within this context. 'The SCardListReaders() function provides the list of readers within a set of named 'reader groups, eliminating duplicates. The caller supplies a list of reader groups, 'and receives the list of readers within the named groups. Unrecognized group names 'are ignored. 'hContext = Handle that identifies the resource manager context for the query. 'mzGroup = Names of the reader groups defined to the system, as a multi-string. Use 'a NULL value to list all readers in the system (that is, the SCard$AllReaders group). 'ReaderList = Multi-string that lists the card readers within the supplied reader 'groups. If this value is NULL, SCardListReaders ignores the buffer length supplied 'in pcchReaders, writes the length of the buffer that would have been returned if 'this parameter had not been NULL to pcchReaders, and returns a success code. 'pcchReaders = Length of the ReaderList buffer in characters. This parameter receives 'the actual length of the multi-string structure, including all trailing null 'characters. If the buffer length is specified as SCARD_AUTOALLOCATE, then 'ReaderList is converted to a pointer to a byte pointer, and receives the 'address of a block of memory containing the multi-string structure. This block 'of memory must be deallocated with SCardFreeMemory. SCARD_PCI_T0.dwProtocol = SCARD_PROTOCOL_T0 SCARD_PCI_T0.dbPciLength = Len(SCARD_PCI_T0) SCARD_PCI_T1.dwProtocol = SCARD_PROTOCOL_T1 SCARD_PCI_T1.dbPciLength = Len(SCARD_PCI_T1) SCARD_PCI_RAW.dwProtocol = SCARD_PROTOCOL_RAW SCARD_PCI_RAW.dbPciLength = Len(SCARD_PCI_RAW) Dim establish_context_result As Long establish_context_result = SCardEstablishContext(SCARD_SCOPE_SYSTEM, 0&, 0&, context_handle) If establish_context_result = SCARD_S_SUCCESS Then Dim buffer_size As Long Dim all_readers_string As String Dim list_readers_result As Long buffer_size = DEFAULT_BUFFER_SIZE all_readers_string = String(buffer_size, vbNullChar) list_readers_result = SCardListReaders(context_handle, vbNullString, all_readers_string, buffer_size) If list_readers_result = SCARD_S_SUCCESS Then Call LoadReaderListInDropDown(all_readers_string) If cmbReaderList.ListCount > 0 Then cmbReaderList.ListIndex = 0 current_reader_name = cmbReaderList.Text reader_is_connected = True Call connect_to_card End If Else Call print_winscard_error("SCardListReaders", list_readers_result) Unload Me End If Else Call print_winscard_error("SCardEstablishContext", establish_context_result) Unload Me End If End Sub Private Function connect_to_card() As Boolean 'A flag that indicates whether other applications may form connections to the card. 'SCARD_SHARE_EXCLUSIVE = 1 (This application IS NOT willing to share this card with other applications.) 'SCARD_SHARE_SHARED = 2 (This application IS willing to share this card with other applications.) 'SCARD_SHARE_DIRECT = 3 (This application demands direct control of the reader, so it is not available to other applications.) 'A bitmask of acceptable protocols for the connection (may be combined with OR). 'SCARD_PROTOCOL_T0 = 1 (T=0 is an acceptable protocol) 'SCARD_PROTOCOL_T1 = 2 (T=1 is an acceptable protocol) '0 (This parameter may be zero only if share_mode is set to SCARD_SHARE_DIRECT. 'In this case, no protocol negotiation will be performed by the drivers until an 'IOCTL_SMARTCARD_SET_PROTOCOL control directive is sent with SCardControl. If (reader_is_connected = True) And (context_handle <> 0) Then card_handle = 0 'reset to 0, SCardConnect() will update this value currently_active_protocol = 0 'reset to 0, SCardConnect() will update this value Dim connect_to_card_result As Long connect_to_card_result = SCardConnect(context_handle, current_reader_name, _ SCARD_SHARE_EXCLUSIVE, SCARD_PROTOCOL_T0 Or SCARD_PROTOCOL_T1, card_handle, currently_active_protocol) If connect_to_card_result <> SCARD_S_SUCCESS Then Call print_winscard_error("SCardConnect", connect_to_card_result) connect_to_card = False Else connect_to_card = True 'Dim scard_control_result As Long 'Dim scard_control_in_buffer As Long 'Dim scard_control_out_buffer As Long 'Dim scard_control_in_buffer_size As Long 'Dim scard_control_out_buffer_size As Long 'Dim scard_control_bytes_returned As Long 'scard_control_in_buffer_size = 4 'scard_control_out_buffer_size = 4 'scard_control_in_buffer = SCARD_PROTOCOL_RAW 'scard_control_result = SCardControl(card_handle, IOCTL_SMARTCARD_SET_PROTOCOL, scard_control_in_buffer, scard_control_in_buffer_size, scard_control_out_buffer, scard_control_out_buffer_size, scard_control_bytes_returned) 'If scard_control_result <> SCARD_S_SUCCESS Then ' Call print_winscard_error("SCardControl", scard_control_result) 'End If End If End If End Function Private Sub disconnect_from_card() 'The SCardDisconnect() function terminates a connection previously opened between 'the calling application and a smart card in the target reader. 'hCard = Reference value obtained from a previous call to SCardConnect. 'dwDisposition = Action to take on the card in the connected reader on close. ' SCARD_LEAVE_CARD = 0 (Don't do anything special) ' SCARD_RESET_CARD = 1 (Reset the card, Warm Reset) ' SCARD_UNPOWER_CARD = 2 (Power down the card and reset it, Cold Reset) ' SCARD_EJECT_CARD = 3 (Eject the card) If card_handle <> 0 Then Dim disconnect_from_card_result As Long disconnect_from_card_result = SCardDisconnect(card_handle, SCARD_RESET_CARD) card_handle = 0 'reset card_handle to 0 If disconnect_from_card_result <> SCARD_S_SUCCESS Then Call print_winscard_error("SCardDisconnect", disconnect_from_card_result) End If End If End Sub Private Sub Form_Terminate() 'Form Lifecycle 'Initialize > Load > Resize > Activate > Paint > Queryunload > Unload > Terminate 'The SCardReleaseContext() function closes an established resource manager context, 'freeing any resources allocated under that context, including SCARDHANDLE objects 'and memory allocated using the SCARD_AUTOALLOCATE length designator. 'The SCardCancel() function terminates all outstanding actions within a specific 'resource manager context. The only requests that you can cancel are those that 'require waiting for external action by the smart card or user. Any such outstanding 'action requests will terminate with a status indication that the action was 'canceled. This is especially useful to force outstanding SCardGetStatusChange calls 'to terminate. Dim scard_cancel_result As Long scard_cancel_result = SCardCancel(context_handle) Call disconnect_from_card If context_handle <> 0 Then Dim release_context_result As Long release_context_result = SCardReleaseContext(context_handle) context_handle = 0 If release_context_result <> SCARD_S_SUCCESS Then Call print_winscard_error("SCardReleaseContext", release_context_result) End If End If End Sub