Pascal/Turbo Pascal - programa que diga estacion del año

Hola:
Necesito ayuda para hacer un programa en Pascal.Acabo de empezar y me cuesta un poco, y lo necesito para la semana que viene.

Escribir un programa en Pascal que:


1.Lea desde el teclado una fecha (con su día, mes y año) y realice las comprobaciones necesarias para que la fecha introducida sea una fecha válida.
2.En caso de que la fecha introducida sea correcta, muestre por pantalla a qué estación del año se corresponde la fecha introducida.
3.En caso contrario el programa muestra un mensaje de error y se acaba la ejecución.
4.Detecte los posible errores en tiempo de ejecución a través del mecanismo try-except visto en clase: en caso de que el usuario introduzca mal un dato de entrada, el programa visualizará un mensaje apropiado y terminará (sentencia exit).

{Espero te sirva de ayuda este programa lo puedes mejorar esto es un ejemplo para
aprender las bases suerte}

program fechaent;
uses
crt, dos;

var
dato : string[12];
cont : integer;
tecla : char;
estacion : string[10];
d1, d2, d3, salir : boolean;
fech : string[4];
dia, mes : integer;

function stringinteger(s : string) : integer;
var
r : integer;
er : integer;
begin
val(s,r,er);
stringinteger := r;
end;


