home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / moveit / moveit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-05-01  |  9.5 KB  |  267 lines
  1.  
  2.               (* Compiler directives.                               *)
  3.  {$A+,B-,D-,E-,F-,I+,N-,O-,R-,S-,V+}
  4.  
  5.               (* STACK, HEAP memory directives.                     *)
  6.  {$M 1024, 0, 0}
  7.  
  8.               (* Example "File moving" program by Guy McLoughlin.   *)
  9. program MoveIt;
  10.  
  11. uses          (* We need this unit for the paramcount and paramstr  *)
  12.   Dos;        (* routines.                                          *)
  13.  
  14. const
  15.               (* Carridge-return + Line-feed constant.              *)
  16.   coCrLf = #13#10;
  17.  
  18. var
  19.               (* Path display width.                                *)
  20.   byDispWidth : byte;
  21.  
  22.               (* Variable to record the number of files moved.      *)
  23.   woMoveCount : word;
  24.  
  25.               (* "To", "From" directory-string variables.           *)
  26.   stDirTo,
  27.   stDirFrom  : dirstr;
  28.  
  29.               (* "To", "From" path-string variables.                *)
  30.   stPathTo,
  31.   stPathFrom,
  32.   stPathTemp : pathstr;
  33.  
  34.               (* Directory search-record variable.                  *)
  35.   rcSearch : searchrec;
  36.  
  37.               (* File-variable to move files with.                  *)
  38.   fiTemp : file;
  39.  
  40.  
  41.    (***** Handle file errors.                                       *)
  42.    procedure ErrorHandler(byErrorNum : byte; boHalt : boolean);
  43.    begin
  44.      case byErrorNum of
  45.  
  46.        1 : begin
  47.              writeln(coCrLf, ' (SYNTAX) MOVEIT <path1><filespec>' +
  48.                      ' <path2>');
  49.              writeln(coCrLf, ' (USEAGE) MOVEIT c:\bat\*.bat c:\temp');
  50.              writeln(        '          MOVEIT   \bat\*.bat   \temp');
  51.              writeln(coCrLf,' (Moves all files with the ''.bat'' ' +
  52.                      'extension from )');
  53.              writeln(' (the ''c:\bat'' directory, to ''c:\temp'' ' +
  54.                      'directory.)');
  55.              writeln(coCrLf,' ( Public-domain util by Guy McLoughlin' +
  56.                             ' \ Aug ''92)')
  57.            end;
  58.  
  59.        2 : writeln(coCrLf, ' Error : <path1> = <path2>');
  60.  
  61.        3 : writeln(coCrLf,
  62.                          ' Error : Directories must be on same disk');
  63.  
  64.        4 : writeln(coCrLf, ' <path1> not found ---> ', stDirFrom);
  65.  
  66.        5 : writeln(coCrLf, ' <path2> not found ---> ', stDirTo);
  67.  
  68.        6 : writeln(coCrLf, ' Duplicate file found  ------------>  ',
  69.                                    (stDirTo + rcSearch.name), coCrLf);
  70.  
  71.      end;     (* case byErrorNum.                                   *)
  72.  
  73.      if boHalt then
  74.        halt
  75.  
  76.    end;       (* ErrorHandler.                                      *)
  77.  
  78.  
  79.    (***** Determine if a file exists.                               *)
  80.    function FileExist(FileName : pathstr) : boolean;
  81.    begin
  82.      FileExist := (FSearch(FileName, '') <> '')
  83.    end;       (* FileExist.                                         *)
  84.  
  85.  
  86.    (***** Determine if a directory exists.                          *)
  87.    function DirExist(stDir : dirstr) : boolean;
  88.    var
  89.      woFattr : word;
  90.      fiTemp  : file;
  91.    begin
  92.      assign(fiTemp, (stDir + '.'));
  93.      getfattr(fiTemp, woFattr);
  94.      if (doserror <> 0) then
  95.        DirExist := false
  96.      else
  97.        DirExist := ((woFattr and directory) <> 0)
  98.    end;       (* DirExist.                                          *)
  99.  
  100.  
  101.    (***** Returns all valid wildcard names for a specific directory.*)
  102.    (*     When the last file is found, the next call will return an *)
  103.    (*     empty string. To re-set this routine, pass it an empty    *)
  104.    (*     path-string.                                              *)
  105.    (*                                                               *)
  106.    (* NOTE: Standard TP DOS unit must be listed in your program's   *)
  107.    (*       "uses" directive, for this routine to compile.          *)
  108.  
  109.    function WildCardNames({ input}     stPath   : pathstr;
  110.                                        woAttr   : word;
  111.                           {update} var stDir    : dirstr;
  112.                                    var rcSearch : searchrec)
  113.                           {output}              : pathstr;
  114.    var
  115.               (* Fsplit variables.                                  *)
  116.      stName : namestr;
  117.      stExt  : extstr;
  118.    begin
  119.               (* If the search-record "name" field is empty, then   *)
  120.               (* initialize it with the first matching file found.  *)
  121.      if (rcSearch.name = '') then
  122.        begin
  123.               (* Obtain directory-string from passed path-string.   *)
  124.          fsplit(stPath, stDir, stName, stExt);
  125.  
  126.               (* Find first match of path-string.                   *)
  127.          findfirst(stPath, woAttr, rcSearch);
  128.  
  129.               (* If a matching file was found, then return full     *)
  130.               (* path-name.                                         *)
  131.          if (doserror = 0) and (rcSearch.name <> '') then
  132.            WildCardNames := (stDir + rcSearch.name)
  133.          else
  134.               (* No match found, return empty string.               *)
  135.            WildCardNames := ''
  136.        end
  137.      else
  138.               (* Search-record "name" field is not empty, so        *)
  139.               (* continue searching for matches.                    *)
  140.        begin
  141.          findnext(rcSearch);
  142.  
  143.               (* If no error occurred, then match was found...      *)
  144.          if (doserror = 0) then
  145.            WildCardNames := (stDir + rcSearch.name)
  146.          else
  147.               (* No match found. Re-set search-record "name" field, *)
  148.               (* and return empty path-string.                      *)
  149.            begin
  150.              rcSearch.name := '';
  151.              WildCardNames := ''
  152.            end
  153.        end
  154.    end;
  155.  
  156.  
  157.    (***** Pad a string with extras spaces on the right.             *)
  158.    function PadR(stIn : string; bySize : byte) : string;
  159.    begin
  160.      fillchar(stIn[succ(length(stIn))], (bySize - length(stIn)) ,' ');
  161.      inc(stIn[0], (bySize - length(stIn)));
  162.      PadR := stIn
  163.    end;       (* PadR.                                              *)
  164.  
  165.  
  166. var           (* Variables used with the TP "FSplit" procedure.     *)
  167.   stName : namestr;
  168.   stExt  : extstr;
  169.  
  170.  
  171.               (* Main program execution block.                      *)
  172. BEGIN
  173.               (* If too many or too few parameters, display syntax. *)
  174.   if (paramcount <> 2) then
  175.     ErrorHandler(1, true);
  176.  
  177.               (* Assign program parameters to string variables.     *)
  178.   stPathFrom := paramstr(1);
  179.   stPathTo   := paramstr(2);
  180.  
  181.               (* Make sure full path-string is used.                *)
  182.   stPathFrom := fexpand(stPathFrom);
  183.   stPathTo := fexpand(stPathTo);
  184.  
  185.               (* Make sure that "To" directory ends with '\'        *)
  186.               (* character.                                         *)
  187.   if (stPathTo[length(stPathTo)] <> '\') then
  188.     stPathTo := stPathTo + '\';
  189.  
  190.               (* Seperate directory-strings from path-strings.      *)
  191.   fsplit(stPathFrom, stDirFrom, stName, stExt);
  192.   fsplit(stPathTo, stDirTo, stName, stExt);
  193.  
  194.               (* Check if "From" directory-string is the same as    *)
  195.               (* the "To" directory.                                *)
  196.   if (stDirFrom = stDirTo) then
  197.     ErrorHandler(2, true);
  198.  
  199.               (* Determine the full path display width.             *)
  200.   if (stDirFrom[0] > stDirTo[0]) then
  201.     byDispWidth := length(stDirFrom) + 12
  202.   else
  203.     byDispWidth := length(stDirTo) + 12;
  204.  
  205.               (* Make sure that files are on the same disk.         *)
  206.   if (stDirFrom[1] <> stDirTo[1]) then
  207.     ErrorHandler(3, true);
  208.  
  209.               (* Make sure that "From" directory exists.            *)
  210.   if NOT DirExist(stDirFrom) then
  211.     ErrorHandler(4, true);
  212.  
  213.               (* Make sure that "To" directory exists.              *)
  214.   if NOT DirExist(stDirTo) then
  215.     ErrorHandler(5, true);
  216.  
  217.               (* Clear the search-record, before begining.          *)
  218.   fillchar(rcSearch, sizeof(rcSearch), 0);
  219.  
  220.               (* Initialize copy-counter.                           *)
  221.   woMoveCount := 0;
  222.  
  223.               (* Set file-mode to "read-only".                      *)
  224.   filemode := 0;
  225.  
  226.   writeln;
  227.  
  228.               (* Repeat... ...Until (stPathTemp = '').              *)
  229.   repeat
  230.               (* Search for vaild filenames.                        *)
  231.     stPathTemp := WildCardNames(stPathFrom, archive, stDirFrom,
  232.                                                             rcSearch);
  233.  
  234.               (* If file search was successful, then...             *)
  235.     if (stPathTemp <> '') then
  236.  
  237.               (* Check if a duplicate file exists in the "To" dir.  *)
  238.       if NOT FileExist(stDirTo + rcSearch.name) then
  239.         begin
  240.               (* Move file from "From" directory to "To" directory. *)
  241.           assign(fiTemp, stPathTemp);
  242.           rename(fiTemp, (stDirTo + rcSearch.name));
  243.  
  244.               (* Increment move-counter by 1.                       *)
  245.           inc(woMoveCount);
  246.  
  247.               (* Let the user know that a file has been moved.      *)
  248.           writeln(' ',PadR((stDirFrom + rcSearch.name), byDispWidth),
  249.                 ' MOVED TO --->  ', (stDirTo + rcSearch.name));
  250.         end
  251.  
  252.       else
  253.               (* Duplicate file found in the "To" directory.        *)
  254.         ErrorHandler(6, false)
  255.  
  256.               (* Repeat... ...Until no more files are found.        *)
  257.   until (stPathTemp = '');
  258.  
  259.               (* Display the number of files moved.                 *)
  260.   if (woMoveCount = 0) then
  261.     writeln(' NO FILES MOVED TO  --------------->  ', stDirTo)
  262.   else
  263.     writeln(coCrLf, ' ', woMoveCount, ' FILES MOVED')
  264. END.
  265.  
  266.  
  267.