Power-Programmierung/CD1.mdf/pascal/library/dos/murutil/datetime.pas

Pascal/Delphi Source File | 1988-09-28 | 5.7 KB | 235 lines

PROGRAM DATETIME;

{$N-} {No numeric coprocessor}

{  This Turbo Pascal V4.0 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.

   Updated for Turbo Pascal Version 4.0 by H.M.M. on 24 November 1987.

   Version:  24 November 1987.

   Program by:
                Harry M. Murphy, Consultant
                3912 Hilton Avenue, NE
                Albuquerque, NM  87110
                Tel:  [phone]
                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  }


USES
      CRT, DOS;

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 : REGISTERS;
    SC   : INTEGER;
    YEAR : INTEGER;

{ -------------------------------- }

PROCEDURE BEEP;

BEGIN { Procedure BEEP }
  SOUND(512);
  DELAY(100);
  NOSOUND
END { Procedure BEEP };

{ -------------------------------- }

PROCEDURE ERROR;

BEGIN { Procedure ERROR }
  SOUND(128);
  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 parses OK.  }

  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','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 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 < 12);
    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
                  ELSE
                    SC := 0
              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.