home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / IOFUNC.ZIP / WTIME.LIB < prev    next >
Encoding:
Text File  |  1986-04-12  |  3.0 KB  |  68 lines
  1. {           ╔═══╦══════════════════════════════════════════════╦═══╗
  2.             ║   ║         Pascal Library by Scott Wade         ║   ║
  3.             ║   ║           715 FM 1959      Apt 310           ║   ║
  4.             ║   ║           Houston, TX 77034                  ║   ║
  5.      ┌──────╨───╨──────────────────────────────────────────────╨───╨──────┐
  6.      │  This  group of routines is contributed to public domain,  and no  │
  7.      │  one can possibly get any commercial value out of them since they  │
  8.      │  must be used in other programs. I require that if these are used  │
  9.      │  as is in  any  program,  that this banner remain with the source  │
  10.      │  code of the program.  I would appreciate any comments or sugges-  │
  11.      │  tions on improvements, & am curious to hear how these are used.   │
  12.      │  You can leave a message for me on these BBS's:                    │
  13.      │          Ziggy's  821-1391         ScoreBoard  583-7848            │
  14.      │          TBL-COMM 661-9040         Test-Mode   660-9252            │
  15.      └────────────────────────────────────────────────────────────────────┘
  16.  
  17.  wTime.LIB v1.2   current Time and Date library.
  18.  v1.1: 9 /27/85 : The '19' is chopped from year to allow the date to fit into
  19.        global type word : string[ 10 ]
  20.  v1.2: 10/17/85 : procedure wMONTH added to allow other routines to convert
  21.        integers 1-12 to months. wTime calls wMonth. }
  22.  
  23. procedure wMonth( mnth : integer ; var Date : word );
  24. begin
  25.    case Mnth of
  26.       1 : Date := 'JAN' ;    2 : Date := 'FEB' ;
  27.       3 : Date := 'MAR' ;    4 : Date := 'APR' ;
  28.       5 : Date := 'MAY' ;    6 : Date := 'JUN' ;
  29.       7 : Date := 'JUL' ;    8 : Date := 'AUG' ;
  30.       9 : Date := 'SEP' ;   10 : Date := 'OCT' ;
  31.      11 : Date := 'NOV' ;   12 : Date := 'DEC'
  32.    else   Date := 'ERR'
  33.    end  { end CASE }
  34. end{ wMonth };
  35.  
  36. procedure wTime(var Time, Date : Word);
  37. type
  38.   regpack    = record  ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;   end;
  39. var
  40.   recpack        : regpack ;             {assign record}
  41.   day,year       : string[ 4];
  42.   hour,min,sec   : string[ 2];
  43.   ah,al          : byte ;
  44. begin
  45.    ah := $2c;                             {initialize correct registers}
  46.    with recpack do ax := ah shl 8 + al   ;
  47.    intr($21,recpack);                     {call interrupt}
  48.  
  49.    with recpack do    begin
  50.       str(cx shr 8,hour);                  {convert to string}
  51.       str(cx mod 256,min);                       { " }
  52.       str(dx shr 8,sec);
  53.    end{ WITH RecPack DO };
  54.  
  55.    time := hour + ':' + min + ':' + sec ;
  56.  
  57.    with recpack do ax := $2a shl 8;
  58.    MsDos(recpack);                        { call function }
  59.    with recpack do  begin
  60.       str(cx,year)        ;                {convert to string}
  61.       str(dx mod 256,day) ;                { " }
  62.    end;{ WITH RecPack DO }
  63.    wMonth( (recpack.dx shr 8), Date);
  64.    year := copy( year, 3, 4);
  65.    date := Date + '/' + day + '/' + year ;
  66. end;{ wTime.LIB
  67. *****************************************************************************}
  68.