El programa permite calcular la diferencia entre dos fechas, expresando la misma en años, meses y dias.
Tiene un error cuando el dia de salida es en el mes de febrero.

{Seccion declarativa}
 
program Fechas;
{programa que calcula el tiempo entre dos fechas}
{expresado en dias, meses y años}
{permite controlar cuanto tiempo trabajo un empleado}
 
{definicion de recursos}
 
uses
 
crt,dos;
 
 
var
di,mi,ai,de,me,ae:integer; {dia, mes y año de ingreso/egreso}
dt,mt,at:integer; {dias, meses y años trabajados}
dfeb:integer; {dias de febrero}
diasmi:integer; {dias del mes de ingreso}
diast,mesest,anost:char;
{seccion algoritmica}
 
begin
 
{ingreso de datos}                      
 
	clrscr;                 
	writeln('Hola, ingrese la fecha de ingreso con el siguiente formato y presione enter');
	writeln('dd mm aaaa');
	readln(di,mi,ai);
	writeln('muy bien, ahora ingrese la fecha de egreso del mismo modo y presione enter');
	readln(de,me,ae);
 
{resolucion}
 
	if (mi=2)
	then
       		if (ai mod 4=0)
       		then
          			if (ai mod 100=0) and (ai mod 400<>0)
           			then
           			dfeb:=28
           			else
           			dfeb:=29
       		else
       		dfeb:=28;
 
 
	at:=abs(ae-ai);
	mt:=abs(me-mi);
	dt:=abs(de-di)+1;
 
 
	if (mi>=me)
   	then
       		begin
           	at:=at-1;
           	mt:=(12-mi)+me;
           	if di>de
              		then
              		begin
              		mt:=mt-1;
              		case mi of
               			1,3,5,7,8,10,12:diasmi:=31;
               			2:diasmi:=dfeb;
               			4,6,9,11:diasmi:=30;
               		end;
 
               	dt:=(diasmi-di)+de+1;
             	end;
	end;
 
 
 
	if (di>de) then
           if (ai=ae) or (mi<me) then
   	   	begin
       		mt:=mt-1;
       		case mi of
       			 1,3,5,7,8,10,12:diasmi:=1;
               		 2:diasmi:=dfeb;
               		 4,6,9,11:diasmi:=30;
                end;
 
       		dt:=(diasmi-di)+de+1;
       end;
 
 
	if mt>=12
   	then
	begin
   		at:=at+1;
   		mt:=mt-12;
        end;
 
 
{epilogo}
{exhibicion de resultados}
 
	if at=0 then
           if mt=0 then
              begin
              clrscr;
              writeln('La persona en cuestion trabajo ',dt,' dia/s');
              readln;
              end
           else
              begin
              clrscr;
              writeln('La persona en cuestion trabajo ',dt,' dia/s y ',mt,' mes/es');
              readln;
              end
         else
             if mt=0 then
                begin
                clrscr;
                writeln('La persona en cuestion trabajo ',dt,' dia/s y ',at,' a¤o/s');
                readln;
                end
             else
                 begin
                 clrscr;
                 writeln('La persona en cuestion trabajo ',dt,' dia/s, ',mt,' mes/es y ',at,' a¤o/s');
                 readln;
          end
end.

El programa calcula las raices de una función cuadrática por el metodo de aproximaciones
sucesivas. Se pide el ingreso de los coeficientes de la funcíón, el intervalo de busqueda
y la presición deseada. Funciona perfectamente.

{Seccion declarativa}
{Objetivo del programa}
   Program Calculo_de_raices;
   {El programa permite calcular las raices simples de la funcion
   f=a2x^2+a1x+a0 por metodo de aproximaciones sucesivas}
{Definicion de recursos}
   Uses
     Crt;
   Var
     a {limite inferior}, b {limite superior}: Real;
     p {paso de busqueda}, pr {presicion deseada}: Real;
     c {resultado parcial}, d {resultado parcial}: Real;
     e {resultado parcial}, f {resultado parcial}: Real;
     g {resultado parcial}: Real;
     a2,a1,a0:Real; {coeficientes de la funcion}
     preg:char; {busqueda de otra raiz}
 
   Function fx(x:real):real;
	begin
	fx:=a2*x*x+a1*x+a0
	end;
 
