Ρουτίνα ελέγχου ΑΦΜ (VB/VBA,ASP/VBScript)

[yiapap]

Και για να το ξεκινήσουμε το νέο forum, να μια χρήσιμη ρουτίνα:

Έλεγχος ΑΦΜ
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%>