Attribute VB_Name = "codice_fiscale"
Option Explicit
Public Type cod
id As Integer
com As String * 25
cod As String * 4
prov As String * 2
End Type
Public cont As Integer
Public nome As String
Public cognome As String
Public data As String
Public comune As String
Public codice() As cod
Public Function tcom(c As String) As String
Dim n As Integer, strlinea As String, l As Integer, strlinea2 As String
n = FreeFile
l = Len(c)
tcom = Trim(LCase(c))
Open App.Path & "\codfis.cod" For Input As #n
While Not EOF(n)
Line Input #n, strlinea
strlinea2 = Trim(LCase(Mid(strlinea, 1, l)))
If Trim(LCase(strlinea2)) = tcom Then
cont = cont + 1
ReDim Preserve codice(1 To cont) As cod
codice(cont).cod = Trim(UCase(Mid(strlinea, l + 2, 4)))
codice(cont).prov = Trim(UCase(Mid(strlinea, l + 7, 2)))
tcom = UCase(codice(cont).cod)
End If
Wend
Close #n
End Function
Public Function tcog(strx As String) As String
Dim stry As String, car As String, i As Integer
stry = ""
i = 1
Do
car = Mid(strx, i, 1)
If car <> "a" And car <> "e" And car <> "i" And car <> "o" And car <> "u" Then
stry = stry & Mid(strx, i, 1)
End If
i = i + 1
Loop Until i > Len(strx) Or Len(stry) = 3
If Len(stry) < 3 Then
i = 1
Do
car = Mid(strx, i, 1)
If car = "a" Or car = "e" Or car = "i" Or car = "o" Or car = "u" Then
stry = stry & Mid(strx, i, 1)
End If
i = i + 1
Loop Until i > Len(strx) Or Len(stry) = 3
End If
tcog = UCase(stry)
End Function
Public Function tnome(strx As String) As String
Dim stry As String, i As Integer, car As String, j As Integer, cons As String
j = 0
stry = ""
i = 1
Do
car = Mid(strx, i, 1)
If car <> "a" And car <> "e" And car <> "i" And car <> "o" And car <> "u" Then
j = j + 1
cons = cons & Mid(strx, i, 1)
End If
If i = Len(strx) Then
If Len(cons) >= 4 Then
stry = Mid(cons, 1, 1) & Mid(cons, 3, 1) & Mid(cons, 4, 1)
Else
stry = cons
End If
End If
i = i + 1
Loop Until i > Len(strx) Or Len(stry) = 3
If Len(stry) < 3 Then
i = 1
Do
car = Mid(strx, i, 1)
If car = "a" Or car = "e" Or car = "i" Or car = "o" Or car = "u" Then
stry = stry & Mid(strx, i, 1)
End If
i = i + 1
Loop Until i > Len(strx) Or Len(stry) = 3
End If
tnome = UCase(stry)
End Function
Public Function controllo(strx As String) As String
Dim i As Integer
Dim sommapari As Integer
Dim sommadispari As Integer
Dim somma As Integer
Dim codasc As Integer, carattere As String * 1
Dim char As Integer
Dim pari(0 To 25) As Integer
Dim dispari(0 To 25) As Integer
dispari(0) = 1: dispari(1) = 0: dispari(2) = 5: dispari(3) = 7: _
dispari(4) = 9: dispari(5) = 13: dispari(6) = 15: dispari(7) = 17: _
dispari(8) = 19: dispari(9) = 21: dispari(10) = 2: dispari(11) = 4: _
dispari(12) = 18: dispari(13) = 20: dispari(14) = 11: dispari(15) = 3: _
dispari(16) = 6: dispari(17) = 8: dispari(18) = 12: dispari(19) = 14: _
dispari(20) = 16: dispari(21) = 10: dispari(22) = 22: dispari(23) = 25: _
dispari(24) = 24: dispari(25) = 23:
sommapari = 0
For i = 2 To Len(strx) Step 2
carattere = Mid(strx, i, 1)
codasc = Asc(carattere)
char = Val(carattere)
If char <> 0 Then
sommapari = sommapari + Val(carattere)
Else
sommapari = sommapari + codasc - 65
End If
Next i
sommadispari = 0
For i = 1 To Len(strx) Step 2
carattere = Mid(strx, i, 1)
codasc = Asc(carattere)
char = Val(carattere)
If char <> 0 Then
sommadispari = sommadispari + dispari(Val(carattere))
Else
sommadispari = sommadispari + dispari(codasc - 65)
End If
Next i
somma = sommapari + sommadispari
controllo = Chr((somma Mod 26) + 65)
End Function
