home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DATETI.ZIP / DATETI.PAS
Encoding:
Pascal/Delphi Source File  |  1985-09-24  |  2.4 KB  |  95 lines
  1.  
  2. { Turbo Pascal routines to read and set date and time }
  3. { Copyright 1984 Michael A. Covington }
  4.  
  5. { For further documentation see PC Tech Journal, February 1985. }
  6.  
  7. { Each routine requires the following type definitions }
  8. { but does not require the other routines.             }
  9.  
  10. type datetimetype = string[8];
  11.      regtype      = record
  12.                      ax,bx,cx,dx,bp,si,di,ds,es,flags: integer
  13.                     end;
  14.  
  15. Var
  16. Error:integer;
  17.  
  18. function date: datetimetype;
  19.   { Returns current date in form '08/31/84'. }
  20. var  reg:     regtype;
  21.      y,m,d,w: datetimetype;
  22.      i:       integer;
  23. begin
  24.   reg.ax:=$2A00;
  25.   intr($21,reg);
  26.   str(reg.cx:4,y);
  27.   delete(y,1,2);
  28.   str(hi(reg.dx):2,m);
  29.   str(lo(reg.dx):2,d);
  30.   w := m + '/' + d + '/' + y;
  31.   for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
  32.   date:=w
  33. end;
  34.  
  35. function time: datetimetype;
  36.   { Returns current time in form '08:13:59'. }
  37. var  reg:     regtype;
  38.      h,m,s,w: datetimetype;
  39.      i:       integer;
  40. begin
  41.   reg.ax:=$2C00;
  42.   intr($21,reg);
  43.   str(hi(reg.cx):2,h);
  44.   str(lo(reg.cx):2,m);
  45.   str(hi(reg.dx):2,s);
  46.   w := h + ':' + m ;
  47.   for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
  48.   time:=w
  49. end;
  50.  
  51. procedure setdate(x:datetimetype);
  52.   { Sets date.  Accepts string in format '08/31/84'. }
  53. var  reg:            regtype;
  54.      rh,rl,c1,c2,c3: integer;
  55. begin
  56.   reg.ax:=$2B00;
  57.   val(x[1]+x[2],rh,c1);  { month goes in DH }
  58.   val(x[4]+x[5],rl,c2);  { day goes in DL   }
  59.   reg.dx:=rh*256 + rl;
  60.   val(x[7]+x[8],rl,c3);  { year goes in CX  }
  61.   reg.cx:=rl + 1900;
  62.   if rl<80 then reg.cx:=reg.cx+100;  { 21st century }
  63.   c1:=c1+c2+c3;          { return codes from VAL }
  64.   if c1=0 then intr($21,reg);
  65.   if c1+lo(reg.ax) <> 0 then
  66.     begin
  67.       Error:=1;
  68.       {Writeln
  69.       writeln('Error--Invalid date, ''',x,'''');
  70.       halt}
  71.     end 
  72. end; 
  73.  
  74. procedure settime(x:datetimetype); 
  75.   { Sets time.  Accepts string in format '08:13:59'. } 
  76. var  reg:            regtype; 
  77.      rh,rl,c1,c2,c3: integer; 
  78. begin 
  79.   reg.ax:=$2D00; 
  80.   val(x[1]+x[2],rh,c1);    { Hours go in CH   } 
  81.   val(x[4]+x[5],rl,c2);    { Minutes go in CL } 
  82.   reg.cx:=rh*256 + rl; 
  83.   val(x[7]+x[8],rh,c3);    { Seconds go in DH } 
  84.   reg.dx:=rh*256; 
  85.   c1:=c1+c2+c3;            { Return codes from VAL } 
  86.   if c1=0 then intr($21,reg); 
  87.   if c1+lo(reg.ax) <> 0 then 
  88.     begin
  89.       Error :=1;
  90.       {writeln;
  91.       writeln('Error--Invalid time, ''',x,'''');
  92.       halt}
  93.     end
  94. end;
  95.