Calcolo codice Fiscale

Un regalino per tutti…

Function Codicefiscale(nome as string, cognome as string, data as string, sesso as string, comune as String) As String
  Dim inome as string
  dim icognome as string
  dim icomune as string
  dim controllo as string
  dim temp As String
  inome = ""
  icognome = ""
  icomune = ""
  controllo = ""
  temp = ""
  Dim letteracod As String
  'prendi le iniziali del nome
  ' ccc As int32 = 1
  dim lungnome as integer
  For lungnome = 1 To Len(nome)
    temp = lowercase(Mid(nome, lungnome, 1))
    Select Case temp
    Case "b"
      inome = inome + temp
    Case "c"
      inome = inome + temp
    Case "d"
      inome = inome + temp
    Case "f"
      inome = inome + temp
    Case "g"
      inome = inome + temp
    Case "h"
      inome = inome + temp
    Case "j"
      inome = inome + temp
    Case "k"
      inome = inome + temp
    Case "l"
      inome = inome + temp
    Case "m"
      inome = inome + temp
    Case "n"
      inome = inome + temp
    Case "p"
      inome = inome + temp
    Case "q"
      inome = inome + temp
    Case "r"
      inome = inome + temp
    Case "s"
      inome = inome + temp
    Case "t"
      inome = inome + temp
    Case "v"
      inome = inome + temp
    Case "w"
      inome = inome + temp
    Case "x"
      inome = inome + temp
    Case "y"
      inome = inome + temp
    Case "z"
      inome = inome + temp
    End Select
  Next
  If Len(inome) >= 4 Then
    temp = lowercase(inome)
    inome = Mid(temp, 1, 1) + Mid(temp, 3, 1) + Mid(temp, 4, 1)
  End If
  'controlla la lunghezza delle iniziali
  If Len(inome) > 3 Then
    inome = Mid(inome, 1, 3)
  ElseIf Len(inome) < 3 Then
    For lungnome = 1 To Len(nome)
      letteracod = Mid(nome, lungnome, 1)
      Select Case letteracod
      Case "a"
        inome = inome + "a"
      Case "e"
        inome = inome + "e"
      Case "i"
        inome = inome +  "i"
      Case "o"
        inome = inome + "o"
      Case "u"
        inome = inome + "u"
      End Select
    Next
    If Len(inome) > 3 Then
      inome = Mid(inome, 1, 3)
    ElseIf Len(inome) < 3 Then
      For lungnome = Len(inome) To 3
        inome = inome + "x"
      Next
    End If
  End If
  'prendi lettere del cognome
  For lungnome = 1 To Len(cognome)
    temp = lowercase(Mid(cognome, lungnome, 1))
    Select Case temp
    Case "b"
      icognome = icognome + temp
    Case "c"
      icognome = icognome + temp
    Case "d"
      icognome = icognome + temp
    Case "f"
      icognome = icognome + temp
    Case "g"
      icognome = icognome + temp
    Case "h"
      icognome = icognome + temp
    Case "j"
      icognome = icognome + temp
    Case "k"
      icognome = icognome + temp
    Case "l"
      icognome = icognome + temp
    Case "m"
      icognome = icognome + temp
    Case "n"
      icognome = icognome + temp
    Case "p"
      icognome = icognome + temp
    Case "q"
      icognome = icognome + temp
    Case "r"
      icognome = icognome + temp
    Case "s"
      icognome = icognome + temp
    Case "t"
      icognome = icognome + temp
    Case "v"
      icognome = icognome + temp
    Case "w"
      icognome = icognome + temp
    Case "x"
      icognome = icognome + temp
    Case "y"
      icognome = icognome + temp
    Case ("z")
      icognome = icognome + temp
    End Select
  Next
  'controlla la lunghezza delle iniziali
  If Len(icognome) > 3 Then
    icognome = Mid(icognome, 1, 3)
  ElseIf Len(icognome) < 3 Then
    'minore di tre cifre prendi anche le vocali
    For lungnome = 1 To Len(cognome)
      letteracod = Mid(cognome, lungnome, 1)
      Select Case letteracod
      Case "a"
        icognome = icognome + "a"
      Case "e"
        icognome = icognome + "e"
      Case "i"
        icognome = icognome + "i"
      Case "o"
        icognome = icognome + "o"
      Case "u"
        icognome = icognome + "u"
      End Select
    Next
    If Len(icognome) > 3 Then
      icognome = Mid(icognome, 1, 3)
    ElseIf Len(icognome) < 3 Then
      For lungnome = Len(icognome) To 3
        icognome = icognome + "x"
      Next
    End If
  End If
  'calola le cifre della data
  Dim idata, gg, mm, aa As String
  ' temp = data
  ' Dim tempn As string
  dim detta() as string
  detta() = split(data,"/")
  gg = detta(0)
  mm = detta(1)
  aa = right(detta(2),2)
  
  'gg = left(data,2)
  'mm = mid(data,
  'tempn = InStr(temp, "/")
  'gg = Mid(data, 1, tempn - 1)
  'temp = Mid(data, 4)
  'tempn = InStr(temp, "/")
  'mm = Mid(temp, 1, tempn - 1)
  'temp = Mid(temp, 4)
  'aa = Mid(temp, 3)
  
  idata = aa
  ' MsgBox("TEMP" + temp)
  Select Case mm
  Case "01"
    idata = idata + "a"
  Case "02"
    idata = idata +"b"
  Case "03"
    idata = idata +"c"
  Case "04"
    idata = idata +"d"
  Case "05"
    idata = idata +"e"
  Case "06"
    idata = idata +"h"
  Case "07"
    idata = idata +"l"
  Case "08"
    idata = idata +"m"
  Case "09"
    idata = idata +"p"
  Case "10"
    idata = idata +"r"
  Case "11"
    idata = idata +"s"
  Case "12"
    idata = idata +"t"
  End Select
  If sesso = "M" Then
    idata = idata + gg
  ElseIf sesso = "F" Then
    idata = idata + str(val(gg) + 40)
  End If
  'codice parziale per calcolare ultima cifra
  Dim parz As String
  parz = lowercase(icognome + inome + idata + comune)
  'trova il carattere di verificca
  Dim d, p As String
  Dim vdis, vpar As integer
  For lungnome = 1 To 15 Step 2
    d = Mid(parz, lungnome, 1)
    Select Case d
    Case "0"
      vdis = vdis + 1
    Case "1"
      vdis = vdis + 0
    Case "2"
      vdis = vdis + 5
    Case "3"
      vdis = vdis + 7
    Case "4"
      vdis = vdis + 9
    Case "5"
      vdis = vdis + 13
    Case "6"
      vdis = vdis + 15
    Case "7"
      vdis = vdis +17
    Case "8"
      vdis = vdis + 19
    Case "9"
      vdis = vdis + 21
    Case "a"
      vdis = vdis + 1
    Case "b"
      vdis = vdis + 0
    Case "c"
      vdis = vdis + 5
    Case "d"
      vdis = vdis + 7
    Case "e"
      vdis = vdis + 9
    Case "f"
      vdis = vdis + 13
    Case "g"
      vdis  = vdis + 15
    Case "h"
      vdis = vdis + 17
    Case "i"
      vdis = vdis + 19
    Case "j"
      vdis = vdis + 21
    Case "k"
      vdis = vdis + 2
    Case "l"
      vdis = vdis + 4
    Case "m"
      vdis = vdis + 18
    Case "n"
      vdis = vdis + 20
    Case "o"
      vdis = vdis + 11
    Case "p"
      vdis = vdis + 3
    Case "q"
      vdis = vdis + 6
    Case "r"
      vdis = vdis + 8
    Case "s"
      vdis = vdis + 12
    Case "t"
      vdis = vdis + 14
    Case "u"
      vdis = vdis + 16
    Case "v"
      vdis = vdis + 10
    Case "w"
      vdis = vdis + 22
    Case "x"
      vdis = vdis + 25
    Case "y"
      vdis = vdis + 24
    Case "z"
      vdis = vdis + 23
    End Select
  Next
  For lungnome = 2 To 14 Step 2
    p = Mid(parz, lungnome, 1)
    Select Case p
    Case "0"
      vpar = vpar + 0
    Case "1"
      vpar  = vpar + 1
    Case "2"
      vpar  = vpar + 2
    Case "3"
      vpar  = vpar + 3
    Case "4"
      vpar  = vpar + 4
    Case "5"
      vpar  = vpar + 5
    Case "6"
      vpar  = vpar + 6
    Case "7"
      vpar  = vpar + 7
    Case "8"
      vpar  = vpar + 8
    Case "9"
      vpar  = vpar + 9
    Case "a"
      vpar  = vpar + 0
    Case "b"
      vpar  = vpar + 1
    Case "c"
      vpar  = vpar + 2
    Case "d"
      vpar  = vpar + 3
    Case "e"
      vpar  = vpar + 4
    Case "f"
      vpar  = vpar + 5
    Case "g"
      vpar  = vpar + 6
    Case "h"
      vpar  = vpar + 7
    Case "i"
      vpar  = vpar + 8
    Case "j"
      vpar  = vpar + 9
    Case "k"
      vpar  = vpar + 10
    Case "l"
      vpar  = vpar + 11
    Case "m"
      vpar  = vpar + 12
    Case "n"
      vpar  = vpar + 13
    Case "o"
      vpar  = vpar + 14
    Case "p"
      vpar  = vpar + 15
    Case "q"
      vpar  = vpar + 16
    Case "r"
      vpar  = vpar + 17
    Case "s"
      vpar  = vpar + 18
    Case "t"
      vpar  = vpar + 19
    Case "u"
      vpar  = vpar + 20
    Case "v"
      vpar  = vpar + 21
    Case "w"
      vpar  = vpar +22
    Case "x"
      vpar  = vpar + 23
    Case "y"
      vpar  = vpar + 24
    Case "z"
      vpar  = vpar + 25
    End Select
  Next
  Dim vdisparsomma As double
  'somma dei valori ottenuti dal dispari e dal pari
  vdisparsomma = vdis + vpar
  '---------------------
  ' vdisparsomma = 148
  '---------------------
  'diviso 26, troviamo il resto
  Dim restov As integer
  restov = vdisparsomma Mod 26
  Select Case restov
  Case 0
    controllo = "a"
  Case 1
    controllo = "b"
  Case 2
    controllo = "c"
  Case 3
    controllo = "d"
  Case 4
    controllo = "e"
  Case 5
    controllo = "f"
  Case 6
    controllo = "g"
  Case 7
    controllo = "h"
  Case 8
    controllo = "i"
  Case 9
    controllo = "j"
  Case 10
    controllo = "k"
  Case 11
    controllo = "l"
  Case 12
    controllo = "m"
  Case 13
    controllo = "n"
  Case 14
    controllo = "o"
  Case 15
    controllo = "p"
  Case 16
    controllo = "q"
  Case 17
    controllo = "r"
  Case 18
    controllo = "s"
  Case 19
    controllo = "t"
  Case 20
    controllo = "u"
  Case 21
    controllo = "v"
  Case 22
    controllo = "w"
  Case 23
    controllo = "x"
  Case 24
    controllo = "y"
  Case 25
    controllo = "z"
  End Select
  'fai il codice fiscale
  dim Codicefiscale as String
  codicefiscale = uppercase(parz + controllo)
  return Codicefiscale
