home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
15a
/
murutil.zip
/
DATETIME.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-06-04
|
6KB
|
223 lines
PROGRAM DATETIME;
{ This Turbo Pascal program gets the current date and time from the
keyboard and sets the MSDOS date and time parameters.
Acceptable date formats are: "04-JUN-86", "4JUN86", "4 JUN 1986"
and so forth.
Acceptable time formats are: "9:55:12", "9:55", "9.55", "9;55"
and so forth.
Program by:
Harry M. Murphy, Consultant
3912 Hilton Avenue, NE
Albuquerque, NM 87110
Tel: (505) 881-0519
4 June 1986. }
{ NOTICE
Copyright 1986, Harry M. Murphy.
A general license is hereby granted for non-commercial
use, copying and free exchange of this program without
payment of any royalties, provided that this copyright
notice is not altered nor deleted. All other rights are
reserved. Harry M. Murphy }
CONST
BLANK = ' ';
LENREC = 12;
MONTHS = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
TYPE
LINIDX = 0..LENREC;
LINSTR = STRING[LENREC];
VAR
CH : CHAR;
DAY : INTEGER;
GOOD : BOOLEAN;
HR : INTEGER;
K : LINIDX;
L : LINIDX;
LINE : LINSTR;
LL : LINIDX;
MN : INTEGER;
MON : INTEGER;
REGS : RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
END;
SC : INTEGER;
YEAR : INTEGER;
PROCEDURE BEEP;
BEGIN { Procedure BEEP }
SOUND(440);
DELAY(100);
NOSOUND
END { Procedure BEEP };
PROCEDURE ERROR;
BEGIN { Procedure ERROR }
SOUND(220);
DELAY(200);
NOSOUND;
DELAY(800)
END { Procedure ERROR };
PROCEDURE SCAN(VAR LINE: LINSTR;
VAR L: LINIDX;
VAR NUM: INTEGER;
MXDG: LINIDX);
VAR
ND : INTEGER;
BEGIN { Procedure SCAN }
NUM := 0;
ND := 0;
WHILE (LINE[L] IN ['0'..'9']) AND (ND < MXDG) DO
BEGIN
NUM := 10*NUM+ORD(LINE[L])-ORD('0');
ND := ND+1;
L := L+1
END
END { Prodecure SCAN };
BEGIN {Program DATETIME }
{ Ask for today's date. Keep asking until it's parses OK. }
LOWVIDEO;
REPEAT
BEEP;
WRITE('Date (dd-mmm-yy): ');
LINE := BLANK;
READLN(LINE);
{ There must be at least six characters in the date:
for example "4JUN86". }
LL := LENGTH(LINE);
GOOD := (LL > 5) AND (LL < LENREC);
{ Parse the date line. }
IF GOOD
THEN
BEGIN
K := 0;
FOR L:=1 TO LL DO
BEGIN
CH := UPCASE(LINE[L]);
IF (CH IN ['0'..'9']) OR (CH IN ['A'..'Z'])
THEN
BEGIN
K := K+1;
LINE[K] := CH
END
END;
LINE[K+1] := CHR(0);
LL := K;
GOOD := LL > 5;
IF GOOD
THEN
BEGIN
L := 1;
SCAN(LINE,L,DAY,2);
MON := (POS(COPY(LINE,L,3),MONTHS)+2) DIV 3;
L := L+3;
SCAN(LINE,L,YEAR,4);
IF YEAR < 100
THEN
YEAR := YEAR+1900;
GOOD := (DAY > 0) AND
(MON > 0) AND
((YEAR > 1985) AND (YEAR < 2100));
IF GOOD
THEN
CASE MON OF
1,3,5,7,8,10,12: GOOD := DAY <= 31;
2: IF (YEAR MOD 4) = 0
THEN
GOOD := DAY <= 29
ELSE
GOOD := DAY <= 28;
4,6,9,11: GOOD := DAY <= 30
END { CASE }
END
END;
IF NOT GOOD THEN ERROR
UNTIL GOOD;
{ At this point we have a valid date. Call MSDOS to save it. }
WITH REGS DO
BEGIN
AX := $2B00;
CX := YEAR;
DX := MON*256+DAY
END { WITH };
MSDOS(REGS);
{ Ask for the time. Keep asking until it's parses OK. }
REPEAT
BEEP;
WRITE('Time (hh:mm:ss): ');
LINE := BLANK;
READLN(LINE);
LL := LENGTH(LINE);
{ There must be at least four characters in the time;
for example: "9:45". }
GOOD := (LL > 3) AND (LL < 9);
LINE[LL+1] := CHR(0);
{ Parse the time line. }
IF GOOD
THEN
BEGIN
FOR L:=1 TO LL DO
IF LINE[L] IN [';','.',',','/'] THEN LINE[L] := ':';
L := 1;
SCAN(LINE,L,HR,2);
GOOD := (HR < 24) AND (LINE[L] = ':');
IF GOOD
THEN
BEGIN
L := L+1;
SCAN(LINE,L,MN,2);
GOOD := (MN < 60) AND ((LINE[L] = ':') OR (L >= LL));
IF GOOD AND (L < LL)
THEN
BEGIN
L := L+1;
SCAN(LINE,L,SC,2);
GOOD := SC < 60
END
END
END;
IF NOT GOOD THEN ERROR
UNTIL GOOD;
{ At this point we have a valid time. Call MSDOS to save it. }
WITH REGS DO
BEGIN
AX := $2D01;
CX := HR*256+MN;
DX := SC*256
END { WITH };
MSDOS(REGS)
END.