function fecha : string;
begin
fillchar(dato,12,' ');
dato[0] := chr(11);
cont := 1;
textcolor(15);
gotoxy(2,10);write('Entre Fecha : ');
gotoxy(17,10);
fecha := ' ';
repeat
tecla := readkey;
if tecla in [#47..#57,#8,#13,#27] then
begin
if tecla in[#13,#27,#8] then
begin
end
else
begin
dato[cont] := tecla;
dato[0] := chr(cont);
gotoxy(16 + cont,10);write(dato[cont]);
cont := cont + 1;
if cont > 11 then
begin
cont := 11;
sound(300);
delay(190);
nosound;
end;
end;
end
else
begin
sound(200);
delay(120);
nosound;
gotoxy(4,20);write('Tecla Invalida...');
delay(300);
gotoxy(4,20);write(' ');
end;
if tecla = #8 then
begin
cont := cont - 1;
if cont < 1 then
cont := 1;
dato[cont] := ' ';
dato[0] := chr(cont);
gotoxy(16 + cont,10);write(' ');
gotoxy(16 + cont,10);write(dato[cont]);
end;
if tecla = #13 then
begin
d1 := false;
d2 := false;
d3 := false;
fillchar(fech,5,' ');
fech[0] := chr(4);
if dato[3] <> '/' then
insert('0',dato,1);
if dato[6] <> '/' then
insert('0',dato,4);
fech := copy(dato,1,2);
if stringinteger(fech) < 32 then
begin
d1 := true;
end;
fillchar(fech,5,' ');
fech[0] := chr(4);
fech := copy(dato,4,2);
if stringinteger(fech) < 13 then
begin
d2 := true;
end;
fillchar(fech,5,' ');
fech[0] := chr(4);
fech := copy(dato,7,4);
if stringinteger(fech) < 5000 then
begin
d3 := true;
end;
if (d1 = true) and (d2 = true) and (d3 = true) then
begin
salir := true
end
else
begin
clrscr;
gotoxy(10,10);write('*** ENTRADA DE FECHA INVALIDA ***');
delay(500);
exit;
end;
end;
until (salir = true) or (tecla = #27);
if salir = true then
begin
clrscr;
fillchar(fech,5,' ');
fech[0] := chr(4);
fech := copy(dato,1,2);
dia := stringinteger(fech);
fillchar(fech,5,' ');
fech[0] := chr(4);
fech := copy(dato,4,2);
mes := stringinteger(fech);
if mes = 12 then
mes := 0;
case mes of
0,1,2 : begin
if (dia > 5) and (mes >= 0) then
fecha := 'Imbierno'
else
fecha := 'Oto¤o';
end;
3,4,5 : begin
if (dia > 2) and (mes >= 3) then
fecha := 'Primavera'
else
fecha := 'Imbierno';
end;
6,7,8 : begin
if (dia > 4) and (mes >= 6) then
fecha := 'Verano'
else
fecha := 'Primavera';
end;
9,10,11 : begin
if (dia > 3) and (mes >= 9) then
fecha := 'Oto¤o'
else
fecha := 'Verano';
end;
end;
end;
end;


begin
clrscr;
estacion := fecha;
gotoxy(3,10);write(dato,' = ',estacion);
gotoxy(20,20);write('PULSE UNA TECLA PARA SALIR');
repeat until keypressed;
end.

Pasese por tutorías. Le estamos esperando.

FI_CUD

Suponiendo que sea un profesor del cud que nota le daría a este programa???

program Enigma;
uses crt;
var
vec:array[1..28] of char;
Rot1_out,Rot1_in,Rot2_out,Rot2_in,Refl_out,Refl_in,aux:string[28];
Ini1,Ini2:char;
i,n,u,x,fil,col:integer;
b:string;
mensaje:string;


begin {Toma Inicial de datos}
(*textcolor(8);
writeln('/////\\\\\');
writeln('! !');
writeln('\\\\\/////');
writeln;
delay(200);
textcolor(6);
gotoxy(3,2);write('E'); delay(200);
gotoxy(4,2);write('N'); delay(200);
gotoxy(5,2);write('I'); delay(200);
gotoxy(6,2);write('G'); delay(200);
gotoxy(7,2);write('M'); delay(200);
gotoxy(8,2);write('A'); delay(200);
textcolor(8);
gotoxy(18,1);write('M');delay(200);
gotoxy(19,2);write('A');delay(200);
gotoxy(20,3);write('D');delay(200);
gotoxy(21,4);write('E');delay(200);
gotoxy(22,2);write('B');delay(200);
gotoxy(23,3);write('Y');delay(200);
gotoxy(24,1);write('N');delay(200);
gotoxy(25,2);write('O');delay(200);
gotoxy(26,3);write('O');delay(200);
gotoxy(27,4);write('N');delay(200);
gotoxy(28,5);write('E');delay(400);
clrscr;*)
textcolor(8);
writeln('/////\\\\\');
writeln('! !');
writeln('\\\\\/////');

textcolor(6);
gotoxy(3,2);write('E');
gotoxy(4,2);write('N');
gotoxy(5,2);write('I');
gotoxy(6,2);write('G');
gotoxy(7,2);write('M');
gotoxy(8,2);write('A');
textcolor(15);

delay(400);gotoxy(1,5);
textcolor(15);
write('Introduzca posicion inicial del primer Rotor: ');
readln(Ini1);


write('Introduzca posicion inicial del segundo Rotor: ');
readln(Ini2);

writeln;
writeln;

writeln('_____CONFIG. ROTORES : ',Ini1,',',Ini2,'_________________________');
writeln;

{Config. inicial de Rotores (Internos y externos)}

Rot1_in:=' .ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Rot1_out:='EKMFLG DQVZNTOWY.HXUSPAIBRCJ';
Rot2_in:=' .ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Rot2_out:='AJDKSIR.UXBLHWTMCQGZNP YFVOE';
Refl_in:=' .ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Refl_out:='. YRUHQSLDPXNGOKMIEBFZCWVJAT';
vec:=Rot1_in;

{Permutacion del 1ºRotor}
for i:=1 to length(Rot1_in) do

if Rot1_in[i]=Ini1 then
begin
aux:=copy(Rot1_in,1,i-1);
delete(Rot1_in,1,i-1);
Rot1_in:=Rot1_in+aux;

aux:=copy(Rot1_out,1,i-1);
delete(Rot1_out,1,i-1);
Rot1_out:=Rot1_out+aux;
x:=i;

end;

{Permutacion del 2ºRotor}
for i:=1 to length(Rot2_in) do

if Rot2_in[i]=Ini2 then
begin
aux:=copy(Rot2_in,1,i-1);
delete(Rot2_in,1,i-1);
Rot2_in:=Rot2_in+aux;

aux:=copy(Rot2_out,1,i-1);
delete(Rot2_out,1,i-1);
Rot2_out:=Rot2_out+aux;
end;

{Muestra Rotores permutados}

writeln; {Vector Inicial}
write('Vector inicial: [');
textcolor(11);
write(vec);
textcolor(15);
writeln(']');
writeln;

writeln; {1ºRotor IN}
write(' Rotor 1 IN: [');
textcolor(10);
write(Rot1_in);
textcolor(15);
writeln(']');

writeln; {1ºRotor OUT}
write(' Rotor 1 OUT: [');
textcolor(2);
write(Rot1_out);
textcolor(15);
writeln(']');


writeln; {2ºRotor IN}
writeln;
textcolor(15);
write(' Rotor 2 IN: [');
textcolor(9);
write(Rot2_in);
textcolor(15);
writeln(']');

writeln; {2ºRotor OUT}
textcolor(15);
write(' Rotor 2 OUT: [');
textcolor(1);
write(Rot2_out);
textcolor(15);
writeln(']');

writeln; {Reflector IN}
writeln;
textcolor(15);
write(' Reflector IN: [');
textcolor(13);
write(Refl_in);
textcolor(15);
writeln(']');

writeln; {Reflector OUT}
textcolor(15);
write(' Reflector OUT: [');
textcolor(5);
write(Refl_out);
textcolor(15);
writeln(']');
writeln;
writeln('_______________________________________________');

writeln;
writeln;
writeln('Presione Enter Para continuar...');
readln;
clrscr;

write('Introduzca el mensaje a encriptar:'); {INPUT}
readln(mensaje);
u:=1;
fil:=21;
col:=2;


repeat {--------------------COMIENZO DE BUCLE--------------------}

{Puesto inicial}
for i:=1 to length(vec) do
if vec[i]=mensaje[u] then
n:=i;

{Rotor 1 IN-OUT}
b:=Rot1_in[n];
for i:=1 to length(Rot1_out) do
if Rot1_out[i]=b then
n:=i;

{Rotor 2 IN-OUT}
b:=Rot2_in[n];
for i:=1 to length(Rot2_out) do
if Rot2_out[i]=b then
n:=i;

{Reflector IN-OUT}
b:=Refl_in[n];
for i:=1 to length(Refl_out) do
if Refl_out[i]=b then
n:=i;

{Rotor 2 OUT-IN}
b:=Rot2_out[n];
for i:=1 to length(Rot2_in) do
if Rot2_in[i]=b then
n:=i;

{Rotor 1 OUT-IN}
b:=Rot1_out[n];
for i:=1 to length(Rot1_in) do
if Rot1_in[i]=b then
n:=i;

{Puesto Final}
b:=vec[n];
gotoxy(fil,col);
textcolor(14);
write(b);
textcolor(15);
u:=u+1;
fil:=fil+1;

x:=1; {Permutacion por cada caracter}
aux:=copy(Rot1_in,1,x); {1ºRotor IN}
delete(Rot1_in,1,x);
Rot1_in:=Rot1_in+aux;

aux:=copy(Rot1_out,1,x); {1ºRotor OUT}
delete(Rot1_out,1,x);
Rot1_out:=Rot1_out+aux;
x:=x+1;

until u-1=length(mensaje); {--------------------FIN DE BUCLE--------------------}

gotoxy(1,2);writeln('Mensaje encriptado:['); {OUTPUT}
gotoxy(fil,2);writeln(']');
writeln('Nro Caracteres = ',u-1);
readln;
end.

Te respondo a tu pregunta sobre la maquina enigma para empezar no esta mal pero te queda algunas cosas que mejorar y realizar mi puntuación seria media si estas en primero o segundo año de aprendizaje si es mas no te pondría ni 2.


mira un pobre ejemplo de una maquina enigma:

program mqenigma;
uses
crt;

const

teclado : array[1..26] of char = {Teclado}
'ABCDEFGHIJKLMNOPQRSTUVWXYZ';

RI : array[1..2, 1..26] of char = {Rueda I}
('ABCDEFGHIJKLMNOPQRSTUVWXYZ',
'EKMFLGDQVZNTOWYHXUSPAIBRCJ');

RII : array[1..2,1..26] of char = {Rueda II}
('ABCDEFGHIJKLMNOPQRSTUVWXYZ',
'AJDKSIRUXBLHWTMCQGZNPYFVOE');

RIII : array[1..2,1..26] of char = {Rueda III}
('ABCDEFGHIJKLMNOPQRSTUVWXYZ',
'BDFHJLCPRTXVZNYEIWGAKMUSQO');

espejo : array[1..2,1..26] of char = {Espejo}
('ABCDEFGHIJKLMNOPQRSTUVWXYZ',
'YRUHQSLDPXNGOKMIEBFZCWVJAT');

pasoIIIaII : array[1..2,1..26] of char = {Conesiones Rueda III a II}
('CEGIKBOQSWUYMXDHVFZJLTRPNA',
'DFHJLCPRTXVZNYEIWGAKMUSQOB');

pasoIIaI : array[1..2,1..26] of char = {Conesiones Rueda II a I}
('DSRXLJMQZFPOWVKUYIEBHNGCTA',
'DSRXLJMQZFPOWVKUYIEBHNGCTA');

pasoIaespejo : array[1..2,1..26] of char = {Conesiones Rueda I a Espejo}
('FSURTZOXJGHYBNACVLKQWDMPE',
'FSURTZOXJGHYBNACVLKQWDMPE');


type
letras = array[1..2,1..26] of char;


var
leer : letras;
contador, cont, yp : integer;
tecla : char;
pasa : boolean;
codifi : char;
textoariginal, textoclave : string;
claveinc : array[1..3] of char;

procedure pasaletra(cual : integer; leer : letras);
var
pas, i : integer;
let1, let2 : char;
begin
case cual of
1 : begin
let1 := RI[1][1];
let2 := RI[2][1];
end;
2 : begin
let1 := RII[1][1];
let2 := RII[2][1];
end;
3 : begin
let1 := RIII[1][1];
let2 := RIII[2][1];
end;
end;
for i := 1 to 26 do
begin
case cual of
1 : begin
leer[1][i] := RI[1][i + 1];
leer[2][i] := RI[2][i + 1];
end;
2 : begin
leer[1][i] := RII[1][i + 1];
leer[2][i] := RII[2][i + 1];
end;
3 : begin
leer[1][i] := RIII[1][i + 1];
leer[2][i] := RIII[2][i + 1];
end;
end;
end;
case cual of
1 : begin
leer[1][26] := let1;
leer[2][26] := let2;
end;
2 : begin
leer[1][26] := let1;
leer[2][26] := let2;
end;
3 : begin
leer[1][26] := let1;
leer[2][26] := let2;
end;
end;
for i := 1 to 26 do
begin
case cual of
1 : begin
rI[1][i] := leer[1][i];
rI[2][i] := leer[2][i];
end;
2 : begin
rII[1][i] := leer[1][i];
rII[2][i] := leer[2][i];
end;
3 : begin
rIII[1][i] := leer[1][i];
rIII[2][i] := leer[2][i];
end;
end;
end;
end;

procedure ponclaveinicio;
var
tec : char;
ni : integer;
begin
claveinc[1] := 'A';
claveinc[2] := 'A';
claveinc[3] := 'A';
gotoxy(10,10);write('**** CLAVE INICIO ****');
gotoxy(10,12);write('I = ',claveinc[1],' II = ',claveinc[2],' III = ',claveinc[3]);
gotoxy(10,14);write('DESEA MODIFICAR CLAVES [S/N] ');
repeat
tec := readkey;
until tec in['n','N','s','S'];
if tec in ['s','S'] then
begin
clrscr;
gotoxy(1,1);write('Pasar III = Tecla Numero [3] ');
gotoxy(1,3);write('Pasar II = Tecla Numero [2] ');
gotoxy(1,5);write('Pasar I = Tecla Numero [1] ');
for ni := 1 to 26 do
begin
gotoxy(20,10 + (ni + 1));write(rI[1][ni]);
gotoxy(24,10 + (ni + 1));write(rII[1][ni]);
gotoxy(28,10 + (ni + 1));write(rIII[1][ni]);
end;
repeat
tec := readkey;
if tec in [#49,#50,#51] then
begin
case tec of
#49 : begin
pasaletra(1,leer);

end;
#50 : begin
pasaletra(2,leer);
end;
#51 : begin
pasaletra(3,leer);
end;
end;
end;
for ni := 1 to 26 do
begin
gotoxy(20,10 + (ni + 1));write(rI[1][ni]);
gotoxy(24,10 + (ni + 1));write(rII[1][ni]);
gotoxy(28,10 + (ni + 1));write(rIII[1][ni]);
end;
until (tec = #13) or (tec = #27);


end;
clrscr;
end;

procedure presenta_estructuras(cual : integer);
begin
case cual of
1 : begin
gotoxy(59,2);write('III');
end;
2 : begin
gotoxy(55,2);write('II');
end;
3 : begin
gotoxy(52,2);write('I');
end;
end;
textcolor(15);
case cual of
1 : begin
gotoxy(52, 4);write(rI[1][1]);
end;
2 : begin
gotoxy(56, 4);write(rII[1][1]);
end;
3 : begin
gotoxy(60, 4);write(rIII[1][1]);
end;
end;
textcolor(15);
end;

function enciendeletra(letra : char) : char;
var
d1, d2 : integer;
con1, con2 : char;
encontra : boolean;
begin
d1 := 1;
encontra := false;
repeat
if rIII[1][d1] = letra then
begin
encontra := true;
con1 := rIII[2][d1];
for d2 := 1 to 26 do
if con1 = pasoIIIaII[1][d2] then
con2 := pasoIIIaII[2][d2];
for d2 := 1 to 26 do
if con2 = rII[1][d2] then
con1 := rII[2][d2];
for d2 := 1 to 26 do
if con1 = pasoIIaI[1][d2] then
con2 := pasoIIaI[2][d2];
for d2 := 1 to 26 do
if con2 = pasoIaespejo[1][d2] then
con1 := pasoIaespejo[2][d2];
for d2 := 1 to 26 do
if con1 = espejo[1][d2] then
con2 := espejo[2][d2];
end;
d1 := d1 + 1;
until (encontra = true) or (d1 > 26);
if encontra = true then
begin
encontra := false;
enciendeletra := con2;
end;
end;


procedure pantalla;
begin
textcolor(15);
gotoxy(50,1);write('ÚÄÄÄÂÄÄÄÂÄÄÄ¿');
gotoxy(50,2);write('³ ³ ³ ³');
gotoxy(50,3);write('ÃÄÄÄÅÄÄÄÅÄÄÄ´');
gotoxy(50,4);write('³ ³ ³ ³');
gotoxy(50,5);write('ÀÄÄÄÁÄÄÄÁÄÄÄÙ');
for yp := 1 to 26 do
begin
gotoxy(30 + (yp + 8),34);write(teclado[yp]);
end;
presenta_estructuras(1);
presenta_estructuras(2);
presenta_estructuras(3);
end;

procedure claveinicio;
var
clv1, clv2, clv3 : char;
co : integer;
begin
clv1 := RI[1][1];
clv2 := RII[1][1];
clv3 := RIII[1][1];
gotoxy(40,40);write('Clave Inicio = ',clv1,'-',clv2,'-',clv3);
end;

procedure iluminaletra(cu : char);
var
hi : integer;
begin
hi := 1;
textcolor(15);
gotoxy(20,44);write('LUCES');
repeat
if teclado[hi] = cu then
begin
textcolor(5);
end;
gotoxy(10 + hi,46);write(teclado[hi]);
textcolor(15);
hi := hi + 1;
until hi > 26;
end;

begin
clrscr;
ponclaveinicio;
pantalla;
cont := 1;
yp := 3;
contador := 1;
claveinicio;
iluminaletra(' ');
gotoxy(2 + cont,yp);
repeat
tecla := readkey;
if upcase(tecla) in[#65..#90] then
begin
textcolor(14);
gotoxy(2 + cont,yp);write(upcase(tecla));
textoariginal[cont] := upcase(tecla);
textoariginal[0] := chr(cont);
cont := cont + 1;
if cont > 34 then
begin
yp := yp + 1;
cont := 1;
end;
codifi := enciendeletra(upcase(tecla));
textoclave[contador] := codifi;
textoclave[0] := chr(contador);
iluminaletra(codifi);
contador := contador + 1;
textcolor(15);
pasaletra(3,leer);
presenta_estructuras(3);
gotoxy(2 + cont,yp);
if rIII[1][1] = 'V' then
begin
pasa := true;
pasaletra(2,leer);
presenta_estructuras(2);
gotoxy(2 + cont,yp);
end;
if (rII[1][1] = 'E') and (pasa = true) then
begin
pasa := false;
pasaletra(1,leer);
presenta_estructuras(1);
gotoxy(2 + cont,yp);
end;
end;
gotoxy(2 + cont,yp);
until (tecla = #27) or (tecla = #13);
clrscr;
gotoxy(30,20);write('TEXTO REAL : ',textoariginal);
gotoxy(30,22);write('CODIFICADO : ',textoclave);
gotoxy(20,24);write('*** PULSA UNA TECLA PARA SALIR ***');
repeat until keypressed;
end.

espero te sirva de algo suerte.