home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BDOS / CPMDATE.LBR / CPMDATE.PZS / CPMDATE.PAS
Pascal/Delphi Source File  |  2000-06-30  |  10KB  |  300 lines
  1. PROGRAM DateDemo_11_18_86;
  2.  
  3. (* ------------------------------------------------------------------------ *
  4.  * ------------------------------------------------------------------------ *
  5.  
  6.  
  7.       This program is a Turbo Pascal version of the CP/M "Date" utility.
  8.    It is not intended as a replacement, but only as a source of code
  9.    for the different procedures and functions it uses.  When compiled
  10.    it requires 12k of disk space.
  11.  
  12.    The program will do the following:
  13.  
  14.       1. Get the date from the system clock and display it in
  15.          day of week, month, day of month, and year.
  16.  
  17.       2. Get the time from the system clock and display it in
  18.          HH:MM:SS format.
  19.  
  20.       3. Get the date, time, or both in any order from the command
  21.          line, parse out the appropriate values, and set the date
  22.          and/or time.  for example: date 11/5/86,14:30:20
  23.  
  24.       4. Prompt for the date and time if the user types "date set"
  25.          at the command line.
  26.  
  27.       5. Display the date and time continuously until a key is pressed
  28.          if the user types "date " .
  29.  
  30.    My appreciation goes to Ken Kroninger for supplying the code that
  31.    showed how the BDOS calls are made.  The code that Ken supplied was
  32.    written by Milton Hicks and J. Bauernschub Jr.  It was lightly revised
  33.    by Jim LaSalle.
  34.  
  35.    Requirements : Turbo Pascal v2.0 or higher.
  36.                   CP/M 3.0 (CP/M plus) - banked version.
  37.  
  38.  
  39.    Please address any comments or questions to Ben Diss.  On Qlink address
  40.    mail to "Duque", on GEnie address mail to "BDiss".
  41.  
  42.  
  43.  * ------------------------------------------------------------------------ *
  44.  * ------------------------------------------------------------------------ *)
  45.  
  46. { The Following information will prove useful in understanding this
  47.   program:
  48.  
  49.   BDOS 105 gets the date and time from the system clock and puts the
  50.   information in a four byte data structure beginning at the address
  51.   passed in the DE register pair.  This program uses two integers to
  52.   input that data: DateInt, and TimeInt. These two integers are
  53.   declared next to each other and so that DateInt will reside higher
  54.   in memory so that the data will be passed to the approriate
  55.   variables.  BDOS uses this four byte structure both in setting and
  56.   in getting the date and time.  BDOS 104 is used to set the time.
  57.  
  58.        Byte 0 - 1 : Date field as an integer representing
  59.                     the number of days since January 1, 1978.
  60.  
  61.        Byte 2     : Hours field in BCD.
  62.        Byte 3     : Minutes field in BCD.
  63.  
  64.   In getting the time the BDOS passes the seconds in register A in BCD.
  65.   Turbo Pascal returns the A register when the BDOS statement is used
  66.   as a function.
  67.  
  68.   BCD stands for Binary Coded Decimal.  An array was declared that is
  69.   used to transfer the BCD value to an integer value.  A BCD number in
  70.   hexidecimal form when written appears as the integer equivalent.
  71.   For example 12h has an integer value of 18 yet its BCD value is 12.
  72.   A hexidecimal number that does not display integers has no BCD
  73.   equivalent.                                                           }
  74.  
  75.  
  76.  
  77. Const
  78.     Days : Array [1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
  79.     BCD  : Array [0..89] of Integer = (0,1,2,3,4,5,6,7,8,9,99,99,99,99,99,99,
  80.                              10,11,12,13,14,15,16,17,18,19,99,99,99,99,99,99,
  81.                              20,21,22,23,24,25,26,27,28,29,99,99,99,99,99,99,
  82.                              30,31,32,33,34,35,36,37,38,39,99,99,99,99,99,99,
  83.                              40,41,42,43,44,45,46,47,48,49,99,99,99,99,99,99,
  84.                              50,51,52,53,54,55,56,57,58,59);
  85.  
  86. Type
  87.     Date_Type = String [30];
  88.     Time_Type = String [8];
  89.  
  90. Var
  91.     mm, dd, yy        : Integer;
  92.     hh, mnts, ss      : Integer;
  93.     am                : Boolean;
  94.  
  95. PROCEDURE Get_CPM_3_Date;
  96.  
  97. Var TimeInt, DateInt  : Integer;
  98.  
  99. Begin
  100.     ss := BCD [BDOS (105, Addr (DateInt))];
  101.     hh := BCD [Lo (TimeInt)];
  102.     mnts := BCD [Hi (TimeInt)];
  103.     yy := 78;
  104.     While DateInt > 365 Do
  105.     Begin
  106.         If yy/4 = Int (yy/4) then DateInt := DateInt - 1;
  107.         yy := yy + 1;
  108.         DateInt := DateInt - 365;
  109.     End;
  110.     If yy/4 = Int (yy/4) then Days [2] := 29;
  111.     mm := 1;
  112.     While DateInt > Days [mm] Do
  113.     Begin
  114.         DateInt := DateInt - Days [mm];
  115.         mm := mm + 1;
  116.     End;
  117.     dd := Trunc (DateInt);
  118. End;
  119.  
  120. PROCEDURE Build_String (Var Date : Date_Type; Var Time : Time_Type);
  121.  
  122. Const
  123.     Day_Array       : Array [0..6] of String [9] =
  124.                     ('Sunday','Monday','Tuesday','Wednesday',
  125.                      'Thursday','Friday','Saturday');
  126.  
  127.     Month_Array     : Array [1..12] of String [9] =
  128.                     ('January','February','March','April','May','June','July',
  129.                      'August','September','October','November','December');
  130.  
  131. Var Temp1, Temp2, Temp3 : String [4];
  132.  
  133. FUNCTION Day_Of_Week (Month, Day, Year : Integer) : Integer;
  134.  
  135. Var Century : Integer;
  136.  
  137. Begin
  138.     If Month < 2 then
  139.     Begin
  140.         Month := Month + 10;
  141.         Year  := Year - 1;
  142.     End
  143.     Else Month := Month - 2;
  144.     Century := Year Div 100;
  145.     Year := Year Mod 100;
  146.     Day_Of_Week := (Day - 1 + ((13 * Month - 1) Div 5) + (5 * Year Div 4)+
  147.                     Century Div 4 - 2 * Century + 1) Mod 7;
  148. End;
  149.  
  150. Begin
  151.     Str (dd,Temp1);
  152.     Str (yy + 1900,Temp2);
  153.     Date := Concat (Day_Array [Day_of_Week (mm, dd, yy + 1900)],', ',
  154.                        Month_Array [mm],' ',Temp1,', ',Temp2);
  155.     If hh >= 12 then
  156.     Begin
  157.         am := False;
  158.         hh := hh - 12;
  159.     End
  160.     Else am := True;
  161.     Str (hh,Temp1);
  162.     Str (mnts,Temp2);
  163.     Str (ss,Temp3);
  164.     Time := Copy ('0' + Temp1, Length (Temp1), 2) + ':' +
  165.             Copy ('0' + Temp2, Length (Temp2), 2) + ':' +
  166.             Copy ('0' + Temp3, Length (Temp3), 2);
  167. End;
  168.  
  169. PROCEDURE Set_Date_Time;
  170.  
  171. Var
  172.     Month, Year, Number_Of_Days : Integer;
  173.     TimeInt, DateInt            : Integer;
  174.     LoTimeInt, HiTimeInt, I     : Integer;
  175.     Chr                         : Char;
  176.  
  177. Begin
  178.     DateInt := dd;
  179.     If yy/4 = Int (yy/4) then Days [2] := 29;
  180.     For Month := 1 to mm-1 Do DateInt := DateInt + Days [Month];
  181.     For Year := yy downto 79 Do
  182.     Begin
  183.         Number_Of_Days := 365;
  184.         If Year/4 = Int (Year/4) then Number_Of_Days := 366;
  185.         DateInt := DateInt + Number_Of_Days;
  186.     End;
  187.     For I := 0 to 89 Do
  188.     Begin
  189.         If BCD [I] = hh then LoTimeInt := I;
  190.         If BCD [I] = mnts then HiTimeInt := I;
  191.     End;
  192.     TimeInt := (HiTimeInt * 256) + LoTimeInt;
  193.     Write ('Press any key to set the time');
  194.     Read (Kbd,Chr);
  195.     BDOS (104, Addr (DateInt));
  196. End;
  197.  
  198. PROCEDURE Input_Date_And_Time (Var Date, Time : Time_Type);
  199.  
  200. Begin
  201.     Write ('Enter the date in MM/DD/YY format: ');
  202.     ReadLn (Date);
  203.     Write ('Enter the time in HH:MM:SS format: ');
  204.     ReadLn (Time);
  205. End;
  206.  
  207. PROCEDURE Parse (Str              : Time_Type;
  208.                  Delimeter        : Char;
  209.              Var Val1, Val2, Val3 : Integer;
  210.              Var Error            : Boolean);
  211.  
  212. Var Error1, Error2, Error3 : Integer;
  213.  
  214. Begin
  215.     Val (Copy (Str, 1, Pos (Delimeter,Str) - 1), Val1, Error1);
  216.     Delete (Str, 1, Pos (Delimeter,Str));
  217.     Val (Copy (Str, 1, Pos (Delimeter,Str) - 1), Val2, Error2);
  218.     Delete (Str, 1, Pos (Delimeter,Str));
  219.     Val (Str, Val3, Error3);
  220.     If (Error1 > 0) or (Error2 > 0) or (Error3 > 0) then Error := True
  221.     Else Error := False;
  222. End;
  223.  
  224. PROCEDURE Display_Date (Continuous : Boolean);
  225.  
  226. Var
  227.     Old_String : String [38];
  228.     Date       : Date_Type;
  229.     Time       : Time_Type;
  230.     Chr        : Char;
  231.  
  232. Begin
  233.     Old_String := '';
  234.     Repeat
  235.         Get_CPM_3_Date;
  236.         Build_String (Date, Time);
  237.         If Old_String <> (Date + Time) then
  238.         Begin
  239.             Write (^m,Date,'; ',Time);
  240.             If am then Write (' am') else Write (' pm');
  241.             Old_String := Date + Time;
  242.         End;
  243.         If KeyPressed then
  244.         Begin
  245.             Continuous := False;
  246.             Read (Kbd,Chr);
  247.         End;
  248.     Until Not Continuous;
  249.     Halt;
  250. End;
  251.  
  252. PROCEDURE Parse_Parameter;
  253.  
  254. Var
  255.     ParStr      : String [30];
  256.     Date, Time  : Time_Type;
  257.     Error       : Boolean;
  258.     I           : Integer;
  259.  
  260. Begin
  261.     Date := '';
  262.     Time := '';
  263.     ParStr := '';
  264.     For I := 1 to ParamCount Do ParStr := ParStr + ParamSTR (I);
  265.     If Pos ('C',ParStr) > 0 then
  266.     Begin
  267.         Display_Date (True);
  268.         Exit;
  269.     End;
  270.     If (Pos (',',ParStr) > 0) then
  271.         If (Pos ('/',ParStr) < Pos (':',ParStr)) then
  272.         Begin
  273.             Date := Copy (ParStr, 1, Pos (',',ParStr) - 1);
  274.             Time := Copy (ParStr, Pos (',',ParStr) + 1, Length (ParStr));
  275.         End
  276.         Else
  277.         Begin
  278.             Time := Copy (ParStr, 1, Pos (',',ParStr) - 1);
  279.             Date := Copy (ParStr, Pos (',',ParStr) + 1, Length (ParStr));
  280.         End
  281.     Else If (Pos ('/',ParStr) > 0) and (Date = '') then
  282.         Date := Copy (ParStr, 1, Length (ParStr))
  283.     Else If (Pos (':',ParStr) > 0) and (Time = '') then
  284.         Time := Copy (ParStr, 1, Length (ParStr))
  285.     Else If Pos ('S',ParStr) > 0 then Input_Date_And_Time (Date,Time);
  286.     Get_CPM_3_Date;
  287.     If Date <> '' then Parse (Date, '/', mm, dd, yy, Error);
  288.     If Time <> '' then Parse (Time, ':', hh, mnts, ss, Error);
  289.     If (mm<0) or (mm>12) or (dd<0) or (dd>31) or (yy<0) or (yy>99)
  290.         or (hh<0) or (hh>24) or (mnts<0) or (mnts>59) or (ss<0) or (ss>59)
  291.         then Error := True;
  292.     If Error then WriteLn ('ERROR: Illegal time/date specification.');
  293.     If (Error = False) and ((Date <> '') or (Time <> '')) then Set_Date_Time;
  294. End;
  295.  
  296. BEGIN
  297.     If ParamCount > 0 then Parse_Parameter
  298.     Else Display_Date (False);
  299. END.
  300.