home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPSQAPI1 / DEMOS / DOSDATE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-31  |  3KB  |  105 lines
  1. unit dosdate;
  2.  
  3. INTERFACE
  4.  
  5. Uses Dos;
  6.  
  7. Const WeekStr : array[0..7] of String[10] =
  8.       ('Sunday',
  9.        'Monday',
  10.        'Tuesday',
  11.        'Wednesday',
  12.        'Thursday',
  13.        'Friday',
  14.        'Saturday',
  15.        'All Week');
  16.  
  17. Const months : array[1..13] of string[3] =
  18.    ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec','BUG');
  19.  
  20. function DosDateFormat(d:longint;format:byte):String;
  21.  
  22. implementation
  23.  
  24. (*
  25. Format number
  26.  
  27. 1 - Xpress method of display last usage date           Mmm DD,YYYY HH:MM:SSap
  28. 2 - opus display method for date written in messages   Mmm-DD-YY H:MMap
  29. 3 - Xpress Sysop menu display of last usage.           MM/DD/YY HH:MMap
  30. 4 - used for opus log                                  DD Mmm HH:MM:SS
  31. 5 - used for last usage date in user.bbs (opus)        DD Mmm YY HH:MM:SS
  32. 6 -                                                    Mmm DD, YY
  33. 7 - used for new files lister in OPUS 1.70             MM/DD/YY
  34.  
  35. *)
  36.  
  37.  
  38. Function Format_Date(Dt:datetime;format : byte):String;
  39. var ms,ds,hs,m1s,ss,mhs,ampm   : string[2];
  40.     ys                         : string[4];
  41.  
  42.  
  43.   begin
  44.   ampm := 'am';
  45.   with dt do
  46.     begin
  47.       str(month:2,ms);
  48.       str(day:1,ds);
  49.       str(year:1,ys);
  50.       str(hour:1,mhs);
  51.       if format = 4 then if length(mhs)=1 then mhs := '0'+mhs;
  52.       if format in [3,4,7] then if length(ds)=1  then ds := '0'+ds;
  53.       if format in [2,5] then ys := copy(ys,3,2);
  54.  
  55.       if hour >= 12 then
  56.          begin
  57.            ampm := 'pm';
  58.            if hour > 12 then hour := Hour - 12;
  59.          end;
  60.  
  61.       str(hour:1,hs);
  62.       str(min:2,m1s);
  63.       str(sec:2,ss);
  64.  
  65.       if (format=3) or (format=7) then if hour < 10 then hs := ' '+hs;
  66.       if m1s[1] = ' ' then m1s[1] := '0';
  67.       if ss[1] = ' '  then ss[1] := '0';
  68.       if ms[1] = ' '  then ms[1] := '0';
  69.  
  70.       if not (month in [1..12]) then month := 13;
  71.       if year < 1988 then month := 13;
  72.       if year > 2000 then month := 13;
  73.  
  74.      if (format < 1) or (format > 7) then format := 1;
  75.      case format of
  76.       1 : Format_Date := Months[month]+' '+ds+','+ys+'  '+hs+':'+m1s+':'+ss+ampm;
  77.       2 : Format_Date := Months[month]+'-'+ds+'-'+ys+' '+hs+':'+m1s+ampm;
  78.       3 : Format_date := ms+'/'+ds+'/'+copy(ys,3,2)+' '+hs+':'+m1s+ampm;
  79.       4 : Format_Date := ds+ ' '+Months[month]+' '+mhs+':'+m1s+':'+ss;
  80.       5 : Format_Date := ds+ ' '+Months[month]+' '+ys+' '+mhs+':'+m1s+':'+ss;
  81.       6 : Format_Date := Months[month]+' '+ds+','+ys;
  82.       7 : Format_Date := ms+'/'+ds+'/'+copy(ys,3,2);
  83.      end;
  84.     end;
  85.  end;
  86.  
  87. function DosDateFormat(d:longint;format:byte):String;
  88. {- full date based on dos timestamp date/time two byte format storage}
  89. var dt     : datetime;
  90.     dtst   : record date, time : word; end absolute d;
  91.  begin
  92.    with dtst do
  93.      begin
  94.       dt.year  := (hi(date) shr 1) + 1980;
  95.       dt.month := (date shr 5) and 15;
  96.       dt.day   := lo(date) and 31;
  97.       dt.Hour  := hi(time) shr 3;
  98.       dt.min   := (time shr 5) and 63;
  99.       dt.sec   := (lo(time) and 31) * 2;
  100.      end;
  101.    DosDateFormat := Format_date(dt,format);
  102.  end;
  103.  
  104. end.
  105.