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.


dopisać readln;
bez żadnych parametrów.
Działało w starszych Turbo Paskalach.