Option Explicit
Private Dihedral(9) As Variant
Private FnF(7) As Variant
Private InverseD5 As Variant
Public Function VerhoeffCheck(ByVal IdValue As String) As Boolean
'Check the supplied value and return true or false
Dim tCheck As Integer, i As Integer
VerhoeffArrayInit
For i = Len(IdValue) To 1 Step -1
tCheck = Dihedral(tCheck)(FnF((Len(IdValue) - i) Mod 8)(Val(Mid(IdValue, i, 1))))
Next
VerhoeffCheck = tCheck = 0
End Function
Public Function VerhoeffCompute(ByVal IdValue As String) As String
'Compute the check digit and return the identifier complete with check-digit
Dim tCheck As Integer, i As Integer
VerhoeffArrayInit
For i = Len(IdValue) To 1 Step -1
tCheck = Dihedral(tCheck)(FnF((Len(IdValue) - i + 1) Mod 8)(Val(Mid(IdValue, i, 1))))
Next
VerhoeffCompute = IdValue & InverseD5(tCheck)
End Function
Private Sub VerhoeffArrayInit()
'Create the arrays required
Dim i As Integer, j As Integer
'if already created exit here
If VarType(InverseD5) >= vbArray Then Exit Sub
'create the DihedralD5 array
Dihedral(0) = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
Dihedral(1) = Array(1, 2, 3, 4, 0, 6, 7, 8, 9, 5)
Dihedral(2) = Array(2, 3, 4, 0, 1, 7, 8, 9, 5, 6)
Dihedral(3) = Array(3, 4, 0, 1, 2, 8, 9, 5, 6, 7)
Dihedral(4) = Array(4, 0, 1, 2, 3, 9, 5, 6, 7, 8)
Dihedral(5) = Array(5, 9, 8, 7, 6, 0, 4, 3, 2, 1)
Dihedral(6) = Array(6, 5, 9, 8, 7, 1, 0, 4, 3, 2)
Dihedral(7) = Array(7, 6, 5, 9, 8, 2, 1, 0, 4, 3)
Dihedral(8) = Array(8, 7, 6, 5, 9, 3, 2, 1, 0, 4)
Dihedral(9) = Array(9, 8, 7, 6, 5, 4, 3, 2, 1, 0)
'create the FunctionF array
FnF(0) = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
FnF(1) = Array(1, 5, 7, 6, 2, 8, 3, 0, 9, 4)
'compute the rest of the FunctionF array
For i = 2 To 7
FnF (i) = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For j = 0 To 9
FnF (i)(j) = FnF(i - 1)(FnF(1)(j))
Next
Next
'Create the InverseD5 array
InverseD5 = Array("0", "4", "3", "2", "1", "5", "6", "7", "8", "9")
End Sub |