home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / dt122.zip / DT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-22  |  8KB  |  273 lines
  1. program setfiletime;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release (as REDATE!).  DDA
  7. v1.10  : 1993/09/07.  Added support for single field specification,
  8.                             suggestion and assistance from Don Dougherty.  DDA
  9.                       Added support for century.
  10.                             (Set century=2000 for 20th century dates.)  DDA
  11. v1.10a : 1993/09/09.  Now specifying seconds is optional, default is :00  DDA
  12. v1.11  : 1993/09/13.  Added "/p": prompt for date, time doesn't change.  DDA
  13. v1.15  : 1993/09/28.  Increased date & time specification flexibility.  DDA
  14. v1.20  : 1993/10/20.  Now can stamp files not in current directory.  DDA
  15. v1.21  : 1994/02/17.  Overlooked portion of code in making prior enhancement,
  16.                       now fixed.  NO PUBLIC RELEASE.  DDA
  17. v1.22  : 1994/05/22.  New name (DT), fully tested, & (hopefully) debugged. DDA
  18.  
  19. ------------------------------------------------------------------------------}
  20.  
  21. uses dos ;
  22. var
  23.    dirinfo : searchrec ;
  24.    ps1     : pathstr ;
  25.    rdir    : dirstr ;
  26.    rname   : namestr ;
  27.    rext    : extstr ;
  28.    ps2     : string ;
  29.    century : word ;
  30.  
  31. procedure showhelp ( errornum : byte );
  32. const
  33.     progdata = 'DT- Free DOS utility: file redater.';
  34.     progdat2 = 'v1.22: May 22, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  35.  
  36.     usage = 'Usage: DT file(s) [mm/dd/yy (or) mm-dd-yy] [hh:mm[:ss]]';
  37.     usag2 = '  or : DT file(s) /p  (prompt for date, time doesn''t change)';
  38. var
  39.     message : string [80];
  40. begin
  41.     writeln ( progdata );
  42.     writeln ( progdat2 );
  43.     writeln ;
  44.     writeln ( usage );
  45.     writeln ( usag2 );
  46.     writeln ;
  47.  
  48.     case errornum of
  49.       1 : message := 'you must specify -exactly- one filespec (wildcards are OK).';
  50.       2 : message := 'too many parameters.';
  51.       3 : message := 'non-numeric found in a date or time string!';
  52.     end;
  53.     writeln ( 'ERROR: (#',errornum,') - ', message );
  54.     halt ( errornum );
  55. end;
  56.  
  57. function leadingzero ( w : word ) : string ;
  58. var
  59.   s : string ;
  60. begin
  61.   str (w:0,s);
  62.   if length (s) = 1 then
  63.     s := '0' + s;
  64.   leadingzero := s;
  65. end;
  66.  
  67. procedure parsedate ( dates : string ; var cdt : longint );
  68. var
  69.      date_time : datetime;
  70.      valerr : integer ;
  71. begin
  72.      if ( length ( dates ) = 7 ) then
  73.         dates := '0'+dates;
  74.      with date_time do
  75.      begin
  76.           val ( copy ( dates ,1,2 ), month, valerr );
  77.               if valerr <> 0 then showhelp (3);
  78.           val ( copy ( dates ,4,2 ), day,   valerr );
  79.               if valerr <> 0 then showhelp (3);
  80.           val ( copy ( dates ,7,2 ), year,  valerr );
  81.               if valerr <> 0 then showhelp (3);
  82.           year := century + year;
  83.      end;
  84.      packtime ( date_time, cdt );
  85. end;
  86.  
  87. procedure parsetime ( times : string ; var cdt : longint );
  88. var
  89.      date_time : datetime;
  90.      valerr : integer ;
  91. begin
  92.      if (( length ( times ) = 4 )
  93.       or ( length ( times ) = 7 )) then
  94.         times := '0'+times;
  95.      if ( length ( times ) = 5 ) then
  96.         times := times + ':00' ;
  97.      with date_time do
  98.      begin
  99.           val ( copy ( times ,1,2 ), hour, valerr );
  100.               if valerr <> 0 then showhelp (3);
  101.           val ( copy ( times ,4,2 ), min,  valerr );
  102.               if valerr <> 0 then showhelp (3);
  103.           val ( copy ( times ,7,2 ), sec,  valerr );
  104.               if valerr <> 0 then showhelp (3);
  105.      end;
  106.      packtime ( date_time, cdt );
  107. end;
  108.  
  109. procedure get_dt ( var cur_dt : longint );
  110. var
  111.     y,mo,d,w,
  112.     h,mi,s,u  : word;
  113.     date_time : datetime;
  114. begin
  115.      getdate (y,mo,d,w);
  116.      gettime (h,mi,s,u);
  117.      with date_time do
  118.      begin
  119.           YEAR := y;  MONTH := mo;  DAY := d;
  120.           HOUR := h;  MIN   := mi;  SEC := s;
  121.      end;
  122.      packtime ( date_time, cur_dt );
  123. end;
  124.  
  125. function extract_file_date ( fname : string ) : string ;
  126. var
  127.     afile : file ;
  128.     fdate : longint ;
  129.     dtt   : datetime ;
  130.     dstr  : string ;
  131. begin
  132.      assign (afile, rdir+fname);
  133.      reset (afile);
  134.      getftime (afile, fdate);
  135.      close (afile);
  136.      unpacktime ( fdate, dtt );
  137.      dstr := '' ;
  138.      with dtt do begin
  139.           dstr := dstr + leadingzero ( month ) + '/' ;
  140.           dstr := dstr + leadingzero ( day ) + '/' ;
  141.           dstr := dstr + ( copy ( ( leadingzero ( year )), 3, 2 ));
  142.      end;
  143.      extract_file_date := dstr ;
  144. end;
  145.  
  146. function extract_file_time ( fname : string ) : string ;
  147. var
  148.     afile : file ;
  149.     ftime : longint ;
  150.     dtt   : datetime ;
  151.     tstr  : string ;
  152. begin
  153.      assign (afile, rdir+fname);
  154.      reset (afile);
  155.      getftime (afile, ftime);
  156.      close (afile);
  157.      unpacktime ( ftime, dtt );
  158.      tstr := '' ;
  159.      with dtt do begin
  160.           tstr := tstr + leadingzero ( hour ) + ':' ;
  161.           tstr := tstr + leadingzero ( min ) + ':' ;
  162.           tstr := tstr + leadingzero ( sec );
  163.      end;
  164.      extract_file_time := tstr ;
  165. end;
  166.  
  167. procedure stampfile ( fname : string ; ftime : longint );
  168. var
  169.    afile : file ;
  170. begin
  171.      assign (afile, rdir+fname);
  172.      reset (afile);
  173.      setftime (afile, ftime);
  174.      close (afile);
  175.      write ('.');
  176. end;
  177.  
  178. procedure todaysdate;
  179. var
  180.    dt : longint ;
  181. begin
  182.      get_dt ( dt );
  183.      while doserror = 0 do begin
  184.            stampfile ( dirinfo.name, dt );
  185.            findnext ( dirinfo );
  186.      end;
  187. end;
  188.  
  189. procedure justdate ( datestr : string );
  190. var
  191.    timestr : string ;
  192.    dt_int  : longint ;
  193. begin
  194.      parsedate ( datestr , dt_int );
  195.      while doserror = 0 do begin
  196.            timestr := extract_file_time ( dirinfo.name );
  197.            parsetime ( timestr , dt_int );
  198.            stampfile ( dirinfo.name , dt_int );
  199.            findnext ( dirinfo );
  200.      end;
  201. end;
  202.  
  203. procedure justtime ( timestr : string );
  204. var
  205.    datestr : string ;
  206.    dt_int  : longint ;
  207. begin
  208.      parsetime ( timestr , dt_int );
  209.      while doserror = 0 do begin
  210.            datestr := extract_file_date ( dirinfo.name );
  211.            parsedate ( datestr , dt_int );
  212.            stampfile ( dirinfo.name , dt_int );
  213.            findnext ( dirinfo );
  214.      end;
  215. end;
  216.  
  217. procedure newdate ( datestr, timestr : string );
  218. var
  219.    dt_int : longint ;
  220. begin
  221.      parsedate ( datestr , dt_int );
  222.      parsetime ( timestr , dt_int );
  223.      while doserror = 0 do begin
  224.            stampfile ( dirinfo.name , dt_int );
  225.            findnext ( dirinfo );
  226.      end;
  227. end;
  228.  
  229. var cent : string ;
  230.     vale : integer ;
  231.  
  232. begin
  233.      ps1 := ( fexpand ( paramstr (1) ));
  234.      fsplit ( ps1,rdir,rname,rext );
  235.      findfirst ( ps1, archive, dirinfo );
  236.      if ( doserror <> 0) then
  237.           showhelp(1);
  238.      write ( 'Working ' );
  239.  
  240.      cent := getenv ( 'century' );
  241.      if cent = '' then cent := '1900' ;
  242.      val ( cent, century, vale );
  243.      if vale <> 0 then century := 1900 ;
  244.  
  245.      case paramcount of
  246.           1 : todaysdate;
  247.           2 : begin
  248.                  ps2 := paramstr ( 2 );
  249.                  if ((ps2 = '/p') or (ps2 = '/P')) then begin
  250.                     while ( length (ps2) < 8) do begin
  251.                        writeln ;
  252.                        writeln ('Enter a date in the format mm/dd/yy:');
  253.                        readln  (ps2);
  254.                     end;
  255.                     justdate (ps2);
  256.                  end
  257.                  else begin
  258.                     if (( length (ps2) = 4 )
  259.                      or ( length (ps2) = 7 )) then
  260.                        ps2 := '0'+ps2;
  261.                     if (( ps2[3] = '-' ) or
  262.                         ( ps2[3] = '/' )) then justdate ( ps2 )
  263.                     else justtime ( ps2 );
  264.                  end;
  265.               end;
  266.           3 : newdate ( paramstr (2), paramstr (3) );
  267.      else
  268.           showhelp(2);
  269.      end;   { case }
  270.  
  271.      writeln ( ' done!' );
  272. end.
  273.