End Function

Attenzione il campo ‘comune’ il codice istat !

Sei un grande! Mi hai fatto fare un figurone con questo regalo! Davvero Grazie!
Aggiungo una cosa: a questo link
http://www.istat.it/it/archivio/6789
si trova il csv con tutti i codici istat (si deve usare il codice catastale) di tutti i comuni.

Grazie ancora davvero!

versione semplificata con funzioni per la verifica

[code]Function codiceFiscale(cf as String) As Boolean
//Verifica se un codice fiscale CF formalmente valido
cf=cf.Uppercase
dim re as RegEx
re=new RegEx
re.SearchPattern="^[A-Z]{6}\d{2}[A-Z]\d{2}[A-Z]\d{3}[A-Z]$"
re.ReplacementPattern=""
if re.Replace(cf)<>"" then Return False

return CodiceLast(cf.Left(15))=cf.Right(1)
End Function

Function CodiceLast(t as String) As string
//Calcolo dell’ultimo carattere per un codice fiscale parziale t
dim set1 as string=“0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ”
dim set2 as string=“ABCDEFGHIJABCDEFGHIJKLMNOPQRSTUVWXYZ”
dim setpari as string=“ABCDEFGHIJKLMNOPQRSTUVWXYZ”
dim setdisp as string=“BAKPLCQDREVOSFTGUHMINJWZYX”
t=t.Uppercase
dim sc,ss2 as String
dim ps1,psp as integer
dim s as integer=0
for i as integer=1 to 13 step 2
sc=t.Mid(i+1,1)
ps1=set1.InStr(sc)
ss2=set2.Mid(ps1,1)
psp=setpari.InStr(ss2)-1
s=s+psp
next
for i as integer=0 to 14 step 2
sc=t.Mid(i+1,1)
ps1=set1.InStr(sc)
ss2=set2.Mid(ps1,1)
psp=setdisp.InStr(ss2)-1
s=s+psp
next
Return chr((s mod 26)+asc(“A”))
End Function

