PROCEDURE machdatum(dat:string10;VAR tg,mt,ja:integer);¢¢(* Im Hauptprogramm sind folgende *)¢(* Angaben erforderlich: *)¢(* CONST maxlaenge=10; *)¢(* TYPE *)¢(* string10=ARRAY[1..maxlaenge] OF char;*)¢¢(* VAR *)¢(* datum:string10 *)¢(* weitere 3 Variable des Types *)¢(* integer, in denen dann die An- *)¢(* gaben in der Reihenfolge Tag, *)¢(* Monat, Jahr als Integer-Zahlen *)¢(* geliefert werden. *)¢(* #i cls.i *)¢(* #i datum.i *)¢(* Das in datum normal mit Punk- *)¢(* ten eingegebene Datum wird ge- *)¢(* prueft. Ein zweistelliges Jahr *)¢(* wird in 19.. umgewandelt. Ein *)¢(* Jahr 0 wird abgewiesen; ebenso *)¢(* unzulaessige Tage und Monate. *)¢(* Es wird auf Schaltjahr und den *)¢(* gregorianischen Kalender ge- *)¢(* prueft. Ein Datum vor dem *)¢(* 15.10.1582 wird abgewiesen. *) ¢ ¢¢CONST¢ leer = ' ';¢ punkt = '.';¢ null = 48;¢ neun = 57;¢¢VAR¢¢i : integer;¢¢FUNCTION schj(VAR XY:integer):boolean;¢¢BEGIN¢ schj:=FALSE;¢ IF (XY MOD 4 = 0) AND (XY MOD 100 <> 0) THEN schj:=TRUE;¢ IF (XY MOD 400 = 0) THEN schj:=TRUE¢END;¢¢¢FUNCTION datumrichtig(t,m,j:integer):boolean;¢BEGIN¢ datumrichtig:=TRUE;¢ IF (j<1582) OR (m<1) OR (m>12) OR (t<1) THEN datumrichtig:=FALSE¢ ELSE¢ CASE m OF¢ 2 : IF (schj(j)=TRUE) THEN¢ BEGIN¢ IF t>29 THEN datumrichtig:=FALSE;¢ END¢ ELSE¢ IF t>28 THEN¢ datumrichtig:=FALSE;¢ 4,6,9,11: IF t>30 THEN¢ datumrichtig:=FALSE;¢1,3,5,7,8,10,12:IF t>31 THEN¢ datumrichtig:=FALSE¢ END;¢ IF (j=1582) AND ((m<10) OR ((m=10) AND¢(t<15))) THEN datumrichtig:=FALSE¢END;¢ ¢¢FUNCTION wert(feld:string10;VAR index:integer):integer;¢VAR¢ element,temp:integer;¢ mehrziffern:boolean;¢¢BEGIN¢ index:=index-1;¢ REPEAT¢ index:=index+1;¢ UNTIL (index=maxlaenge)¢ OR (feld[index]<>leer) AND ¢ (feld[index]<>punkt);¢ IF (feld[index]<>leer) AND (feld[index]<>punkt) THEN¢ mehrziffern:=true¢ ELSE¢ mehrziffern:=FALSE;¢ temp:=0;¢ WHILE mehrziffern AND (index<=maxlaenge) DO¢ BEGIN¢ element:=ord(feld[index]);¢ IF (element>=null) AND (element<=neun) THEN¢ BEGIN¢ temp:=10*temp+element-null;¢ index:=index+1¢ END¢ ELSE¢ mehrziffern:=FALSE¢ END;¢wert:=temp¢END;¢¢¢BEGIN¢ i:=1;¢REPEAT¢ BEGIN¢ tg:=wert(dat,i);¢ mt:=wert(dat,i);¢ ja:=wert(dat,i);¢ IF (ja>0) AND (ja<100) THEN¢ ja:=ja+1900¢ END;¢ IF NOT datumrichtig(tg,mt,ja) THEN¢ BEGIN¢ write('Datum ?!? >>: ');¢ readln(datum);¢ i:=1;¢ dat:=datum¢ END;¢UNTIL datumrichtig(tg,mt,ja)¢END; ¢
