Salve a tutti.
Premetto che ho poca esperienza di programmazione, ma con tutto ciò non mi tiro mai indietro davanti alle difficoltà.
Da qualche tempo mi sono imbattuto nella lettura della mia tessera sanitaria, e dopo parecchie righe di codice con scarso risultato volevo fare un consulto nel forum per capire dove sto sbagliando. Ringrazio chiunque potesse aiutarmi e di seguito posto il codice :
Public Type SCARD_IO_REQUEST
dwProtocol As Long
dbPciLength As Long
End Type
Public Type APDURec
bCLA As Byte
bINS As Byte
bP1 As Byte
bP2 As Byte
bP3 As Byte
DATA(1 To 255) As Byte
DataIn(1 To 255) As Byte
DataOut(1 To 255) As Byte
SW(1 To 2) As Byte
IsSend As Boolean
End Type
Public Type SCARD_READERSTATE
RdrName As String
UserData As Long
RdrCurrState As Long
RdrEventState As Long
ATRLength As Long
ATRValue(1 To 36) As Byte
End Type
Public Declare Function SCardEstablishContext Lib "winscard.dll" (ByVal dwScope As Long, _
ByVal pvReserved1 As Long, _
ByVal pvReserved2 As Long, _
ByRef hContext As Long) As Long
Public Declare Function SCardReleaseContext Lib "winscard.dll" (ByVal hContext As Long) As Long
Public Declare Function SCardConnect Lib "winscard.dll" Alias "SCardConnectA" (ByVal hContext As Long, _
ByVal szReaderName As String, _
ByVal dwShareMode As Long, _
ByVal dwPrefProtocol As Long, _
ByRef hCard As Long, _
ByRef activeprotocol As Long) As Long
Public Declare Function SCardDisconnect Lib "winscard.dll" (ByVal hCard As Long, _
ByVal Disposistion 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 Disposition As Long) As Long
Public Declare Function SCardState Lib "winscard.dll" (ByVal hCard As Long, _
ByRef State As Long, _
ByRef Protocol As Long, _
ByRef ATR As Byte, _
ByRef ATRLen As Long) As Long
Public Declare Function SCardStatus Lib "winscard.dll" Alias "SCardStatusA" (ByVal hCard As Long, _
ByVal szReaderName As String, _
ByRef pcchReaderLen As Long, _
ByRef State As Long, _
ByRef Protocol As Long, _
ByRef ATR As Byte, _
ByRef ATRLen As Long) As Long
Public Declare Function SCardTransmit Lib "winscard.dll" (ByVal hCard As Long, _
pioSendRequest As SCARD_IO_REQUEST, _
ByRef SendBuff As Byte, _
ByVal SendBuffLen As Long, _
ByRef pioRecvRequest As SCARD_IO_REQUEST, _
ByRef recvbuff As Byte, _
ByRef RecvBuffLen As Long) As Long
Public Declare Function SCardTransmitLong Lib "winscard.dll" Alias "SCardTransmit" (ByVal hCard As Long, _
ByRef pioSendPci As SCARD_IO_REQUEST, _
ByRef pbSendBuffer As Byte, _
ByVal cbSendLength As Long, _
ByVal pioRecvPci As Long, _
ByRef pbRecvBuffer As Byte, _
ByRef pcbRecvLength As Long) As Long
Public Declare Function SCardListReaders Lib "winscard.dll" Alias "SCardListReadersA" (ByVal hContext As Long, _
ByVal mzGroup As String, _
ByVal ReaderList As String, _
ByRef pcchReaders As Long) As Long
Public Declare Function SCardGetStatusChange Lib "winscard.dll" Alias "SCardGetStatusChangeA" (ByVal hContext As Long, _
ByVal TimeOut As Long, _
ByRef ReaderState As SCARD_READERSTATE, _
ByVal ReaderCount 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 Type SCARDCONTEXT
CardContextl As Long
ReaderName As Byte
End Type
Sub Leggi()
Dim hContext As Long
Dim hCard As Long
Dim retval As Long
Dim readers As String * 256
Dim groups As String * 256
Dim pcchReaders As Long
Dim activeprotocol As Long
Dim readerlen As Long
Dim szReaderName As String
Dim SW1 As Long, SW2 As Long
Dim scard_protocol_t0_or_t1 As Long
Dim SCARD_SHARE_SHARED As Long
Dim SCARD_SCOPE_USER As Long
Dim SCARD_SCOPE_SYSTEM As Long
SCARD_SHARE_SHARED = 3
SCARD_SCOPE_USER = 1
SCARD_SCOPE_SYSTEM = 2
retval = SCardEstablishContext(SCARD_SCOPE_SYSTEM, SW1, SW2, hContext)
If (retval <> 0) Then MsgBox ("Errore: " & CStr(retval))
readerlen = 256
Dim recvlel As Long
Dim strHexa As String
scard_protocol_t0_or_t1 = 0
SCARD_SHARE_SHARED = 3
strHexa = ""
' FACCIO UNA LISTA DEI LETTORI DISPONIBILI
retval = SCardListReaders(hContext, groups, readers, readerlen)
If retval <> 0 Then
MsgBox "errore SCardListReaders n. " & CStr(retval)
Exit Sub
End If
' ######################################################################
' APRO LA CONNESSIONE CON LA CARTA
retval = SCardConnect(hContext, readers, SCARD_SHARE_SHARED, scard_protocol_t0_or_t1, hCard, activeprotocol)
If (retval <> 0) Then
MsgBox ("Tessera non inserita. Errore: " & CStr(retval))
Exit Sub
End If
' ######################################################################
retval = SCardDisconnect(hCard, 0)
If (retval <> 0) Then MsgBox ("Errore: " & CStr(retval))
retval = SCardReleaseContext(hContext)
If (retval <> 0) Then MsgBox ("Errore: " & CStr(retval))
Dim apdu(261) As Byte
Dim recvbuff(258) As Byte
Dim recvlen As Integer
Dim RecvBuffLen As Long
Dim pioSendRequest As SCARD_IO_REQUEST
Dim pioRecvRequest As SCARD_IO_REQUEST
' STRINGA APDU
apdu(0) = &H0 'CLA
apdu(1) = &HCA 'INS
apdu(2) = &H0 'P1
apdu(3) = &H81 'P2
apdu(4) = &H0 'LC
apdu(5) = &H0 'LE
recvlen = 257
pioSendRequest.dwProtocol = activeprotocol
pioSendRequest.dbPciLength = Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeprotocol
pioRecvRequest.dbPciLength = Len(pioSendRequest)
retval = SCardTransmit(hCard, pioSendRequest, apdu(0), 6, pioRecvRequest, recvbuff(0), RecvBuffLen)
If (retval <> 0) Then MsgBox ("Errore nella trasmissione: " & CStr(retval))
'---------------------
' LIVELLO MF
'---------------------
apdu(0) = &H0 'CLA
apdu(1) = &HA4 'INS
apdu(2) = &H9 'P1
apdu(3) = &H0 'P2
apdu(4) = &H2 'LC
apdu(5) = &H3F
apdu(6) = &H0
recvlen = 257
pioSendRequest.dwProtocol = activeprotocol
pioSendRequest.dbPciLength = Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeprotocol
pioRecvRequest.dbPciLength = Len(pioSendRequest)
retval = SCardTransmit(hCard, pioSendRequest, apdu(0), 7, pioRecvRequest, recvbuff(0), RecvBuffLen)
If (retval <> 0) Then
MsgBox ("Errore n." & CStr(retval))
End If
'---------------------
' LIVELLO EF 1100
'---------------------
apdu(0) = &H0 'CLA
apdu(1) = &HA4 'INS
apdu(2) = &H9 'P1
apdu(3) = &H0 'P2
apdu(4) = &H2 'LC
apdu(5) = &H11
apdu(6) = &H0
recvlen = 257
pioSendRequest.dwProtocol = activeprotocol
pioSendRequest.dbPciLength = Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeprotocol
pioRecvRequest.dbPciLength = Len(pioSendRequest)
retval = SCardTransmit(hCard, pioSendRequest, apdu(0), 7, pioRecvRequest, recvbuff(0), RecvBuffLen)
If (retval <> 0) Then
MsgBox ("Errore n." & CStr(retval))
End If
'---------------------
' LIVELLO EF 1102 - DATI PERSONALI CONTENUTI NELLA CARTA
'---------------------
apdu(0) = &H0 'CLA
apdu(1) = &HA4 'INS
apdu(2) = &H9 'P1
apdu(3) = &H0 'P2
apdu(4) = &H2 'LC
apdu(5) = &H11
apdu(6) = &H2
recvlen = 257
pioSendRequest.dwProtocol = activeprotocol
pioSendRequest.dbPciLength = Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeprotocol
pioRecvRequest.dbPciLength = Len(pioSendRequest)
retval = SCardTransmit(hCard, pioSendRequest, apdu(0), 7, pioRecvRequest, recvbuff(0), RecvBuffLen)
If (retval <> 0) Then
MsgBox ("Errore n." & CStr(retval))
End If
' LEGGO I BINARY PROVENIENTI DALLA CARTA
apdu(0) = &H0 'CLA
apdu(1) = &HB0 'INS
apdu(2) = &H0 'P1
apdu(3) = &H0 'P2
apdu(4) = &H96 'LC
recvlen = 257
pioSendRequest.dwProtocol = activeprotocol
pioSendRequest.dbPciLength = Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeprotocol
pioRecvRequest.dbPciLength = Len(pioSendRequest)
retval = SCardTransmit(hCard, pioSendRequest, apdu(0), 5, pioRecvRequest, recvbuff(0), RecvBuffLen)
If (retval <> 0) Then
MsgBox ("Errore n." & CStr(retval))
End If
Dim risposta As String
risposta = ""
Dim k, LenEmettitore, LenRilascio, LenScadenza, LenCognome, LenNome, LenValore1, LenValore2, LenValore3, LenCodice As Long
Dim Emettitore, Rilascio, Scadenza, Nome, Cognome, CODICE As String
For k = 0 To apdu(4) - 1: risposta = risposta + Chr(recvbuff(k)): Next k
' ESTRAGGO COGNOME, NOME, CODICE FISCALE
' IN BASE ALLA POSIZIONE NELLA STRINGA DI RISPOSTA DALLA CARTA
Dim PosIni
PosIni = 1
risposta = Trim(risposta)
risposta = Mid(risposta, 7)
LenEmettitore = HexToLong(Int(Mid(risposta, PosIni, 2)))
PosIni = PosIni + 2
Emettitore = Mid(risposta, PosIni, LenEmettitore)
PosIni = PosIni + LenEmettitore
LenRilascio = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
Rilascio = Mid(risposta, PosIni, LenRilascio)
PosIni = PosIni + LenRilascio
LenScadenza = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
Scadenza = Mid(risposta, PosIni, LenScadenza)
PosIni = PosIni + LenScadenza
LenCognome = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
Cognome = Mid(risposta, PosIni, LenCognome)
' txtDati.Text = Cognome
MsgBox ("Cognome: " & CStr(Cognome))
PosIni = PosIni + LenCognome
LenNome = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
Nome = Mid(risposta, PosIni, LenNome)
' txtDati.Text = txtDati.Text & " - " & Nome
PosIni = PosIni + LenNome
LenValore1 = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
PosIni = PosIni + LenValore1
LenValore2 = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
PosIni = PosIni + LenValore2
LenValore3 = Int(Mid(risposta, PosIni, 2))
PosIni = PosIni + 2
PosIni = PosIni + LenValore3
LenCodice = HexToLong(Int(Mid(risposta, PosIni, 2)))
PosIni = PosIni + 2
CODICE = Mid(risposta, PosIni, LenCodice)
' txtDati.Text = txtDati.Text & " - " & CODICE
' ############################################################################
' CHIUDO LA CONNESSIONE CON LA CARTA
retval = SCardDisconnect(hCard, 0)
If (retval <> 0) Then MsgBox ("Errore: " & CStr(retval))
retval = SCardReleaseContext(hContext)
If (retval <> 0) Then MsgBox ("Errore: " & CStr(retval))
' ############################################################################
End Sub
Function HexToLong(ByVal sValue As String) As Long
If UCase(Left(sValue, 2)) <> "&H" Then
sValue = "&H" & sValue
End If
If Right(sValue, 1) <> "&" Then
sValue = sValue & "&"
End If
HexToLong = Val(sValue)
End Function