//La tua funzione riscritta in forma pi breve e sfruttando la CodiceLast
Function Codicefiscale(nome as string, cognome as string, data as date, maschio as boolean, comune as String) As String
Dim inome as string
dim icognome as string
dim icomune as string
dim temp As String

dim lettereNome() as String=array( “b”,“c”,“d”,“f”,“g”,“h”,“j”,“k”,“l”,“m”,“n”,“p”,“q”,“r”,“s”,“t”,“v”,“w”,“x”,“y”,“z”)
dim lettereNomeExtra() as String=array(“a”,“e”,“i”,“o”,“u”)

Dim letteracod As String
dim lungnome as integer
dim lenNome as integer=nome.Len

nome=nome.Lowercase
For lungnome = 1 To lenNome
temp=nome.Mid(lungnome,1)
if lettereNome.IndexOf(temp)>-1 then inome=inome+temp
Next
dim lenCNome as integer=inome.Len
if inome.len>=4 then
inome = inome.Left(1)+inome.mid(3,1)+inome.mid(4,1)
lenCNome=inome.Len
End If
'controlla la lunghezza delle iniziali
If lenCNome > 3 Then
inome = inome.Mid(1, 3)
ElseIf lenCNome < 3 Then
For lungnome = 1 To lenNome
letteracod = nome.Mid(lungnome, 1)
if lettereNomeExtra.IndexOf(letteracod)>-1 then inome=inome+letteracod
Next
lenCNome=inome.Len
If lenCNome > 3 Then
inome = inome.Mid(1, 3)
ElseIf lenCNome< 3 Then
For lungnome = lenCNome To 3
inome = inome + “x”
Next
End If
End If

