home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 126 / REDATE!.ZIP / REDATE!.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-09  |  7KB  |  241 lines
  1. program setfiletime;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  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.  
  13. ------------------------------------------------------------------------------}
  14.  
  15. uses dos;
  16. var
  17.    dirinfo : searchrec ;
  18.    ps2     : string ;
  19.    century : word ;
  20.  
  21. procedure showhelp ( errornum : byte );
  22. const
  23.     progdata = 'REDATE!- Free DOS utility: file redater.';
  24.     progdat2 = 'V1.10a: September 9, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  25.  
  26.     usage = 'Usage: REDATE! file(s) [mm/dd/yy (or) mm-dd-yy] [hh:mm:ss (or) hh:mm]';
  27. var
  28.     message : string [80];
  29. begin
  30.     writeln ( progdata );
  31.     writeln ( progdat2 );
  32.     writeln ;
  33.     writeln ( usage );
  34.     writeln ;
  35.  
  36.     case errornum of
  37.       1 : message := 'you must specify -exactly- one filespec (wildcards are OK).';
  38.       2 : message := 'too many parameters.';
  39.       3 : message := 'non-numeric found in a date or time string!';
  40.     end;
  41.     writeln ( 'ERROR: (#',errornum,') - ', message );
  42.     halt ( errornum );
  43. end;
  44.  
  45. function leadingzero ( w : word ) : string ;
  46. var
  47.   s : string ;
  48. begin
  49.   str (w:0,s);
  50.   if length (s) = 1 then
  51.     s := '0' + s;
  52.   leadingzero := s;
  53. end;
  54.  
  55. procedure parsedate ( dates : string ; var cdt : longint );
  56. var
  57.      date_time : datetime;
  58.      valerr : integer ;
  59. begin
  60.      with date_time do
  61.      begin
  62.           val ( copy ( dates ,1,2 ), month, valerr );
  63.               if valerr <> 0 then showhelp (3);
  64.           val ( copy ( dates ,4,2 ), day,   valerr );
  65.               if valerr <> 0 then showhelp (3);
  66.           val ( copy ( dates ,7,2 ), year,  valerr );
  67.               if valerr <> 0 then showhelp (3);
  68.           year := century + year;
  69.      end;
  70.      packtime ( date_time, cdt );
  71. end;
  72.  
  73. procedure parsetime ( times : string ; var cdt : longint );
  74. var
  75.      date_time : datetime;
  76.      valerr : integer ;
  77. begin
  78.      if length ( times ) = 5 then
  79.         times := times + ':00' ;
  80.      with date_time do
  81.      begin
  82.           val ( copy ( times ,1,2 ), hour, valerr );
  83.               if valerr <> 0 then showhelp (3);
  84.           val ( copy ( times ,4,2 ), min,  valerr );
  85.               if valerr <> 0 then showhelp (3);
  86.           val ( copy ( times ,7,2 ), sec,  valerr );
  87.               if valerr <> 0 then showhelp (3);
  88.      end;
  89.      packtime ( date_time, cdt );
  90. end;
  91.  
  92. procedure get_dt ( var cur_dt : longint );
  93. var
  94.     y,mo,d,w,
  95.     h,mi,s,u  : word;
  96.     date_time : datetime;
  97. begin
  98.      getdate (y,mo,d,w);
  99.      gettime (h,mi,s,u);
  100.      with date_time do
  101.      begin
  102.           YEAR := y;  MONTH := mo;  DAY := d;
  103.           HOUR := h;  MIN   := mi;  SEC := s;
  104.      end;
  105.      packtime ( date_time, cur_dt );
  106. end;
  107.  
  108. function extract_file_date ( fname : string ) : string ;
  109. var
  110.     afile : file ;
  111.     fdate : longint ;
  112.     dtt   : datetime ;
  113.     dstr  : string ;
  114. begin
  115.      assign (afile, fname);
  116.      reset (afile);
  117.      getftime (afile, fdate);
  118.      close (afile);
  119.      unpacktime ( fdate, dtt );
  120.      dstr := '' ;
  121.      with dtt do begin
  122.           dstr := dstr + leadingzero ( month ) + '/' ;
  123.           dstr := dstr + leadingzero ( day ) + '/' ;
  124.           dstr := dstr + ( copy ( ( leadingzero ( year )), 3, 2 ));
  125.      end;
  126.      extract_file_date := dstr ;
  127. end;
  128.  
  129. function extract_file_time ( fname : string ) : string ;
  130. var
  131.     afile : file ;
  132.     ftime : longint ;
  133.     dtt   : datetime ;
  134.     tstr  : string ;
  135. begin
  136.      assign (afile, fname);
  137.      reset (afile);
  138.      getftime (afile, ftime);
  139.      close (afile);
  140.      unpacktime ( ftime, dtt );
  141.      tstr := '' ;
  142.      with dtt do begin
  143.           tstr := tstr + leadingzero ( hour ) + ':' ;
  144.           tstr := tstr + leadingzero ( min ) + ':' ;
  145.           tstr := tstr + leadingzero ( sec );
  146.      end;
  147.      extract_file_time := tstr ;
  148. end;
  149.  
  150. procedure stampfile ( fname : string ; ftime : longint );
  151. var
  152.    afile : file ;
  153. begin
  154.      assign (afile, fname);
  155.      reset (afile);
  156.      setftime (afile, ftime);
  157.      close (afile);
  158.      write ('.');
  159. end;
  160.  
  161. procedure todaysdate;
  162. var
  163.    dt : longint ;
  164. begin
  165.      get_dt ( dt );
  166.      while doserror = 0 do begin
  167.            stampfile ( dirinfo.name, dt );
  168.            findnext ( dirinfo );
  169.      end;
  170. end;
  171.  
  172. procedure justdate ( datestr : string );
  173. var
  174.    timestr : string ;
  175.    dt_int  : longint ;
  176. begin
  177.      parsedate ( datestr , dt_int );
  178.      while doserror = 0 do begin
  179.            timestr := extract_file_time ( dirinfo.name );
  180.            parsetime ( timestr , dt_int );
  181.            stampfile ( dirinfo.name , dt_int );
  182.            findnext ( dirinfo );
  183.      end;
  184. end;
  185.  
  186. procedure justtime ( timestr : string );
  187. var
  188.    datestr : string ;
  189.    dt_int  : longint ;
  190. begin
  191.      parsetime ( timestr , dt_int );
  192.      while doserror = 0 do begin
  193.            datestr := extract_file_date ( dirinfo.name );
  194.            parsedate ( datestr , dt_int );
  195.            stampfile ( dirinfo.name , dt_int );
  196.            findnext ( dirinfo );
  197.      end;
  198. end;
  199.  
  200. procedure newdate ( datestr, timestr : string );
  201. var
  202.    dt_int : longint ;
  203. begin
  204.      parsedate ( datestr , dt_int );
  205.      parsetime ( timestr , dt_int );
  206.      while doserror = 0 do begin
  207.            stampfile ( dirinfo.name , dt_int );
  208.            findnext ( dirinfo );
  209.      end;
  210. end;
  211.  
  212. var cent : string ;
  213.     vale : integer ;
  214.  
  215. begin
  216.      findfirst ( paramstr (1), archive, dirinfo );
  217.      if ( doserror <> 0) then
  218.           showhelp(1);
  219.      write ( 'Working ' );
  220.  
  221.      cent := getenv ( 'century' );
  222.      if cent = '' then cent := '1900' ;
  223.      val ( cent, century, vale );
  224.      if vale <> 0 then century := 1900 ;
  225.  
  226.      case paramcount of
  227.           1 : todaysdate;
  228.           2 : begin
  229.                  ps2 := paramstr ( 2 );
  230.                  if (( ps2[3] = '-' ) or
  231.                      ( ps2[3] = '/' )) then justdate ( ps2 )
  232.                  else justtime ( ps2 );
  233.               end;
  234.           3 : newdate ( paramstr (2), paramstr (3) );
  235.      else
  236.           showhelp(2);
  237.      end;   { case }
  238.  
  239.      writeln ( ' done!' );
  240. end.
  241.