Ρουτίνα ελέγχου Εγκυρότητας ΑΦΜ

Δείτε επίσης: Μετατροπή ενός ποσού σε περιγραφή (ολογράφως)

Οι παρακάτω αλγόριθμοι ελέγχουν την ορθότητα ενός αριθμού Α.Φ.Μ.

Είναι προφανές ότι ο αλγόριθμος ΑΦΜ δεν ελέγχει αν το ΑΦΜ πραγματικά υπάρχει ή αν πραγματικά αντιστοιχεί σε κάποιο φυσικό/νομικό πρόσωπο.

Ο κώδικας είναι ελεύθερος προς χρήση. Αν θέλετε αφήστε τα σχόλια άθικτα ;-)

UPDATE: O αρχικός αλγόριθμος δημιουργούσε πρόβλημα όταν το τελευταίο ψηφίο είναι 0 (μηδέν) και υπάρχει μια συγκεκριμένη ακολουθία ψηφίων (iSum mod 11 =10). H γραμμή που άλλαξε είναι με έντονα γράμματα.
Παρακαλώ ενημερώστε τον κωδικά σας!

Visual Basic, Visual Basic For Applications

Δημιουργήστε ένα νέο Module και αντιγράψτε τον παρακάτω κώδικα:

Public Function CheckAFM(sAFM As String) As Boolean
' Validate an AFM number
' Pre: sAFM = string containing the AFM
' Post: True if sAFM is a valid AFM, False otherwise
' NOTE: This algorithm does NOT check if the AFM actually exists, only if it is a valid number!
' Usage Example: a=CheckAFM("012345678")->a=False
' Yiannis Papadopoulos <www.yiapap.com> 2004
Dim iSum As Integer
Dim btRem As Byte
Dim i As Byte

If sAFM = "" Or Len(sAFM) <> 9 Then
CheckAFM = False
Exit Function
End If

iSum = 0
CheckAFM = False

For i = 1 To Len(sAFM) - 1
If Asc(mID(sAFM, i, 1)) < 48 Or Asc(mID(sAFM, i, 1)) > 57 Then
CheckAFM = False
Exit Function
End If
iSum = iSum + Val(mID(sAFM, i, 1)) * (2 ^ (Len(sAFM) - i))
Next i

If iSum = 0 Then
CheckAFM = False
Else
btRem = iSum Mod 11
If Val(Right(sAFM, 1)) = btRem Or (btRem = 10 And Val(Right(sAFM, 1)) = 0) Then CheckAFM = True
End If
End Function

ASP Script (VBScript)

Αντιγράψτε τον παρακάτω κώδικα σε οποιοδήποτε σημείο της ASP σελίδας σας (συνίσταται η κορυφή)

<%Function CheckAFM(sAFM)
' Validate an AFM number
' Pre: sAFM = string containing the AFM
' Post: True if sAFM is a valid AFM, False otherwise
' NOTE: This algorithm does NOT check if the AFM actually exists, only if it is a valid number!
' Usage Example: a=CheckAFM("012345678")->a=False
' Yiannis Papadopoulos <yiapap> 2004
Dim iSum
Dim btRem
Dim i
on error resume next
If sAFM = "" Then
CheckAFM = False
Exit Function
End If

iSum = 0
CheckAFM = False
For i = 1 To Len(sAFM) - 1
If Asc(mID(sAFM, i, 1)) < 48 Or Asc(mID(sAFM, i, 1)) > 57 Then
CheckAFM = False
Exit Function
End If
iSum = iSum + mid(sAFM, i, 1) * (2 ^ (Len(sAFM) - i))
Next
if iSum=0 then
Exit Function
else
btRem = iSum Mod 11
If int(Right(sAFM, 1)) = btRem Or (btRem = 10 And int(Right(sAFM, 1)) = 0) Then
CheckAFM = True
else
CheckAFM=False
end if
end if
End Function%>

Home