Warsztat: Test poprawności PESEL.

Pesel.zip
Autor: Wojciech Wendrychowicz (Wojciech.Wendrychowicz@ptedom.pl)
Baza w formacie MsAccess 97
19kB, 5 września 2001

Pesel2.zip - uzupełnienie.
Autor: Mariusz (centrum@kcik.gov.pl)
Baza w formacie MsAccess 97
13kB, 13 czerwca 2002

Pesel3.zip - uzupełnienie 2.
Autor: Mariusz Cieciura (m.cieciura@polanglo.pl)
Baza w formacie MsAccess 2000
25kB, 20 listopada 2002

Errata: W przykładach występuje (łatwy do samodzielnego poprawienia) błąd, na który zwrócił uwagę Krzysztof Przeklasa (krzysztof.przeklasa@centertel.pl). Oto post Krzysztofa:
Witam,
przeglądając przykłady zamieszczone w Warsztacie, dotyczące weryfikacji nr
PESEL tzn. Pesel, Pesel2, Pesel3 we wszystkich trzech znalazłem mały błąd.
Występuje on w przypadku, gdy suma kontrolna jest liczbą dwucyfrową (10 a
cyfra kontrolną 0), wtedy bezpośrednie porównanie z cyfrą kontrolną zwraca
fałsz. Rozwiązanie tego problemu jest bardzo proste, korzystając z kawałka
kodu zawartego w Pesel3 (Autor: Mariusz Cieciura)

zamiast:

Sumakontrolna = (D1 + D2 * 3 + D3 * 7 + D4 * 9 + D5 + D6 * 3 + D7 * 7 + D8 *
9 + D9 + D10 * 3)
Cyfrakontrolna =  10 - (Sumakontrolna Mod 10)

powinno być:

Sumakontrolna = (D1 + D2 * 3 + D3 * 7 + D4 * 9 + D5 + D6 * 3 + D7 * 7 + D8 *
9 + D9 + D10 * 3)
Cyfrakontrolna = Right(10 - (Sumakontrolna Mod 10), 1)

pozdrawiam
Krzysiek

Opis problemu:

Jak poznać, czy PESEL został wpisany prawidłowo?

Rozwiązanie:

Rozwiązanie (plik Pesel.zip) przysłał Wojciech Wendrychowicz, oto jego post:

Cześć, mam nadzieję, że mnie nikt nie uprzedził, no i że to się w ogóle komukolwiek przyda: Po utracie fokusu kod sprawdza poprawność numeru PESEL po sumie kontrolnej na końcu i wyrzuca odpowiedni komunikat. Pozdrawiam Wojtek

P.S. Przyda się, przyda! Chyba każdemu, kto w swojej bazie rejestruje takie dane.

Uzupełnienie:

Uzupełnieniem do powyższego jest przykład Pesel2.zip, przysłany przez Mariusza. Oto co pisze Mariusz:

Z wielką radością skorzystałem z procedurki sprawdzenia numeru Pesel według sumy kontrolnej przedstawionej przez Pana Wojciecha Wendrychowicza. Pozwoliłem sobie uzupełnić moduł o sprawdzenie wprowadzenia wyłącznie cyfr oraz przejścia do następnych formantów. Pozdrawiam Mariusz

Uzupełnienie 2:

Mariusz Cieciura przysłał uzupełnienie nr 2 do programu sprawdzającego PESEL. Teraz na podstawie tego numeru, program wpisuje datę urodzenia i płeć. Ten pomysł na pewno spodoba się użytkownikom naszego oprogramowania, może nawet ktoś zawoła "Ale czary, jaki ten komputer mądry!". Nie byłoby to niemiłe...
Oto post Mariusza:

Chciałem wtrącić swoje trzy grosze do testu poprawności PESELa. Zmodyfikowałem trochę przykład PESEL2 przenosząc funkcje z formularza do modułów i dodając do niej nowe możliwości tj. sprawdzanie płci i wyliczanie daty urodzin (w zakresie od 01.01.1900 do 31.12.2099 myśle ze dalej nie trzeba ;-)) Składnia funkcji: Sprawdz_Pesel(Nr_PESEL As Variant, Opcja As Byte) gdzie Opcja może mieć wartości 1,2,3: ' Funkcja zwraca wartość zależną od wartości opcji ' Opcja może mieć jedną z trzech wartości ' 1 sprawdza poprawność PESELa zwracając wartość True lub False ' 2 sprawdza płeć osoby zwracając wartość K dla kobiety lub M dla mężczyzny ' 3 zwraca datę urodzenia osoby Mam nadzieje, ze się przyda. Pozdrawiam, Mariusz Cieciura

PESEL można sprawdzić także w sposób podany przez Leszka Żura. A oto, co pisze Leszek:

Ja zrobiłem tak: Pod pole gdzie wpisuje się pesel (u mnie nazywa się Tekst36) podpiąłem zdarzenie "Po aktualizacji", które wywołuje procedurkę: 
Private Sub Tekst36_AfterUpdate()
On Error GoTo Err_Tekst36_AfterUpdate

Dim  Odp, C
Odp = vbOK

If Len([Tekst36]) <> 11 Then
    Odp = Odp * MsgBox("Zła dlugość Peselu", vbOKCancel)
End If
If Odp = vbOK And Len([Tekst36]) = 11 Then
    C = ((Mid([Tekst36], 1, 1) * 1 + Mid([Tekst36], 2, 1) * 3 +
Mid([Tekst36], 3, 1) * 7 + Mid([Tekst36], 4, 1) * 9 + Mid([Tekst36], 5, 1) *
1 + Mid([Tekst36], 6, 1) * 3 + Mid([Tekst36], 7, 1) * 7 + Mid([Tekst36], 8,
1) * 9 + Mid([Tekst36], 9, 1) * 1 + Mid([Tekst36], 10, 1) * 3 +
Mid([Tekst36], 11, 1) * 1) Mod 10)
    If C > 0 Then
        Odp = Odp * MsgBox("Złe CRC Peselu wynosi " & [C], vbOKCancel)
    End If
End If

'TUTAJ ROBISZ COS Z TYM PESELEM JAK JEST OK

Err_Tekst36_AfterUpdate:
    MsgBox Err.Description
    Resume Exit_Tekst36_AfterUpdate
End Sub
Ja mam wprawdzie A2000 ale nie powinno być różnic. Pozdrawiam - Leszek Żur