codice fiscale

[amodio]

Public Function CheckCodFiscale(aValue As String) As Boolean
    
    aValue = UCase(aValue)
        
    If Trim(aValue) = "" Then
        CheckCodFiscale = True
        Exit Function
    End If
    Dim I As Integer
    Dim N As Integer
    Dim TBC(36) As Integer
    Dim nDispari As Integer
    Dim nPari As Integer
    TBC(0) = 0
    TBC(1) = 1: TBC(2) = 0: TBC(3) = 5: TBC(4) = 7: TBC(5) = 9
    TBC(6) = 13: TBC(7) = 15: TBC(8) = 17: TBC(9) = 19: TBC(10) = 21
    TBC(11) = 2: TBC(12) = 4: TBC(13) = 18: TBC(14) = 20: TBC(15) = 11
    TBC(16) = 3: TBC(17) = 6: TBC(18) = 8: TBC(19) = 12: TBC(20) = 14
    TBC(21) = 16: TBC(22) = 10: TBC(23) = 22: TBC(24) = 25: TBC(25) = 24
    TBC(26) = 23: TBC(27) = 1: TBC(28) = 0: TBC(29) = 5: TBC(30) = 7
    TBC(31) = 9: TBC(32) = 13: TBC(33) = 15: TBC(34) = 17: TBC(35) = 19
    TBC(36) = 21
'   Controllo sulla lunghezza della stringa: deve essere di 16 caratteri
    If Len(aValue) <> 16 Then
        CheckCodFiscale = False
        Exit Function
    End If
'   controllo sull'ultimo carattere
'   ciclo dispari: primo char, terzo, ecc...
    nDispari = 0
    For I = 1 To 15 Step 2
        N = Asc(Mid$(aValue, I, 1))
        If N < 58 Then
            N = N - 21
        Else
            N = N - 64
        End If
        If N < 0 Or N > 36 Then
            CheckCodFiscale = False
        End If
        nDispari = nDispari + TBC(N)
    Next I
'   ciclo pari: secondo char, quarto, ecc...
    nPari = 0
    For I = 2 To 14 Step 2
        N = Asc(Mid$(aValue, I, 1))
        N = Asc(Mid$(aValue, I, 1))
        If N < 58 Then
            N = N - 48
        Else
            N = N - 65
        End If
        If N < 0 Or N > 36 Then
            CheckCodFiscale = False
        End If
        nPari = nPari + N
    Next I
    I = (nPari + nDispari) Mod 26 + 65
    N = Asc(Mid$(aValue, 16, 1))
    If I = N Then
        CheckCodFiscale = True
    Else
        CheckCodFiscale = False
    End If
End Function