home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / disks / disk390.lzh / SetClock / Examples / SetClock.pas
Pascal/Delphi Source File  |  1990-10-23  |  5KB  |  147 lines
  1. Program SetClock;
  2. { Author: Willi Kusche
  3.           P. O. Box 456
  4.           Bellmawr, NJ  08099  }
  5.  
  6. {$I "include/DOS.i"}
  7. {$I "include/ExecStdIO.i"}
  8. {$I "include/Parameters.i"}
  9. {$I "include/StringLib.i"}
  10. {$I "include/Ports.i"}
  11. {$I "include/TimerDevice.i"}
  12.  
  13. const SecondsInMinute=60;
  14.       SecondsInHour=SecondsInMinute * 60;
  15.       SecondsInDay=SecondsInHour * 24;
  16.       SecondsInYear=SecondsInDay * 365;
  17.  
  18. type PackedDecimalDateRec=record
  19.                             year,
  20.                             month,
  21.                             day,
  22.                             hour,
  23.                             minute,
  24.                             second: integer
  25.                           end;
  26.      months=array[0..11] of integer;
  27.  
  28. var direction: string;
  29.     ExtraDaysInFeb, TotalSeconds,
  30.     year, month, day, hour, minute, second, temp: integer;
  31.     date_stamp: DateStampRec;
  32.     PDDate: PackedDecimalDateRec;
  33.     result: integer;
  34.     IOR: IOSTDReqPtr;
  35.  
  36. const DaysTable: months = (0, 31, 59, 90, 120, 151,
  37.                            181, 212, 243, 273, 304, 334);
  38.  
  39. function PackedDecimal(i: integer): integer;
  40.   begin
  41.     PackedDecimal := (i div 10) * 16 + i mod 10
  42.   end;
  43.  
  44. function ToInteger(i: integer): integer;
  45.   begin
  46.     ToInteger := (i shr 4) * 10 + i mod 16
  47.   end;
  48.  
  49. procedure WriteSClock(date_stuff: PackedDecimalDateRec);
  50.   external;
  51.  
  52. procedure ReadSClock(var date_stuff: PackedDecimalDateRec);
  53.   external;
  54.  
  55. begin
  56.   direction := AllocString(80);
  57.   GetParam(1, direction);
  58.   writeln;
  59.   if strieq(direction, "save")
  60.       then begin
  61.         DateStamp(date_stamp);
  62.         temp := date_stamp.dsDays - 2251;
  63.         year := (4 * temp + 3) div 1461;
  64.         temp := temp - ((1461 * year) div 4);
  65.         month := (5 * temp + 2) div 153;
  66.         day := temp - (153 * month + 2) div 5 + 1;
  67.         month := month + 3;
  68.         if month > 12
  69.             then begin
  70.               year := year + 1;
  71.               month := month - 12
  72.             end;
  73.         PDDate.year := PackedDecimal(year + 84);
  74.         PDDate.month := PackedDecimal(month);
  75.         PDDate.day := PackedDecimal(day);
  76.         temp := date_stamp.dsMinute;
  77.         hour := temp div 60;
  78.         PDDate.minute := PackedDecimal(temp - (hour * 60));
  79.         PDDate.hour := PackedDecimal(hour);
  80.         PDDate.second := PackedDecimal(date_stamp.dsTick div 50);
  81.         writeln('Resetting Spirit hardware clock to zero.');
  82.         writeln('Please wait...');
  83.         WriteSClock(PDDate);
  84.         writeln('Spirit hardware clock now matches AmigaDOS system clock!')
  85.       end
  86.     else if strieq(direction, "load")
  87.              then begin
  88.                ReadSClock(PDDate);
  89.                year := ToInteger(PDDate.year);
  90.                month := ToInteger(PDDate.month);
  91.                day := ToInteger(PDDate.day);
  92.                hour := ToInteger(PDDate.hour);
  93.                minute := ToInteger(PDDate.minute);
  94.                second := ToInteger(PDDate.second);
  95.                if second = 99
  96.                    then writeln("Couldn't find Spirit hardware clock!")
  97.                  else begin
  98.                    if year = 0
  99.                        then temp := 694224000
  100.                      else begin
  101.                        if year > 77
  102.                            then temp := (year - 78) * SecondsInYear
  103.                          else temp := 694224000 + year * SecondsInYear
  104.                      end;
  105.                    ExtraDaysInFeb := year div 4;
  106.                    if (year mod 4 = 0) and (month > 2)
  107.                        then ExtraDaysInFeb := ExtraDaysInFeb - 1;
  108.                    if year > 77
  109.                        then ExtraDaysInFeb := ExtraDaysInFeb - 19;
  110.                    TotalSeconds := temp
  111.                                    + (ExtraDaysInFeb
  112.                                       + DaysTable[month - 1]
  113.                                       + day - 1) * SecondsInDay
  114.                                    + hour * SecondsInHour
  115.                                    + minute * SecondsInMinute
  116.                                    + second;
  117.                    new(IOR);
  118.                    result := OpenDevice(TimerName, 0, IOR, 0);
  119.                    if result <> 0
  120.                        then begin
  121.                          writeln("Couldn't open timer!");
  122.                          exit(10)
  123.                        end;
  124.                    IOR^.ioReq.ioMessage.mnNode.lnType := NTMessage;
  125.                    IOR^.ioReq.ioMessage.mnNode.lnName := "";
  126.                    IOR^.ioReq.ioMessage.mnReplyPort := nil;
  127.                    IOR^.ioReq.ioCommand := TR_SETSYSTIME;
  128.                    IOR^.ioActual := TotalSeconds;
  129.                    IOR^.ioLength := 0;
  130.                    result := DoIO(IOR);
  131.                    if result <> 0
  132.                        then begin
  133.                          writeln("Couldn't set timer!");
  134.                          exit(10)
  135.                        end;
  136.                    dispose(IOR);
  137.                    writeln("AmigaDOS system clock set from hardware clock")
  138.                  end
  139.              end
  140.     else begin
  141.       writeln("Use:");
  142.       writeln("  'SetClock LOAD' to set system clock from hardware clock");
  143.       writeln("  'SetClock SAVE' to set hardware clock from system clock")
  144.     end;
  145.   writeln
  146. end.
  147.