lenNome=cognome.len
cognome=cognome.Lowercase
'prendi lettere del cognome
For lungnome = 1 To lenNome
temp = cognome.Mid(lungnome,1)
if lettereNome.IndexOf(temp)>-1 then icognome=icognome+temp
Next
lenCNome=icognome.Len
'controlla la lunghezza delle iniziali
If lenCNome > 3 Then
icognome = icognome.Mid(1, 3)
ElseIf lenCNome< 3 Then
'minore di tre cifre prendi anche le vocali
For lungnome = 1 To lenNome
letteracod = cognome.Mid(lungnome, 1)
if lettereNomeExtra.IndexOf(letteracod)>-1 then icognome=icognome+letteracod
Next
If Len(icognome) > 3 Then
icognome = Mid(icognome, 1, 3)
ElseIf Len(icognome) < 3 Then
For lungnome = Len(icognome) To 3
icognome = icognome + “x”
Next
End If
End If
dim idata as String=str(data.Year).Right(2)
dim vMesi() as String=array(“a”,“b”,“c”,“d”,“e”,“h”,“l”,“m”,“p”,“r”,“s”,“t”)
idata=idata+vMesi(data.Month-1)
if maschio then
idata=idata+str(data.Day,“00”)
else
idata=idata+str(data.Day+40)
end if
dim codice as String=icognome + inome + idata + comune
dim controllo as String=CodiceLast(codice)

return Uppercase(codice+controllo)

End Function
[/code]

Antonio, la funzione di controllo OK, ma solo se utilizzata in un contesto dove non esistono codici fiscali di persone giuridiche.
Per il mio caso, ad esempio non andrebbe bene, posso avere codici fiscali solo numerici ad esempio il codice fiscale di un ente, di una azienda srl, snc, sas, una cooperative etc.

