Mit dem kleinen Progrämmchen in XProfan11 kann die untere, maschinenlesbare Zeile des deutschen Personalausweises geprüft werden. Einfach die Angaben entsprechend in die 4 Editfelder eintippen und dann auf "Testen" klicken.
Auf Wunsch kann auch die am Programmanfang stehende Konstante %MinOld auf ein Mindestalter gesetzt sein, dann erfolgt zusätzlich eine Altersprüfung des Ausweisinhabers.
Für die ernsthafte Anwendung sollte die Auswertung geändert werden, damit das Programm nicht so geschätzig ist. Ein eventueller Betrüger soll ja keine Hinweise erhalten, woran man ihn entlarvt hat.
Code
$H Windows.PH
Declare Edit1%, Edit2%, Edit3%, Edit4%, Button%, Ende%, Titel$
Def %MinOld 0 ' Alterangabe in Jahren, wenn Alterprüfung erfolgen soll, ansonsten %MinOld = 0
Titel$ = "Ausweis-Test"
Proc BlockTest ' Prüft Blöcke auf gültige Länge und Prüfziffer
Parameters _Zeile$, _IsLen%
Declare _Len%, _Z%, _S%, _F%, _OrgPruef%
_F% = 7
_Zeile$ = Trim$(_Zeile$)
_Len% = Len(_Zeile$)
If _Len%
If _IsLen% < 0
Case _Len% < Abs(_IsLen%) : Return 9
ElseIf _Islen%
Case _Len% <> _Islen% : Return 9
EndIf
WhileNot _Z% ' Sucht von rechts letzte Ziffer
_OrgPruef% = Ord(Mid$(_Zeile$, _Len%, 1))
' Damit nur Ziffernzeichen berücksichtigt werden
Dec _Len%
Case (_OrgPruef% < 58) And (_OrgPruef% > 47) : _Z% = 1
EndWhile
_OrgPruef% = _OrgPruef% - 48 ' letzte Ziffer ist Prüfzahl
WhileLoop _Len%
_Z% = Ord(Mid$(_Zeile$, &Loop, 1))
' Damit nur Ziffernzeichen berücksichtigt werden
If (_Z% < 58) And (_Z% > 47)
_Z% = _Z% - 48
_S% = _S% + _Z% * _F%
If _F% = 7
_F% = 3
ElseIf _F% = 3
_F% = 1
ElseIf _F% = 1
_F% = 7
EndIf
EndIf
EndWhile
' letzte Ziffer aus Summe nach S% ermitteln
_F% = (_S% \ 10) * 10
_S% = _S% - _F%
Else
_OrgPruef% = -1
EndIf
_S% = _S% - _OrgPruef% ' Differenz aus Prüfzahl und letzte Ziffer der Summe muß 0 sein
Return _S%
EndProc
Proc DateTest ' Testet Datumsangaben auf Gültigkeit
Parameters _Date$
Declare _Y%, _M%, _D%, _DR%, _Err%
_Y% = Val(Mid$(_Date$, 1, 2))
_M% = Val(Mid$(_Date$, 3, 2))
_D% = Val(Mid$(_Date$, 5, 2))
' Schaltjahr ermitteln
' wegen der 2-stelligen Jahresdarstellung vereinfacht
' jedes volle Jahrhundert wird als Schaltjahr behandelt
_Y% = _Y% + 100
If _Y% = 4 * (_Y% \ 4)
_DR% = 29
Else
_DR% = 28
EndIf
If (_M% > 0) And (_M% < 13)
If _D% > 0
Select _M%
CaseOf 1, 3, 5, 7, 8, 10, 12
Case _D% > 31 : _Err% = 2
CaseOf 2
Case _D% > _DR% : _Err% = 2
OtherWise
Case _D% > 30 : _Err% = 2
EndSelect
Else
_Err% = 2 ' ungültiger Tag
EndIf
Else
_Err% = 1 ' ungültiger Monat
EndIf
Return _Err%
EndProc
Proc FromToTest ' Testet die Gültigkeitsdauer
Parameters _Date$
Declare _Y%, _M%, _D%, _YRef%, _MRef%, _DRef%, _RefDate$, _Err%
_Y% = Val(Mid$(_Date$, 1, 2))
_M% = Val(Mid$(_Date$, 3, 2))
_D% = Val(Mid$(_Date$, 5, 2))
_RefDate$ = Date$(3)
_YRef% = Val(Mid$(_RefDate$, 3, 2))
_MRef% = Val(Mid$(_RefDate$, 5, 2))
_DRef% = Val(Mid$(_RefDate$, 7, 2))
If _Y% < _YRef%
_Err% = 1 ' Jahr abgelaufen
ElseIf _Y% = _YRef%
If _M% < _MRef%
_Err% = 2 ' Monat abgelaufen
ElseIf _M% = _MRef%
Case _D% < _DRef% : _Err% = 3 ' Tag abgelaufen
EndIf
EndIf
_Y% = _Y% - 10
Case _Y% < 0 : _Y% = _Y% + 100
If _Y% > _YRef%
_Err% = 4 ' Jahr liegt zu weit voraus
ElseIf _Y% = _YRef%
If _M% > _MRef%
_Err% = 5 ' Monat liegt zu weit voraus
ElseIf _M% = _MRef%
Case _D% > _DRef% : _Err% = 6 ' Tag liegt zu weit voraus
EndIf
EndIf
Return _Err%
EndProc
Proc OldTest
Parameters _Date$
Declare _Y%, _M%, _D%, _YRef%, _MRef%, _DRef%, _RefDate$, _Err%
_Y% = Val(Mid$(_Date$, 1, 2))
_M% = Val(Mid$(_Date$, 3, 2))
_D% = Val(Mid$(_Date$, 5, 2))
_RefDate$ = Date$(3)
_YRef% = Val(Mid$(_RefDate$, 3, 2))
_MRef% = Val(Mid$(_RefDate$, 5, 2))
_DRef% = Val(Mid$(_RefDate$, 7, 2))
_D% = _DRef% - _D%
Case _D% < 1 : Inc _M%
_M% = _MRef% - _M%
Case _M% < 1 : Inc _Y%
_Y% = _YRef% - _Y%
Case _Y% < 0 : _Y% = _Y% + 100
Case _Y% < %MinOld : _Err% = 1
Return _Err%
EndProc
Proc ErrorText ' Anfügen Fehlertexte
Parameters _Err$, _NewErr$
If _Err$ <> ""
_Err$ = _Err$ + "\n" + _NewErr$
Else
_Err$ = _NewErr$
EndIf
Return _Err$
EndProc
Proc Test
Declare _P1%, _P2%, _P3%, _P4%, _P5%, _P6%, _P7%, _P8%, _D$, _Test$
_Test$ = GetText$(Edit1%)
_D$ = Right$(_Test$, 1)
_P1% = BlockTest(_Test$, -8)
_Test$ = GetText$(Edit2%)
_P2% = BlockTest(_Test$, 7)
_P5% = DateTest(_Test$)
' Bei Bedarf Altersprüfung, wenn alle anderen Angaben OK
Case %MinOld : _P8% = OldTest(_Test$)
_Test$ = GetText$(Edit3%)
_P3% = BlockTest(_Test$, 7)
_P6% = DateTest(_Test$)
_P7% = FromToTest(_Test$)
_Test$ = GetText$(Edit1%) + GetText$(Edit2%) + GetText$(Edit3%) + GetText$(Edit4%)
_P4% = BlockTest(_Test$, 0)
' Hier wäre noch denkbar:
' Zum Gültigkeitsdatum (Edit3%) - 10 Jahre muß der Inhaber
' mindestens 14 Jahre als gewesen sein
_Test$ = "" ' leeren, nimmt nun Fehlermeldungen auf
Case _P1% : _Test$ = ErrorText(_Test$, "Dokumentnummer oder ausstellende Behörde ungültig")
Case _P2% : _Test$ = ErrorText(_Test$, "Geburtsdatum ungültig")
Case _P3% : _Test$ = ErrorText(_Test$, "Gültigkeitsdatum ungültig")
Case _P4% : _Test$ = ErrorText(_Test$, "Prüfziffer paßt nicht")
Case _P5% : _Test$ = ErrorText(_Test$, "Geburtsdatum nicht möglich")
Case _P6% : _Test$ = ErrorText(_Test$, "Gültigkeitsdatum nicht möglich")
Case _P7% : _Test$ = ErrorText(_Test$, "Gültigkeit abgelaufen oder vordatiert")
Case _P8% : _Test$ = ErrorText(_Test$, "Mindestalter nicht erreicht")
Case _D$ <> "D" : _Test$ = ErrorText(_Test$, "Kein deutscher Personalausweis")
Case _Test$ = "" : _Test$ = "Dokumentprüfung OK"
MessageBox(_Test$, Titel$, 0)
EndProc
Proc ClearEdits
SetText Edit1%, ""
SetText Edit2%, ""
SetText Edit3%, ""
SetText Edit4%, ""
SetFocus(Edit1%)
EndProc
WindowTitle Titel$
WindowStyle 536
Window 128, 128 - 366, 144
CLS ~GetSysColor(~Color_BtnFace)
TextColor RGB(0, 0, 250), -1
DrawText 4, 4, "Geben Sie die untere Zeile des zu prüfenden"
DrawText 4, 24, "Personalausweises ein"
TextColor 0, -1
DrawText 102, 56, "<<"
DrawText 194, 56, "<"
DrawText 276, 56, "<<<<<"
SetDialogFont ~GetStockObject(~Default_GUI_Font)
Edit1% = Create("Edit", %HWnd, "", 4, 54, 96, 20)
Edit2% = Create("Edit", %HWnd, "", 124, 54, 64, 20)
Edit3% = Create("Edit", %HWnd, "", 208, 54, 64, 20)
Edit4% = Create("Edit", %HWnd, "", 322, 54, 24, 20)
Button% = Create("Button", %HWnd, "Testen", 4, 82, 96, 24)
SetFocus(Edit1%)
WhileNot Ende%
EnableWindow Button%, Len(GetText$(Edit1%)) And Len(GetText$(Edit2%)) And Len(GetText$(Edit3%)) And Len(GetText$(Edit4%))
WaitInput
If %Key = 2
Ende% = 1
ElseIf Clicked(Button%)
Test
ClearEdits
EndIf
EndWhile
Alles anzeigen
Gruß Volkmar