grazie a tutti.
Public Function ControllaCodiceFiscaleSilenziosa(ByVal Codice As String,
ByRef CodComune As String, ByRef Data As String, ByRef Sesso As String) As
String
'controlla un codice fiscale
'INPUT
'Codice = codice da controllare
Dim dat As String
Dim i As Integer
Dim A As String
Dim ok As Boolean
Dim tnc As String
Dim X As String
Dim j As Integer
Dim Res As Integer
Dim Comune As String
'Dim CodComune As String
Dim Prov As String
Dim Anomalia As Boolean
Dim Giorno As Integer
'Dim Sesso As String
Const TitoloMessaggi = "Controllo codice fiscale"
'inizializziamo vettore mesi
Dim CodiceMese(12) As String
CodiceMese(1) = "A"
CodiceMese(2) = "B"
CodiceMese(3) = "C"
CodiceMese(4) = "D"
CodiceMese(5) = "E"
CodiceMese(6) = "H"
CodiceMese(7) = "L"
CodiceMese(8) = "M"
CodiceMese(9) = "P"
CodiceMese(10) = "R"
CodiceMese(11) = "S"
CodiceMese(12) = "T"
'inizializziamo vettore 16° carattere di controllo
Dim nd(26) As Integer
nd(1) = 1
nd(2) = 0
nd(3) = 5
nd(4) = 7
nd(5) = 9
nd(6) = 13
nd(7) = 15
nd(8) = 17
nd(9) = 19
nd(10) = 21
nd(11) = 2
nd(12) = 4
nd(13) = 18
nd(14) = 20
nd(15) = 11
nd(16) = 3
nd(17) = 6
nd(18) = 8
nd(19) = 12
nd(20) = 14
nd(21) = 16
nd(22) = 10
nd(23) = 22
nd(24) = 25
nd(25) = 24
nd(26) = 23
'controllo lunghezza
ControllaCodiceFiscaleSilenziosa = ""
If Len(Codice) <> 16 Then
ControllaCodiceFiscaleSilenziosa = "Non sono 16 caratteri"
Exit Function
End If
'controllo cognome e nome
For i = 1 To 6
If Asc(Mid(Codice, i, 1)) > 90 Or Asc(Mid(Codice, i, 1)) < 65 Then
A = "Il " & i & "° carattere non è una lettera"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
Next
'controllo data
dat = Mid(Codice, 7, 5)
'controllo numeri
If Asc(Mid(dat, 1, 1)) > 57 Or Asc(Mid(dat, 1, 1)) < 48 Then
A = "Il 7° carattere non è un numero"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
If Asc(Mid(dat, 2, 1)) > 57 Or Asc(Mid(dat, 2, 1)) < 48 Then
A = "L'8° carattere non è un numero"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
If Asc(Mid(dat, 4, 1)) > 57 Or Asc(Mid(dat, 4, 1)) < 48 Then
A = "Il 10° carattere non è un numero"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
If Asc(Mid(dat, 5, 1)) > 57 Or Asc(Mid(dat, 5, 1)) < 48 Then
A = "L'11° carattere non è un numero"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
If Mid(dat, 4, 2) = "00" Then
A = "Il giorno di nascita è 00"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
Anno = Val(Microsoft.VisualBasic.Left(dat, 2))
'controllo mese
A = Mid(dat, 3, 1)
ok = False
For i = 1 To UBound(CodiceMese)
If CodiceMese(i) = A Then
Mese = i
ok = True
Exit For
End If
Next
If Not ok Then
A = "Il 9° carattere non è un codice del mese valido"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
'controlla giorno
Giorno = Val(Microsoft.VisualBasic.Right(dat, 2))
Sesso = ""
If Giorno < 32 Then
Sesso = "M"
ElseIf Giorno > 40 And Giorno < 72 Then
Sesso = "F"
Giorno = Giorno - 40
Else
A = "Il 10° e l' 11° carattere non sono un giorno valido"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
'controllo Comune
CodComune = Mid(Codice, 12, 4)
'controllo 16° carattere
tnc = 0
'cerca tra i pari delle lettere
For i = 2 To 14 Step 2
X = Mid(Codice, i, 1)
For j = 65 To 90
If Chr(j) = X Then
tnc = tnc + j - 65
Exit For
End If
Next
Next
'cerca tra i pari delle cifre
For i = 2 To 14 Step 2
X = Mid(Codice, i, 1)
For j = 48 To 57
If Chr(j) = X Then
tnc = tnc + j - 48
Exit For
End If
Next
Next
'cerca tra i dispari delle lettere
For i = 1 To 15 Step 2
X = Mid(Codice, i, 1)
For j = 65 To 90
If Chr(j) = X Then
tnc = tnc + nd(j - 64)
Exit For
End If
Next
Next
'cerca tra i dispari dei numeri
For i = 1 To 15 Step 2
X = Mid(Codice, i, 1)
For j = 48 To 57
If Chr(j) = X Then
tnc = tnc + nd(j - 47)
Exit For
End If
Next
Next
'CDF: Costruisco la Data
If Giorno <= 9 Then
Data = "0" & Giorno & "/"
Else
Data = Giorno & "/"
End If
If Mese <= 9 Then
Data = Data & "0" & Mese & "/"
Else
Data = Data & Mese & "/"
End If
If Anno <= 4 Then
Data = Data & "200" & Anno
Else
If Anno <= 9 Then
Data = Data & "190" & Anno
Else
Data = Data & "19" & Anno
End If
End If
If Microsoft.VisualBasic.Right(Codice, 1) <> Chr((tnc Mod 26) + 65) Then
A = "Il 16° carattere non è un codice di controllo valido" & vbCr
A = A & "dovrebbe essere -" & Chr((tnc Mod 26) + 65) & "-"
ControllaCodiceFiscaleSilenziosa = A
Exit Function
End If
End Function
"Sanpei" <mm...@libero.it> ha scritto nel messaggio
news:#MBVCeJT...@TK2MSFTNGP11.phx.gbl...
http://www.dotnethell.it/articles/article.aspx?
ArticleID=84
Ciao
Marco Caruso[MCAD]
Articoli e Tips su
http://www.dotnethell.it
"Sanpei" <mm...@libero.it> ha scritto nel messaggio
news:%23MBVCeJ...@TK2MSFTNGP11.phx.gbl...