Källkoden för /anders.enges/vb/vbtips7.asp

---

<!--#include file="../inc/navstuff.asp" -->
Kontrollerar om ett personsignum är korrekt angivet genom att validera signumets kontrolltecken.<br>
<br>
Användning:<br>
<br>
SignumCheck("101010-101B") ger TRUE<br>
SignumCheck("101010-101A") ger FALSE<br>
<br>
<div class=code>
' Fungerar i Access om vbString byts till 8<br>
' Är väl inte så stolt över GoTo satserna men det bara blev så...<br>
Function SignumCheck(sSigIN)<br>
   Dim sSignum As String<br>
   Dim iRetVal As Integer<br>
   Dim sMellan As String<br>
   Dim lSiffran As Long<br>
   Dim sTecken As String<br>
   Dim iIndexet As Integer<br>
   sTecken = "0123456789ABCDEFHJKLMNPRSTUVWXY"   'OBS! G, I, O, Q fattas<br>
   sSignum = sSigIN & ""      ' för att se till att Signum alltid är ngt<br>
   If sSigIN & "" = "" Then<br>
      GoTo FEEL      ' Godkänn inte tomt<br>
      'GoTo BRA om du accepterar tomt signum<br>
   ElseIf VarType(sSigIN) <> vbString Then   ' vbString är definierat till 8<br>
      GoTo FEEL<br>
   End If<br>
   sMellan = Mid(sSignum, 7, 1)   ' bindetecken?<br>
   If sMellan = "-" Or sMellan = "+" Or sMellan = " " Then<br>
      sSignum = Left(sSignum, 6) & Mid(sSignum, 8, 4)<br>
   End If<br>
   If Len(sSignum) <> 10 Then<br>
      GoTo FEEL<br>
   End If<br>
   If Not IsNumeric(Left(sSignum, 9)) Then<br>
      GoTo FEEL<br>
   End If<br>
   lSiffran = Val(Left(sSignum, 9))<br>
   iIndexet = (lSiffran Mod 31) + 1<br>
   If Right(sSignum, 1) <> UCase(Mid(sTecken, iIndexet, 1)) Then<br>
      GoTo FEEL<br>
   End If<br>
   GoTo BRA<br>
FEEL:<br>
   SignumCheck = False<br>
   Exit Function<br>
BRA:<br>
   SignumCheck = True<br>
End Function
</div>
<!--#include file="../inc/footer.asp" -->