Pascal užduotis

program Gimtadienis;

Const   Cduom = 'U1.txt';
       Crez  = 'U1rez.txt';


Var     yy,
       mm,
       dd,
       klaida    : integer;
       data      : string;
       Kelemieji : boolean;
       F, B      : text;
{------------------------Funkcijos ir procedûros------------------------------}
Procedure nuliukas(var strc : string; x : integer);
Begin
   if x >= 10 then str(x, strc)
              else
                begin
                 str(x, strc);
                 strc := '0' + strc;
                end;
End;

Procedure Rasyti(a, b : integer);
Var stra, strb : string;
Begin
   nuliukas(stra, a);
   nuliukas(strb, b);
   WriteLn(F, yy,'-',stra,'-',strb);
End;

procedure tikrinti(a, b : integer);
Var tinkaa, tinkab : boolean;
   maxb           : integer;
Begin
maxb := 0;
tinkaa := false;
tinkab := false;
   if a <= 12                     then
   begin
    tinkaa := true;
    if (a = 1)  or (a = 3)  or
       (a = 5)  or (a = 7)  or
       (a = 8)  or (a = 10) or
       (a = 12)                      then maxb := 31
                                    else
    begin
    if (a = 2)                       then
    if kelemieji = true              then maxb := 29
                                     else maxb := 28;
                                          maxb := 30;
    end
   end
                                  else tinkaa := false;
   if b <= maxb                   then tinkab := true
                                  else tinkab := false;
   if (tinkaa = true) and (tinkab = true) then Rasyti(a, b)
                                          else
                                          begin
                                           klaida := klaida + 1;
                                           if klaida = 2 then
                                           WriteLn(F, 'NETEISINGA');
                                          end;
End;

Procedure mmdd(var x, y : integer);
Var str : string;
   er  : integer;
Begin
  str := copy(data,1,2);
  val(str, x, er);
  str := copy(data,4,2);
  val(str, y, er);
End;

Function arkelemi : boolean;
Begin
   If yy mod 4 = 0 then arkelemi := true
                   else arkelemi := false;
End;

Procedure spresti;
var m, me, d : string[2];
   er : integer;
Begin

   m := copy(data,7,2);
   val(m, yy, er);
   if yy <= 6 then yy := 2000 + yy
              else yy := 1900 + yy;
   kelemieji := arkelemi;

   Assign(F, Crez); ReWrite(F);
   mmdd(mm,dd);
   tikrinti(mm,dd);
   mmdd(dd,mm);
   tikrinti(mm,dd);

   Close(F);
End;


Procedure Duomenys;
Begin
klaida := 0;
Assign(B, Cduom); Reset(B);
   ReadLn(B, data);
Close(B);
End;

{--------------------------Pagrindinë programa--------------------------------}

begin
 Duomenys;
 spresti;
end.

program mokslininkas;

Const Cduom  = 'U1.txt';
     Crez   = 'U1rez.txt';
     dienos = 3;
     Cmax   = 50;

Type  en     = 2..100000;
     ce     = 2..50;

Var   N       : en;
     C       : ce;
     blusos,
     buvo    : integer;

{-------------------------Funkcijos ir procedûros-----------------------------}
Procedure Rasyti;
Var F   : text;
Begin
Assign(F, Crez); ReWrite(F);
   WriteLn(F,buvo, ' ',N);
Close(F);
End;


Function Skaiciuoti: integer;
Var i, x, k, y : integer;
Begin
buvo := 0;
For i := 2 to Cmax do
Begin
k    := blusos;
y    := 0;
   For x := 1 To dienos Do
       If k mod i = 0 Then
       Begin
           k := k div i;
           y := y + 1;
           If y = 3 Then
           begin
               Skaiciuoti := i;
               buvo       := k;
           End;
       End;
End;
End;

Procedure Duomenys;
Var B : text;
Begin
Assign(B, Cduom); Reset(B);
   ReadLn(B, blusos);
Close(B);
End;
{---------------------------Pagrindinë programa-------------------------------}
begin
 Duomenys;
 N := Skaiciuoti;
 Rasyti;
end.