home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / MIXED110.ZIP / TDATE.PAS < prev    next >
Pascal/Delphi Source File  |  1997-11-10  |  5KB  |  164 lines
  1. Program Tdate(output);
  2.  
  3. {
  4.     Turbo Pascal version of Date program.
  5.     Written by: Alan D. Percy
  6.     Date Written: 7/12/84
  7.  
  8.     Prints date and time from getdate routine.
  9. }
  10. Type
  11.     str80 = string[80];
  12.  
  13. Var
  14.     darry : str80;       {get ASCII string in here}
  15.  
  16. function getdate : str80;
  17. {
  18.     Gets an ASCII representation of the
  19.     time and date as follows:
  20.        Mon Jan 23 10:51:32 AM
  21.  
  22.     calls: rawdate and number
  23. }
  24. Type
  25.     rawtype = array[1..6] of integer;
  26. Var
  27.     rdate : rawtype;     {place to get raw date into}
  28.     tmp : str80;         {place to build string into}
  29.     pmflag : boolean;      {AM/PM flag}
  30.  
  31. function number(num : integer; flag : boolean) : str80;
  32. {
  33.     This function returns a string with
  34.     the character representation of the
  35.     number passed as the parameter 'num'.
  36.     The parameter 'flag' determines whether
  37.     leading zeros should be given or not
  38.     (false= no, true= yes).
  39.  
  40.     Limitations:
  41.     Only a two digit number can be converted.
  42. }
  43. Var stmp : str80;
  44.     tmp : integer;
  45.  
  46. Begin  {of number routine}
  47.     tmp := ord('0')+num div 10;    {figure first character number}
  48.     stmp := char(tmp);             {put in string}
  49.     if (stmp = '0') and not flag then  {if flag not set and leading zero}
  50.         stmp := ' ';                   {make blank}
  51.     tmp := ord('0')+num-10*(num div 10);   {figure second character number}
  52.     stmp := concat(stmp,char(tmp));        {tack on to string}
  53.     number := stmp
  54. End;    {of number routine}
  55.  
  56. procedure rawdate(var raw : rawtype);
  57. {
  58.     Fills a 6 element array of integers
  59.     with the decimal time from the
  60.     MM58167 clock chip addressed at the
  61.     port 'cbase' constant.  The form
  62.     of the array is as follows:
  63.  
  64.     Element      Contents (in decimal)
  65.     --------     ---------------------
  66.        1         Month number (1-12)
  67.        2         Day of the month (1-31)
  68.        3         Day of the week (1-7)
  69.        4         Hours (0-23)
  70.        5         Minutes (0-59)
  71.        6         Seconds (0-59)
  72. }
  73. const
  74.     cbase = $0e0;
  75. var
  76.     i, tmp : integer;
  77.     bcddate : rawtype;
  78.     flag : boolean;  {true when read twice the same}
  79. begin   {of rawdate routine}
  80.  
  81.     {get array filled with BCD value quickly ( < 1 second) }
  82.  
  83.     repeat  {until read twice the same}
  84.         for i := 1 to 6 do  {read the array in BCD the first time}
  85.             bcddate[i] := ord(port[cbase+8-i]);  {get BCD value from chip}
  86.         flag := true; {assume we get it correct again}
  87.         for i := 1 to 6 do {try again}
  88.             if bcddate[i] <> ord(port[cbase+8-i]) then
  89.                 flag := false {if not the same clear flag and try again}
  90.     until flag;
  91.  
  92.     {convert from BCD to decimal at our leasure}
  93.  
  94.     for i := 1 to 6 do Begin
  95.         tmp := bcddate[i] div 16;
  96.         raw[i] := tmp * 10 + (bcddate[i] - tmp * 16)
  97.     end
  98. end;   {of rawdate routine}
  99.  
  100. Begin {of getdate routine}
  101.     rawdate(rdate);       {read date and time from port}
  102.  
  103.     case rdate[3] of
  104.         1 : tmp := 'Sun ';
  105.         2 : tmp := 'Mon ';
  106.         3 : tmp := 'Tue ';
  107.         4 : tmp := 'Wed ';
  108.         5 : tmp := 'Thu ';
  109.         6 : tmp := 'Fri ';
  110.         7 : tmp := 'Sat ';
  111.         else
  112.             tmp := '*** ';
  113.     end;
  114.  
  115.     case rdate[1] of
  116.         1 : tmp := tmp + 'Jan ';
  117.         2 : tmp := tmp + 'Feb ';
  118.         3 : tmp := tmp + 'Mar ';
  119.         4 : tmp := tmp + 'Apr ';
  120.         5 : tmp := tmp + 'May ';
  121.         6 : tmp := tmp + 'Jun ';
  122.         7 : tmp := tmp + 'Jul ';
  123.         8 : tmp := tmp + 'Aug ';
  124.         9 : tmp := tmp + 'Sep ';
  125.         10 : tmp := tmp + 'Oct ';
  126.         11 : tmp := tmp + 'Nov ';
  127.         12 : tmp := tmp + 'Dec ';
  128.     else
  129.         tmp := tmp + '*** '
  130.     end;
  131.  
  132.     tmp := tmp + number(rdate[2],false) + ' ';  {add on day of the month}
  133.  
  134.     if rdate[4] >= 12 then begin  {if after 12 pm convert from military time}
  135.         pmflag := true;
  136.         if rdate[4] > 12 then
  137.             rdate[4] := rdate[4] - 12
  138.     end
  139.     else begin
  140.         pmflag := false;
  141.         if rdate[4] = 0 then    {if 12 am}
  142.             rdate[4] := 12
  143.     end;
  144.  
  145.     tmp := tmp + number(rdate[4],false) + ':';   {put hour in}
  146.     tmp := tmp + number(rdate[5],true) + ':';    {put minutes in}
  147.     tmp := tmp + number(rdate[6],true);          {put seconds in}
  148.  
  149.     if pmflag then
  150.         tmp := tmp + ' PM'
  151.     else
  152.         tmp := tmp + ' AM';
  153.  
  154.     getdate := tmp
  155.  
  156. end;   {of getdate routine}
  157.  
  158.  
  159. Begin   {of date program}
  160.     darry := getdate;       {get ASCII for of date and time}
  161.     writeln('Tdate: (Turbo Pascal version of Date)');
  162.     writeln('Current date and time is: ',darry)
  163. end.
  164.