algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

PESEL - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 6
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 06 października 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

Pesel_d/Pesel_d.dpr:
//
// @author Tomasz Lubinski
// www.algorym.org
// (c) 2005
//
// PESEL
//

program Pesel_d;
{$APPTYPE CONSOLE}
uses
  SysUtils;

var
  PESEL : array [0..10] of Integer;
  valid : boolean;
  PESELStr : String;

function getBirthYear(): integer;
var
        year : integer;
	month : integer;
begin

	year := 10 * PESEL[0];
	year := year + PESEL[1];
	month := 10 * PESEL[2];
	month := month + PESEL[3];
	if (month > 80) and (month < 93) then
		year := year + 1800
	else if (month > 0) and (month < 13) then
		year := year + 1900
	else if (month > 20) and (month < 33) then
		year := year + 2000
	else if (month > 40) and (month < 53) then
		year := year + 2100
	else if (month > 60) and (month < 73) then
		year := year + 2200;
	result := year;
end;

function getBirthMonth(): integer;
var
	month : integer;
begin
	month := 10 * PESEL[2];
	month := month + PESEL[3];
	if (month > 80) and (month < 93) then
        	month := month -80
	else if (month > 20) and (month < 33) then
		month := month - 20
	else if (month > 40) and (month < 53) then
		month := month - 40
	else if (month > 60) and (month < 73) then
		month := month - 60;
	result := month;
end;

function getBirthDay(): integer;
var
	day : integer;
begin
	day := 10 * PESEL[4];
	day := day + PESEL[5];
	result := day;
end;

function getSex(): string;
begin
	if (valid) then
		if (PESEL[9] mod 2 = 1) then
			result := 'Mezczyzna'
		else
			result := 'Kobieta'
	else
		result := '---'
end;

function checkSum(): boolean;
var
        sum : integer;
begin
	sum := 1 * PESEL[0] +
	       3 * PESEL[1] +
 	       7 * PESEL[2] +
 	       9 * PESEL[3] +
	       1 * PESEL[4] +
	       3 * PESEL[5] +
	       7 * PESEL[6] +
	       9 * PESEL[7] +
	       1 * PESEL[8] +
	       3 * PESEL[9];
	sum := sum mod 10;
	sum := 10 - sum;
	sum := sum mod 10;

	if (sum = PESEL[10]) then
                result := true
	else
                result := false;
end;

function checkMonth(): boolean;
var
        month : integer;
begin
	month := getBirthMonth();
	if (month > 0) and (month < 13) then
		result := true
	else
                result := false;
end;

function leapYear(year: integer): boolean;
begin
	if (year mod 4 = 0) and (year mod 100 <> 0) or (year mod 400 = 0) then
        	result := true
	else
                result := false;
end;

function  checkDay(): boolean;
var
	year : integer;
	month : integer;
	day : integer;
begin
	year := getBirthYear();
	month := getBirthMonth();
	day := getBirthDay();
	if ((day >0) and (day < 32) and
	    ((month = 1) or (month = 3) or (month = 5) or
 	     (month = 7) or (month = 8) or (month = 10) or
 	     (month = 12))) then
  		result := true
	else if ((day >0) and (day < 31) and
		((month = 4) or (month = 6) or (month = 9) or
                 (month = 11))) then
		result := true
	else if (((day >0) and (day < 30) and (leapYear(year))) or
                 ((day >0) and (day < 29) and not(leapYear(year)))) then
		result := true
	else
                result := false;
end;

procedure PeselValidator(PESELNumber: String);
var
        i : integer;
begin

        if (length(PESELNumber) <> 11) then
		valid := false
	else
           begin
		for i := 0 to 10  do
			PESEL[i] := StrToInt(PESELNumber[i+1]);
		if (checkSum()) and (checkMonth()) and (checkDay()) then
			valid := true
		else
			valid := false;
            end;
end;

begin
        writeln('Podaj numer PESEL');
        readln(PESELStr);

        PeselValidator(PESELStr);

        if valid then
           begin
        	writeln('Numer PESEL jest prawidlowy');
        	writeln('Rok urodzenia: ' + IntToStr(getBirthYear()));
        	writeln('Miesiac urodzenia: ' + IntToStr(getBirthMonth()));
        	writeln('Dzien urodzenia: ' + IntToStr(getBirthDay()));
        	writeln('Plec: ' + getSex());
           end
        else
           begin
        	writeln('Numer PESEL jest nieprawidlowy');
           end;
end.
Komentarze
photo
0 # kame89 2013-12-16 14:31
Może ktoś to tak przerobić żeby czekało aż użytkownik naciśnie Enter
Odpowiedz | Odpowiedz z cytatem | Cytować
photo
0 # Romek 2014-01-25 15:41
Przed ostatnim end.
dopisać readln;
bez żadnych parametrów.
Działało w starszych Turbo Paskalach.
Odpowiedz | Odpowiedz z cytatem | Cytować
Dodaj komentarz