uses dos, crt;
Function DayInMonth (m: byte; y: integer): byte; forward;
procedure SDate (St: string; var a: dat);
const mthe: array [1 .. 12] of string [3] = ('JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC') ;
const mthru: array [1 .. 12] of string [3]
const mthrl: array [1 .. 12] of string [3]
var i, j, e: byte; mode: byte; S: word; err: boolean; D, M, Y, wd: word; c: shortint;
Procedure add (mode: byte; s: word; var a: dat);
begin
case mode of
1: if (s> 0) and (s <= 31) then A.day: = S else DTErr: = true;
3: if (s> 0) and (s <= 12) then A.month: = S else DTErr: = true;
5: if s> = 100 then A.year: = S else A.year: = S +100 * (Y div 100);
end;
end;
begin
DTErr: = false;
GetDate (Y, M, D, wd);
e: = length (st);
i: = 1; mode: = 0;
while (i <= e) do begin
c: = ord (st [i])-ord ('0 ');
if ((mode mod 2) = 0) and (c> = 0) and (C <= 9) then begin S: = c; inc (mode) end
else if (c <= 9) and (c> = 0) then S: = S * 10 + c
else if (mode mod 2) = 1 then begin Add (mode, S, a); Inc (mode) end;
if (mode = 2) then
for j: = 1 to 12 do
if (mthe [j, 1] = upcase (st [i])) and (Mthe [j, 2] = upcase (st [i +1])) and (mthe [j, 3] = upcase (st [i +2])) or
((mthru [j, 1] = st [i]) or (Mthrl [j, 1] = st [i])) and ((mthru [j, 2] = st [i +1]) or (mthrl [j, 2] = st [i +1])) and
((mthru [j, 3] = st [i +2]) or (Mthrl [j, 3] = st [i +2])) then
begin add (3, j, a); mode: = 4 end;
inc (i);
end;
if (mode mod 2) = 1 then add (mode, S, a);
if mode <1 then add (1, D, a);
if mode <3 then add (3, M, a);
if mode <5 then add (5, Y, a);
if not DTErr then DTErr: = a.day> DayInMonth (a.month, a.year);
if not DTErr then a.dweek: = dweek (a);
end;
function dweek (a: dat): byte;
var n, m, y: word;
begin
DTErr: = false;
y: = a.year;
if a.month <= 2 then begin m: = a.month +12; dec (y) end else m: = a.month;
n: = (A.day +2 * m + trunc (0.6 * (m +1)) + y + (y div 4) - (y div 100) + (y div 400)) mod 7;
dweek: = n;
end;
Function STime (st: string): Word;
var i, e, mode: byte; a, s: word; c: shortint;
begin
DTErr: = false;
e: = length (st);
i: = 1; mode: = 0; a: = 0;
while (i <= e) do begin
c: = ord (st [i])-ord ('0 ');
if ((mode mod 2) = 0) and (c> = 0) and (C <= 9) then begin S: = c; inc (mode) end
else if (c <= 9) and (c> = 0) then S: = S * 10 + c
else if mode = 1 then begin A: = S; inc (mode) end
else if mode =...
