Rubrik: Variablen/Strings · Algorithmen/Mathematik | VB-Versionen: VB6 | 29.07.10 |
Personalausweisnummer auf Gültigkeit prüfen Eine Funktion, mit der sich deutsche Personalausweisnummern auf Gültigkeit prüfen lassen. | ||
Autor: Dieter Otter | Bewertung: | Views: 14.439 |
www.tools4vb.de | System: Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Mit nachfolgendem Code lässt sich die Nummer eines deutschen Personalausweises auf Gültigkeit prüfen. Die Funktion prüft ermittelt hierzu die Prüfziffern der einzelnen Nummernblöcke und vergleicht diese mit der in der Nummer selbst angegebenen Prüfziffer. Optional lässt sich beim Aufruf der Funktion noch angeben, ob zusätzlich auch das Geburtsdatum sowie das Ablaufdatum auf korrekte Datumsangabe hin geprüft werden soll.
Anmerkung:
Eine deutsche Personalausweisnummer ist wie folgt aufgebaut:
aaaabbbbbPD<<ccccccP<ddddddP<<<<<<<P
- aaaa = Behördenkennziffer
- bbbbb = fortlaufende Nummer
- D = Kennung für Deutschland
- cccccc = Geburtsdatum im Format yymmdd
- dddddd = Ablaufdatum im Format yymmdd
- P = Prüfziffern
Und hier die Funkition PersoCheckNumber
' Prüft die Gültigkeit der angegebenen Personalsausweisnummer ' (nur für Deutschland!) Public Function PersoCheckNumber(ByVal sNumber As String, _ Optional ByVal bCheckDate As Boolean = False) As Boolean Dim bResult As Boolean ' alle "<"-Zeichen ausfiltern sNumber = Replace(sNumber, "<", "") ' Handelt es sich um einen deutschen Personalausweis? If Len(sNumber) = 26 And Mid$(sNumber, 11, 1) = "D" Then sNumber = Left$(sNumber, 10) & Mid$(sNumber, 12) ' Prüfziffer 1. Block (Behörde) If PersoGetPZ(Left$(sNumber, 9)) = Mid$(sNumber, 10, 1) Then ' GebDatum auf gültiges Datum prüfen If bCheckDate Then If Not PersoIsDate(Mid$(sNumber, 11, 6)) Then Exit Function End If ' Prüfziffer 2. Block (GebDatum) If PersoGetPZ(Mid$(sNumber, 11, 6)) = Mid$(sNumber, 17, 1) Then ' Ablaufdatum auf gültiges Datum prüfen If bCheckDate Then If Not PersoIsDate(Mid$(sNumber, 18, 6)) Then Exit Function End If ' Prüfziffer 3. Block (Ablaufdatum) If PersoGetPZ(Mid$(sNumber, 18, 6)) = Mid$(sNumber, 24, 1) Then ' Gesamtprüfziffer If PersoGetPZ(Mid$(sNumber, 1, 24)) = Mid$(sNumber, 25, 1) Then bResult = True End If End If End If End If End If PersoCheckNumber = bResult End Function
' Hilfsfunktion: Ermittelt die Prüfziffer der ' angegebenen Ziffernfolge Private Function PersoGetPZ(ByVal sNumber As String) As String Dim i As Long Dim bError As Boolean ReDim nSum(2) As Long For i = 1 To Len(sNumber) Select Case Asc(Mid$(sNumber, i, 1)) Case 48 To 57 ' nur Ziffern erlaubt! Case Else ' Prüfung abbrechen bError = True Exit For End Select Next i If Not bError Then ' Quersumme berechnen For i = 1 To Len(sNumber) Step 3 nSum(0) = nSum(0) + (Val(Mid$(sNumber, i, 1))) nSum(1) = nSum(1) + (Val(Mid$(sNumber, i + 1, 1))) nSum(2) = nSum(2) + (Val(Mid$(sNumber, i + 2, 1))) Next i PersoGetPZ = Right$(CStr(nSum(0) * 7 + nSum(1) * 3 + nSum(2)), 1) End If End Function
' Hilfsfunktion: Prüft, ob es sich um eine ' gültige Datumsangabe handelt Private Function PersoIsDate(ByVal sNumber As String) As Boolean Dim bResult As Boolean Dim nMonth As Long Dim nDay As Long nMonth = Val(Mid$(sNumber, 3, 2)) nDay = Val(Mid$(sNumber, 5, 2)) If nMonth > 0 And nMonth < 13 Then Select Case nMonth Case 1, 3, 5, 7, 8, 10, 12 If nDay > 0 And nDay < 32 Then bResult = True Case 2 If nDay > 0 And nDay < 30 Then bResult = True Case Else If nDay > 0 And nDay < 31 Then bResult = True End Select End If PersoIsDate = bResult End Function