{Seccion algoritmica}
{Desarrollo de la solucion}
   Begin
   {Prologo}
       {Limpieza de pantalla}
          ClrScr;
       {Presentacion del programa}
        {Escribir titulo en pantalla}
          Writeln('Calculo de raices simples de f=a2x^2+a1x+a0');
          Writeln;
          Writeln('El programa realiza el calculo de raices simples');
          Writeln('de la funcion f=a2x^2+a1x+a0 por aproximacion sucesiva.');
       {Obtencion de datos}
          Writeln;
	  Writeln('Ingrese los coeficientes de la funcion separados por un');
	  Writeln('espacio y presione enter "a2 a1 a0"');
          Readln(a2,a1,a0);
	  Writeln;
          Writeln('Ingrese el limite inferior del intervalo');
          Write('deseado para buscar raices: ');
          Readln(a);
          Writeln;
          Writeln('Ingrese el limite superior del intervalo');
          Write('deseado para buscar raices: ');
          Readln(b);
          Writeln;
          Writeln('Ingrese el paso de busqueda requerido: ');
          Readln(p);
          Writeln;
          Writeln('Ingrese precision en el calculo de las raices: ');
          Readln(pr);
          Writeln;
      {Resolucion}
          a:= a-p;
          Repeat
            a:= a+p;
            c:= fx(a);
            d:= a;
            d:= d+p;
            e:= fx(d);
          Until (c*e<0) or (d>b);  {Obtencion del intervalo <=pr}
            If d>b    {Caso que no existen raices}
              Then
                Begin
                  Writeln;
                  Writeln('No hay raices de la funcion en el intervalo de busqueda');
                  Writeln;
                  Writeln('Presione Enter para volver a la pantalla de edicion');
                  Readln;
                End
              Else
                Begin
                   Repeat                     {Acotacion del intervalo en mitades}
                      c:= fx(a);
                      e:= fx(d);
                      f:= (a+d)/2;
                      g:= fx(f);
                        If g*c<0
                          Then
                            Begin
                              d:= f;
                            End
                          Else
                            Begin
                              a:= f;
                            End
                   Until (Abs(g)<=pr) or (Abs(c)<=pr) or (Abs(e)<=pr);
 
      {Epilogo}
         {Exhibicion del resultado en pantalla}
                 Write('La raiz es: ', F:2:6);
                 Write(#241, Pr:1:6);
                 Writeln;
                 Readln;
                 Write('¨Desea buscar otra raiz? s/n  ');
                 Readln(preg);
                 Writeln;
                 If preg='s' then
                    Begin
                    a:=f;
                    Repeat
                          a:= a+p;
                          c:= fx(a);
                          d:= a;
                          d:= d+p;
                          e:= fx(d);
                    Until (c*e<0) or (d>b);  {Obtencion del intervalo <=pr}
                          If d>b    {Caso que no existen raices}
                             Then
                             Begin
                             Writeln;
                             Writeln('No hay raices de la funcion en el intervalo de busqueda');
                             Writeln;
                             Writeln('Presione Enter para volver a la pantalla de edicion');
                             Readln;
                             End
                          Else
                             Begin
                             Repeat       {Acotacion del intervalo en mitades}
                             c:= fx(a);
                             e:= fx(d);
                             f:= (a+d)/2;
                             g:= fx(f);
                                 If g*c<0
                                    Then
                                    Begin
                                    d:= f;
                                    End
                                 Else
                                    Begin
                                    a:= f;
                                    End
                             Until (Abs(g)<=pr) or (Abs(c)<=pr) or (Abs(e)<=pr);
 
      {Epilogo}
         {Exhibicion del resultado en pantalla}
                 Write('La otra raiz es: ', F:2:6);
                 Writeln(#241, Pr:1:6);
                 Writeln;
                 Writeln('No hay mas raices');
                 Writeln;
                 Writeln('Gracias por utilizar el programa');
                 Readln;
 
                          End
                 End
                 Else
                     Writeln('Gracias por utilizar el programa');
                     Readln;
 
 
 
 
                 End;
 
End.