vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB629.07.10
Personalausweisnummer auf Gültigkeit prüfen

Eine Funktion, mit der sich deutsche Personalausweisnummern auf Gültigkeit prüfen lassen.

Autor:   Dieter OtterBewertung:  Views:  14.439 
www.tools4vb.deSystem:  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



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.