home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug027.arc
/
TTDATE.INC
< prev
next >
Wrap
Text File
|
1979-12-31
|
6KB
|
151 lines
PROCEDURE getdate(VAR dummy_date : str11; y : INTEGER);
Label
escape;
CONST
Term : CharSet = [^E,^I,^M,^X,^Z,#27];
VAR
K,R,yes : INTEGER;
ddate,dyear : STRING[2];
dmonth : str3;
tc : CHAR;
OK : BOOLEAN;
BEGIN
K := 1;
ddate := copy(dummy_date,1,2);
dmonth := copy(dummy_date,4,3);
dyear := copy(dummy_date,10,4);
ok := FALSE;
repeat
REPEAT
CASE K OF
1 : BEGIN
repeat
R := -1;
InputStr(ddate,2,22,y,term,tc);
val(ddate,R,yes);
until ((R in [1..31]) and (tc = ^X)) or (tc in [^M,^Z,^E,#27]);
case tc of
^E : k := 3;
^Z : goto escape;
end;
end;
2 : BEGIN
GotoXY(26,y+1);
REPEAT
Read(kbd,tc);
tc := UpCase(tc);
UNTIL tc IN ['A','D','F','J','M','N','O','S',^Z,^M,^E,^X,^I,#27];
IF tc = ^Z then goto escape;
if tc = ^E then k := 0;
if not(tc in [^M,^X,^E,#27])
THEN
BEGIN
Write(tc);
CASE tc OF
'A' : BEGIN
REPEAT
Read(kbd,tc);
tc := UpCase(tc);
UNTIL tc IN ['P','U'];
CASE tc OF
'P' : BEGIN
dmonth := 'APR';
Write('PR');
END;
'U' : BEGIN
dmonth := 'AUG';
Write('UG');
END;
END;
END;{case A}
'D' : BEGIN
dmonth := 'DEC';
Write('EC');
END;
'F' : BEGIN
dmonth := 'FEB';
Write('EB');
END;
'S' : BEGIN
dmonth := 'SEP';
Write('EP');
END;
'N' : BEGIN
dmonth := 'NOV';
Write('OV');
END;
'M' : BEGIN
Write('A');
REPEAT
Read(kbd,tc);
tc := UpCase(tc);
UNTIL tc IN ['R','Y'];
CASE tc OF
'R' : BEGIN
dmonth := 'MAR';
Write('R');
END;
'Y' : BEGIN
dmonth := 'MAY';
Write('Y');
END;
END; {case}
END; {case M}
'O' : BEGIN
dmonth := 'OCT';
Write('CT');
END;
'J' : BEGIN
REPEAT
Read(kbd,tc);
tc := UpCase(tc);
UNTIL tc IN ['A','U'];
CASE tc OF
'A' : BEGIN
dmonth := 'JAN';
Write('AN');
END;
'U' : BEGIN
Write('U');
REPEAT
Read(kbd,tc);
tc := UpCase(tc);
UNTIL tc IN ['L','N'];
CASE tc OF
'L' : BEGIN
dmonth := 'JUL';
Write('L');
END;
'N' : BEGIN
dmonth := 'JUN';
Write('N');
END;
END;{case}
END;{Case U}
END;{case ['A','U']}
END;{Case J}
END;{case ['A','D','F','J','M','N','O','S']}
END;
END;{case 2}
3 : begin
repeat
InputStr(dyear,2,31,y,term,tc);
until ((dyear >= '00') and (dyear <= '99')) or (tc in [^M,^Z,^X,^E,#27]);
case tc of
^E : k := 0;
^Z : goto escape;
end;
end;
END; {Case}
K := K + 1;
UNTIL (K=4) or (TC in [^Z,#13,#27]) or ((TC=^E) and (K=2)) or ((TC=^X) and (K=4));
dummy_date := ddate + ' ' + dmonth + ' 19' + dyear;
verify_date(dummy_date,ok);
if (not ok) then k := 1;
if Dummy_Date = '__ ___ 19__' then ok := true;
until ok or (tc in [^E,^X]);
escape:
END;