Page History
...
Code Block | ||||||||
---|---|---|---|---|---|---|---|---|
| ||||||||
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 |
...
Overview
Content Tools
Apps