Calcolo del codice fiscale
| Numero | Nome | Mask |
| 3 | TextBox | |
| 1 | MaskedTextBox | 00/00/00 |
| 1 | Button | |
| 5 | Label | |
| 1 | GroupBox | |
| 2 | RadioButton |
Imports System.Data
Imports System.Data.OleDb
Public Class Form1
Dim consonanti() As String = {"B", "C", "D", "F", "G", "H", "J", "K", "L", "M", "N", "P", "Q", "R", "S", "T", "V", "W", "X", "Y", "Z"}
Dim vocali() As String = {"A", "E", "I", "O", "U"}
Dim Alfabeto() As String = {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"}
Dim Cognome As String
Dim Nome As String
Dim Data() As String
Dim Anno As String
Dim Mese As String
Dim Giorno As String
Dim Sesso As String
Dim Luogo As String
Dim PathDatabase As String = Application.StartupPath & "\database.mdb"
Dim codice As String
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Cognome = TextBox1.Text.ToUpper
Nome = TextBox2.Text.ToUpper
Data = Split(MaskedTextBox1.Text, "/")
Anno = Data(2)
Mese = Data(1)
Giorno = Data(0)
If (RadioButton1.Checked) Then
Sesso = "m"
Else
Sesso = "f"
End If
Luogo = TextBox3.Text.ToUpper
CodiceCognome(Cognome)
CodiceNome(Nome)
codice += Anno
CodiceMese(Mese)
CodiceGiornoSesso(Giorno, Sesso)
CodiceLuogo(Luogo)
CodiceCarattereControllo()
Label5.Text = codice
codice = ""
End Sub
#Region "Creazione Codice"
Public Sub CodiceCognome(ByVal cognome As String)
Dim conta As Integer = 0
For i = 0 To cognome.Length - 1
For k = 0 To 20
If (cognome(i) = consonanti(k)) Then
codice += cognome(i)
conta += 1
End If
If conta = 3 Then
Exit For
End If
Next
Next
If conta < 3 Then conta = 3 - conta For i = 0 To cognome.Length - 1 For k = 0 To 4 If (cognome(i) = vocali(k)) Then codice += cognome(i) conta -= 1 End If If (conta = 0) Then Exit For End If Next Next End If End Sub Public Sub CodiceNome(ByVal nome As String) Dim conta As Integer = 0 Dim ConsonantiNome As String = "" For i = 0 To nome.Length - 1 For k = 0 To 20 If (nome(i) = consonanti(k)) Then ConsonantiNome += nome(i) conta += 1 End If Next Next If (conta >= 4) Then
For i = 0 To 3
If (i = 1) Then
i += 1
End If
codice += ConsonantiNome(i)
Next
Else
conta = 0
For i = 0 To nome.Length - 1
For k = 0 To 20
If (nome(i) = consonanti(k)) Then
codice += nome(i)
conta += 1
End If
If conta = 3 Then
Exit For
End If
Next
Next
End If
End Sub
Public Sub CodiceMese(ByVal mese As String)
Select Case mese
Case Is = "01"
codice += "A"
Case Is = "02"
codice += "B"
Case Is = "03"
codice += "C"
Case Is = "04"
codice += "D"
Case Is = "05"
codice += "E"
Case Is = "06"
codice = "H"
Case Is = "07"
codice = "L"
Case Is = "08"
codice += "M"
Case Is = "09"
codice += "P"
Case Is = "10"
codice += "R"
Case Is = "11"
codice += "S"
Case Is = "12"
codice += "T"
End Select
End Sub
Public Sub CodiceGiornoSesso(ByVal giorno As String, ByVal sesso As String)
Dim a As Integer = giorno
If (sesso = "f") Then
a += 40
End If
giorno = a
codice += giorno
End Sub
Dim Connessione As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & PathDatabase & ";"
Public Sub CodiceLuogo(ByVal luogo As String)
Using conn As New OleDbConnection(Connessione)
Dim comando As New OleDbCommand("SELECT * FROM CodiceComuni WHERE COMUNE = '" & luogo & "'", conn)
conn.Open()
Dim reader As OleDbDataReader = comando.ExecuteReader
While reader.Read
codice += reader("CODICE").ToString()
End While
reader.Close()
End Using
End Sub
Public Sub CodiceCarattereControllo()
Dim CodiceDispari As String = ""
Dim NumeroDispari As Int64
Dim CodicePari As String = ""
Dim NumeroPari As Int64
For i = 0 To codice.Length - 1 Step 2
CodiceDispari += codice(i)
Next
For i = 1 To codice.Length - 1 Step 2
CodicePari += codice(i)
Next
NumeroDispari = Dispari(CodiceDispari)
NumeroPari = Pari(CodicePari)
Dim valore As Int64 = (NumeroDispari + NumeroPari) / 26
Dim numero As String = valore
CodiceIdentificativo(Val(numero(0)))
End Sub
Function Dispari(ByVal codicedispari As String)
Dim num As String = ""
For i = 0 To codicedispari.Length - 1
Select Case codicedispari(i)
Case Is = "0"
num += "1"
Case Is = "1"
num += "0"
Case Is = "2"
num += "5"
Case Is = "3"
num += "7"
Case Is = "4"
num += "9"
Case Is = "5"
num += "13"
Case Is = "6"
num += "15"
Case Is = "7"
num += "17"
Case Is = "8"
num += "19"
Case Is = "9"
num += "21"
Case Is = "A"
num += "1"
Case Is = "B"
num += "0"
Case Is = "C"
num += "5"
Case Is = "D"
num += "7"
Case Is = "E"
num += "9"
Case Is = "F"
num += "13"
Case Is = "G"
num += "15"
Case Is = "H"
num += "17"
Case Is = "I"
num += "19"
Case Is = "J"
num += "21"
Case Is = "K"
num += "2"
Case Is = "L"
num += "4"
Case Is = "M"
num += "18"
Case Is = "N"
num += "20"
Case Is = "O"
num += "11"
Case Is = "P"
num += "3"
Case Is = "Q"
num += "6"
Case Is = "R"
num += "8"
Case Is = "S"
num += "12"
Case Is = "T"
num += "14"
Case Is = "U"
num += "16"
Case Is = "V"
num += "10"
Case Is = "W"
num += "22"
Case Is = "X"
num += "25"
Case Is = "Y"
num += "24"
Case Is = "Z"
num += "23"
End Select
Next
Dim n As Int64 = Val(num)
Return n
End Function
Function Pari(ByVal codicepari As String) As Integer
Dim num As String = ""
For i = 0 To codicepari.Length - 1
For k = 0 To 25
If (codicepari(i) = Alfabeto(k)) Then
num += k.ToString
End If
Next
Select Case codicepari(i)
Case Is = "0"
num += codicepari(i)
Case Is = "1"
num += codicepari(i)
Case Is = "2"
num += codicepari(i)
Case Is = "3"
num += codicepari(i)
Case Is = "4"
num += codicepari(i)
Case Is = "5"
num += codicepari(i)
Case Is = "6"
num += codicepari(i)
Case Is = "7"
num += codicepari(i)
Case Is = "8"
num += codicepari(i)
Case Is = "9"
num += codicepari(i)
End Select
Next
Dim n As Int64 = Val(num)
Return n
End Function
Public Sub CodiceIdentificativo(ByVal valore As Integer)
For i = 0 To 24
If (valore = i) Then
codice += Alfabeto(i)
End If
Next
End Sub
#End Region
End Class
Programma e Sorgenti:
