Imports System.Text
Imports System.Runtime.InteropServices
Public Class SJScard : Implements IDisposable
Public Readers As String()
Public Cognome As String
Public Nome As String
Public CF As String
Public DataEmissione As Date
Public DataScadenza As Date
Public DataNascita As Date
Public Sesso As String
Public NatoA As String
Public ResidenteA As String
Private hContext As IntPtr = IntPtr.Zero
Private phCard As IntPtr = IntPtr.Zero
Private Const SCARD_SCOPE_SYSTEM As Integer = 2
Private Const SCARD_SHARE_SHARED As Integer = 2
Private Const SCARD_LEAVE_CARD As Integer = 0
'Private Const SCARD_RESET_CARD As Integer = 1
'Private Const SCARD_UNPOWER_CARD As Integer = 2
'Private Const SCARD_EJECT_CARD As Integer = 3
Private Const SCARD_S_SUCCESS As Integer = 0
Private Const SCARD_PROTOCOL_T0 As Integer = &H1
Private Const SCARD_PROTOCOL_T1 As Integer = &H2
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardEstablishContext(ByVal dwScope As Integer, ByVal pvReserved1 As IntPtr, ByVal pvReserved2 As IntPtr, ByRef phContext As IntPtr) As Integer
End Function
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardReleaseContext(ByVal hContext As IntPtr) As Integer
End Function
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardConnect(ByVal hContext As IntPtr, _
ByVal szReaderName As String, _
ByVal dwShareMode As Integer, _
ByVal dwPreferredProtocols As Integer, _
ByRef phCard As IntPtr, _
ByRef pdwActiveProtocol As Integer) As Integer
End Function
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardListReaders(ByVal hContext As IntPtr, ByVal mszGroups As String, _
ByVal mszReaders As String, ByRef pcchReaders As UInteger) As Integer
End Function
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardDisconnect(ByVal phCard As IntPtr, _
ByVal dwDisposition As Integer) As Integer
End Function
<DllImport("winscard.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SCardTransmit(ByVal phCard As IntPtr, _
ByRef pioSendPci As SCARD_IO_REQUEST, _
ByVal pbSendBuffer As Byte(), _
ByVal cbSendLength As Int32, _
ByRef pioRecvPci As SCARD_IO_REQUEST, _
ByVal pbRecvBuffer As Byte(), _
ByRef RecvBuffLen As Int32) As Integer
End Function
<StructLayout(LayoutKind.Sequential)> _
Private Structure SCARD_IO_REQUEST
Dim dwProtocol As Int32
Dim dbPciLength As Int32
End Structure
Private activeProtocol As Integer
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
Protected Overridable Sub Dispose(ByVal IsDisposing As Boolean)
Static isDisposed As Boolean ' To detect redundant calls.
If isDisposed Then Return
If IsDisposing Then
If phCard <> IntPtr.Zero Then
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
End If
If hContext <> IntPtr.Zero Then
SCardReleaseContext(hContext)
hContext = IntPtr.Zero
End If
End If
isDisposed = True
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
End Sub
Private Function CardTransmit(ByVal APDU() As Byte, ByRef SW As Integer, ByRef ResBuff() As Byte) As Integer
SW = 0
ResBuff = Nothing
Dim recvbuff(260) As Byte
Dim pioSendRequest As New SCARD_IO_REQUEST
Dim pioRecvRequest As New SCARD_IO_REQUEST
pioSendRequest.dwProtocol = activeProtocol
pioSendRequest.dbPciLength = Marshal.SizeOf(pioSendRequest) ' Len(pioSendRequest)
pioRecvRequest.dwProtocol = activeProtocol
pioRecvRequest.dbPciLength = Marshal.SizeOf(pioRecvRequest) ' Len(pioSendRequest)
Dim recBuffLen As Int32 = 256
Dim result = SCardTransmit(phCard, pioSendRequest, APDU, APDU.Length, pioRecvRequest, recvbuff, recBuffLen)
If result <> SCARD_S_SUCCESS Then Return result
' calcolo SW
SW = CInt(recvbuff(recBuffLen - 2) * &H100 + recvbuff(recBuffLen - 1))
Dim arrayTmp(recBuffLen - 3) As Byte
Array.Copy(recvbuff, arrayTmp, arrayTmp.Length)
ResBuff = arrayTmp
Return result
End Function
Private Function Errore(ByVal errorNumber As Integer) As String
' https://learn.microsoft.com/it-it/windows/win32/secauthn/authentication-return-values
' https://web.archive.org/web/20090330082954/http://www.wrankl.de/SCTables/SCTables.html
Dim ErroreStr = errorNumber.ToString("X4")
Select Case ErroreStr
Case "8010002E"
Return "Non è disponibile alcun lettore di smart card"
Case "80100009"
Return "Lettore non collegato"
Case "80100069"
Return "Tessera non inserita"
End Select
Return "Errore " & ErroreStr
End Function
Public Function ListReaders() As String
Dim result As Integer
If hContext = IntPtr.Zero Then
' mi collego al driver
result = SCardEstablishContext(SCARD_SCOPE_SYSTEM, IntPtr.Zero, IntPtr.Zero, hContext)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
End If
Dim pcchReaders As UInt32 = 1000
Dim mszReaders = New String(" "c, CInt(pcchReaders))
result = SCardListReaders(hContext, Nothing, mszReaders, pcchReaders)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
Readers = mszReaders.Trim.Split(New Char() {Convert.ToChar(0)}, StringSplitOptions.RemoveEmptyEntries)
Return ""
End Function
Private Function Estrai(ByRef txt As String, ByVal lung As Integer) As String
Dim lungVal = Convert.ToInt32(txt.Substring(0, lung), 16)
Dim testo = txt.Substring(lung, lungVal)
txt = txt.Substring(lung + lungVal)
Return testo
End Function
Public Function ReadCard(ByVal ReaderName As String) As String
Dim result As Integer
If hContext = IntPtr.Zero Then
' mi collego al driver
result = SCardEstablishContext(SCARD_SCOPE_SYSTEM, IntPtr.Zero, IntPtr.Zero, hContext)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
End If
result = SCardConnect(hContext, ReaderName, SCARD_SHARE_SHARED, SCARD_PROTOCOL_T0 Or SCARD_PROTOCOL_T1, phCard, activeProtocol)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
' --------------------------------------------------------------------------------------------------
Dim SW As Integer = 0
Dim data() As Byte = New Byte() {0}
result = CardTransmit(New Byte() {0, &HA4, 0, 0, 2, &H3F, 0}, SW, data) ' select MF (3F00)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
If SW <> &H9000 Then
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
Return Errore(SW)
End If
result = CardTransmit(New Byte() {0, &HA4, 0, 0, 2, &H11, 0}, SW, data) ' select DF1 (1100)
If result <> SCARD_S_SUCCESS Then Return Errore(result)
If SW <> &H9000 Then
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
Return Errore(SW)
End If
result = CardTransmit(New Byte() {0, &HA4, 0, 0, 2, &H11, 2}, SW, data) ' select EF 1102
If result <> SCARD_S_SUCCESS Then Return Errore(result)
If SW <> &H9000 Then
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
Return Errore(SW)
End If
result = CardTransmit(New Byte() {0, &HB0, 0, 0, &HFE}, SW, data) ' read datas
If result <> SCARD_S_SUCCESS Then Return Errore(result)
If SW <> &H9000 Then
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
Return Errore(SW)
End If
Dim txt = Encoding.Default.GetString(data)
SCardDisconnect(phCard, SCARD_LEAVE_CARD)
phCard = IntPtr.Zero
Dim lung = Convert.ToInt32(txt.Substring(0, 6), 16)
txt = txt.Substring(0, lung).Substring(6)
Dim boh = Estrai(txt, 2)
Dim dataEmiss = Estrai(txt, 2)
Dim dataScad = Estrai(txt, 2)
Cognome = Estrai(txt, 2)
Nome = Estrai(txt, 2)
Dim dataNasc = Estrai(txt, 2)
Sesso = Estrai(txt, 2)
CF = Estrai(txt, 4)
NatoA = Estrai(txt, 4)
ResidenteA = Estrai(txt, 6)
DataEmissione = Date.MinValue
Date.TryParseExact(dataEmiss, "ddMMyyyy", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, DataEmissione)
DataScadenza = Date.MinValue
Date.TryParseExact(dataScad, "ddMMyyyy", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, DataScadenza)
DataNascita = Date.MinValue
Date.TryParseExact(dataNasc, "ddMMyyyy", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, DataNascita)
Return ""
End Function
Public Function ReadCard() As String
Dim result = ListReaders()
If result <> "" Then Return result
If Readers.Count = 0 Then Return "Non è disponibile alcun lettore di smart card"
Return ReadCard(Readers(0))
End Function
End Class