Ecco l’algoritmo di controllo cos come emanato dall’agenzia delle entrate :

[code]Function ControllaCF(cf as String) As string
dim alternativo as string
if IsNumeric(cf) and len(cf) = 11 then
alternativo = controllaPIVA(cf)
Return alternativo
else
Dim i,ValCode As Integer
Dim FCstring,char As String
Dim rg as RegEx
Dim chkAlpha As RegExMatch

rg=new RegEx
rg.SearchPattern="[^A-Z0-9]"
chkAlpha=rg.Search(cf)

FCstring="A01B00C05D07E09F13G15H17I19J21K02L04M18N20O11P03Q06R08S12T14U16V10W22X25Y24Z23"

If Len(cf)<>16 Or chkAlpha<>Nil Then
  Return "Inserimento dati codice fiscale errato"
Else
  For i=1 To 15
    char=Mid(cf,i,1)
    If (i Mod 2) = 0 Then
      
      If char>="0" And char<="9" Then
        ValCode=ValCode+Val(char)
      Else
        ValCode=ValCode+Asc(char)-65
      End If
      
    ElseIF char>="0" And char<="9" Then
      ValCode=ValCode+Val(Mid(FCstring,InStr(FCstring,Chr(Asc(char)+17))+1,2))
    Else
      ValCode=ValCode+Val(Mid(FCstring,InStr(FCstring,char)+1,2))
    End If
    
  Next
  
  If Chr((ValCode Mod 26)+65)<>Mid(cf,16,1) Then
    Return "Codice Fiscale errato"
  End If
  
End If

end if

End Function
[/code]

e quello per il controllo della partita iva

[code] Dim i,n As Integer
Dim rg as RegEx
Dim chkAlpha As RegExMatch

rg=new RegEx
rg.SearchPattern="[^0-9]"
chkAlpha=rg.Search(pi)

If Len(pi)<>11 Or chkAlpha<>Nil Then
Return “Inserimento dati partita iva errato”
Else
For i=1 To 9 Step 2
n=n+Val(Mid(pi,i,1))
If val(Mid(pi,i+1,1))*2<=9 then
n=n+Val(Mid(pi,i+1,1))*2
Else
n=n+(Val(Mid(pi,i+1,1))*2)-9
End If
Next
n=n+Val(Mid(pi,11,1))

If (n Mod 10)<>0 Then
  Return "Partita IVA errata"
End If

End If[/code]

Ma il codice fiscale di un ente non strutturato come una partita iva?
In quel caso per la verifica basta, come hai fatto tu, reindirizzare la verifica su verificaPartitaIVA e li puoi fare sia la verifica formale, che l’interrogazione per verificare che sia valida ed esistente.

diventato veramente prezioso questo thread! Grazie a tutti e due per le dritte!
Approfitto per completare con un altro URL, dove trovare i codici istat per gli stati esteri
http://www.agenziaentrate.gov.it/wps/content/Nsilib/Nsi/Strumenti/Codici+attivita+e+tributo/Codici+territorio/Comuni+italia+esteri/

ciao a tutti,
avrei bisogno di un aiuto per creare una pagina web xojo in cui calcolare il codice fiscale.
Come faccio ad associare le funzioni elencate in precedenza con i campi che ho inserito in maschera (textfield_nome, cognome, ecc.)?
Poi dopo aver compilato in campi necessari vorrei cliccare su un button e visualizzare il valore del codice fiscale in un altro campo inizialmente vuoto.

Grazie mille.

Utilizza la funzione che ho postato io in questo thread.
In particolare la funzione Codicefiscale

Ho utlizzato la funzione che ha indicato Antonio,
In pratica nella cartella c’ un progettino per il calcolo del codice fiscale che gira su web con tanto di database sqlite contenente la tabella dei comuni e relativi codici istat, sia per l’italia che per gli stati esteri.
per farlo funzionare, occorre copiare il file comuni.sqlite3 nella cartella ‘documenti’ del proprio computer

Massi, ne fai di cose, tra una doccia e l’altra !! :slight_smile:

Niente doccia … .st progettando la bici con le ruote quadrate…

Scherzo, st creando il plugin per leggere i file .dxf …
sono arrivato alle polilinee con curve bezier… adesso diventer scemo…