ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/DATETIME.LBR/DATETIME.PQS/DATETIME.PAS

Pascal/Delphi Source File | 2000-06-30 | 6KB | 240 lines

{ Datetime.pas - this routine prompts the user for the date and time and
                 then sets them using system interrupt calls.  Each time
                 the system is booted, the date and time are saved in a
                 file and used as the default for the call to datetime.

  Tim Twomey  1/28/85
 }

PROGRAM datetime;

TYPE
   { regs holds register values for msdos calls }
   regs = RECORD
            ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
          END;

   { time_rec holds the times of the last boot }
   time_rec = RECORD
                lhour, lminute, lday, lmonth ,lyear : integer;
              END;

   minutes = SET OF 0..59;
   hours = SET OF 0..23;
   days = SET OF 1..31;
   months = SET OF 1..12;
   years = SET OF 85..99;

  CONST
    time_error = ^G'Invalid Time';
    date_error = ^G'Invalid Date';
    minute_range : minutes = [0..59];
    hour_range : hours = [0..23];
    day_range : days = [1..31];
    month_range : months = [1..12];
    year_range : years = [85..99];

VAR
   registers       : regs;
   al              : byte;
   ok              : boolean;
   date_str        : STRING[8];
   time_str        : STRING[6];
   str_inx         : integer;
   year            : integer;
   month           : integer;
   day             : integer;
   hour            : integer;
   minute          : integer;
   result          : integer;
   last_boot       : time_rec;
   time_file       : FILE OF time_rec;
   first_time      : boolean;

  LABEL
    get_date,
    get_time,
    set_date,
    set_time;

BEGIN


   { turn off turbo pascals insistence on bold video }

   lowvideo;

   { Check to see if there is a last boot date file }

   assign (time_file, 'lastboot.dat');
   {$I-}
  reset(time_file) {$I+};
   ok := (ioresult = 0);
   IF NOT ok
     THEN

      { there was no lastboot.dat file, so let's create one }
       BEGIN
         writeln ('Creating LASTBOOT.DAT');
         rewrite (time_file);
         { set initial defaults }
         WITH last_boot DO
           BEGIN
             lhour := 12;
             lminute := 0;
             lday := 1;
             lmonth := 1;
             lyear := 85;
           END;
         write (time_file,last_boot);
         reset (time_file);
       END;

   { get the time and date of the last boot }

   read (time_file,last_boot);

   { Get the current date }

   first_time := TRUE;
   get_date:
             IF NOT first_time
               THEN writeln(date_error);
   first_time := FALSE;
   WITH last_boot DO
     BEGIN
       day := lday;
       month := lmonth;
       year := lyear;
     END;
   write ('Enter current date (Format MM DD YY) (default ',month:2,
          '/',day:2,'/',year:2,' ) : ');
   readln (date_str);
   { check if user entered anything }
   IF (length(date_str) > 0)
     THEN
       BEGIN  { use new date }
      { check month }
         val (date_str, month, result);
         IF NOT (month IN month_range)
           THEN GOTO get_date;
         IF (result = 0)
           THEN GOTO set_date;
         delete (date_str, 1, result+1);
      { check day }
         val (date_str, day, result);
         IF NOT (day IN day_range)
           THEN GOTO get_date;
         IF (result = 0)
           THEN GOTO set_date;
         delete (date_str, 1, result+1);
      { check year }
         val (date_str, year, result);
         IF NOT (year IN year_range)
           THEN GOTO get_date;
         IF result <> 0
           THEN GOTO get_date;
       END;

   { Set the date }

   set_date:
             WITH registers DO
               BEGIN
                 cx := 1900 + year;
                 dx := (month shl 8) + day;
                 ax := $2B shl 8;
               END;
   msdos (registers);
   WITH registers DO
      al := lo(ax);
   IF (al = $FF)
     THEN
       BEGIN
         writeln (date_error);
         GOTO get_date;
       END;

   { set the new defaults }

   WITH last_boot DO
     BEGIN
       lday := day;
       lmonth := month;
       lyear := year;
     END;


   { Get the current time }

   first_time := TRUE;
   get_time:
             IF NOT first_time
               THEN writeln(time_error);
   first_time := FALSE;
   WITH last_boot DO
     BEGIN
       hour := lhour;
       minute := lminute;
     END;
   write ('Enter current time (Format HH MM) (default ',hour:2,':',
          minute:2,' ) : ');
   readln (time_str);
   { check if user entered anything }
   IF length(time_str) > 0
     THEN
       BEGIN { use new time }
      { check hour }
         val (time_str, hour, result);
         IF NOT (hour IN hour_range)
           THEN GOTO get_time;
         IF (result = 0)
           THEN GOTO set_time;
         delete (time_str, 1 ,result+1);
      { check minute }
         val (time_str, minute, result);
         IF NOT (minute IN minute_range)
           THEN GOTO get_time;
         IF (result <> 0)
           THEN GOTO get_time;
       END;

   { Set the Time }

   set_time:
             WITH registers DO
               BEGIN
                 cx := (hour shl 8) + minute;
                 dx := 0;
                 ax := $2D shl 8;
               END;
   msdos (registers);
   WITH registers DO
      al := lo(ax);
   IF (al = $FF)
     THEN
       BEGIN
         writeln (time_error);
         GOTO get_time;
       END;

   { set the new defaults }

   WITH last_boot DO
     BEGIN
       IF (hour <> 0)
         THEN lhour := hour;
       IF (minute <> 0)
         THEN lminute := minute;
     END;

   { write the new lastboot record }

   reset (time_file);
   write (time_file,last_boot);
   close (time_file);

END.
       END;
   msdos (registers);
   WITH