home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / util / batch / NewExt.lha / NewExt / Source / NewExt.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-05  |  4.1 KB  |  114 lines
  1. PROGRAM NewExt;
  2.  
  3. USES DOS, AmigaDOS;   { CLI utility to change multiple files extensions }
  4.             { Lee S Kindness 7.13.93 v1.0                     }
  5.  
  6. { ================================ }
  7.  
  8. FUNCTION CheckParams(progname, vernum : string) : BOOLEAN;
  9. BEGIN
  10.     IF (PARAMCOUNT = 0) OR (PARAMSTR(1) = '?') THEN BEGIN
  11.         WRITELN(progname,' v',vernum,' (c)Lee Kindness 5.12.93');
  12.         WRITELN('Usage: ',progname,' <wldcrd.ext> <.newext>');
  13.         WRITELN('Eg   : ',progname,' #?.pic .ILBM');
  14.         WRITELN('       will remove the .pic extension on all matching files');
  15.         WRITELN('       and replace with an extension of .ILBM');
  16.         WRITELN(progname,': required argument missing');
  17.         CheckParams := FALSE;
  18.     END ELSE
  19.         checkparams := TRUE;
  20. END;
  21.  
  22. { ================================ }
  23.  
  24. PROCEDURE DoTheNaming(InitialName : string; DOSReturnStr : SEARCHREC;
  25.                                 VAR counter : INTEGER);
  26. VAR
  27.     NewName : PATHSTR; { new name for the file          }
  28.     DirBit  : dirstr;  { directory file is in           }
  29.     NameBit : NAMESTR; { base name of the file          }
  30.     ExtBit  : extstr;  { extension of the file name     }
  31.     outinitialname : string; { name outputted to screen }
  32.     n, myIO    : INTEGER; { for loop counter               }
  33.     OK : boolean;
  34.  
  35. FUNCTION IsFile(filename : PATHSTR) : BOOLEAN;
  36. VAR attrs : INTEGER;
  37.     
  38.  
  39. BEGIN
  40.     GETFATTR(filename,Attrs);
  41.     IF attrs = Directory THEN
  42.         IsFile := FALSE   { we don't want to rename a directory with }
  43.     ELSE IsFile := TRUE; { an extension if #? is specified          }
  44. END;
  45.  
  46. BEGIN
  47.     counter := 0;
  48.     WHILE (DosError = 0) DO BEGIN  
  49.         InitialName := DOSReturnStr.name;
  50.         outinitialname := initialname + ' ';
  51.         IF IsFile(initialname) THEN BEGIN
  52.             FOR n := (length(outinitialname)+1) TO 30 DO 
  53.                 outinitialname := outinitialname + '.'; { pad to make output nicer }
  54.             WRITE(' ',outinitialname,' ');
  55.             FSPLIT(InitialName,DirBit,NameBit,ExtBit); { split name into individual bits }
  56.             NewName := DirBit + NameBit + PARAMSTR(2) + #0; { and glue new name together } 
  57.             Initialname := Initialname + #0;
  58.             OK := RENAME_(@InitialName[1], @NewName[1]);
  59.             myIO := IOErr;
  60.             CASE myIO OF
  61.                  0   : BEGIN
  62.                       WRITELN(newname);
  63.                      counter := counter + 1; { changed the name of 1 more file }
  64.                  END; {0}
  65.                  202 : WRITELN('Can''t rename, in use');
  66.                  203 : WRITELN('Can''t rename, already exists');
  67.                  205 : WRITELN('Can''t rename, not found');
  68.                  213 : WRITELN('Can''t rename, disk not validated');
  69.                  214 : WRITELN('Can''t rename, disk write protected');
  70.                  223 : WRITELN('Can''t rename, protected from writing');
  71.                  225 : WRITELN('Can''t rename, not DOS disk');
  72.                  226 : WRITELN('Can''t rename, no disk in drive');
  73.                  ELSE  WRITELN('Error ',myIO,' Use Fault command to determine');
  74.             END; {case} 
  75.         END; {if}
  76.         FINDNEXT(DOSReturnStr); { patern matching }
  77.     END;
  78. END;
  79.  
  80. { ================================ }
  81. { ================================ }         
  82.  
  83. PROCEDURE Main;
  84.  
  85. CONST 
  86.     Vernum : string = '1.0'; { current version number }
  87.     ver    : string = '$VER: NewExt v1.0 (7.12.93) (c)Lee Kindness.';
  88.                          { string to be given by version command }
  89. VAR 
  90.     initialName  : PATHSTR;   { initial file name/probably a wildcard     }
  91.      Progname     : NAMESTR;   { current name of this program              }
  92.     DOSReturnStr : SEARCHREC; { holds info returned by findfirst/findnext }
  93.     counter      : INTEGER;   { amount of file names changed              }
  94.     p            : pointer;   { used to suppress disk insertion alerts    }
  95.  
  96.  
  97. BEGIN
  98.     progname := PARAMSTR(0); { get the program name }
  99.     IF CheckParams(ProgName, vernum) THEN BEGIN { check parameters }
  100.         p := LOCKALERTWINDOW(NIL);        
  101.         FINDFIRST(PARAMSTR(1), AnyFile, DOSReturnStr); { find first pattern match }
  102.         DoTheNaming(InitialName,DOSReturnStr,counter); { rename and find next matches }
  103.         p := LOCKALERTWINDOW(p);
  104.         CASE Counter OF
  105.             0  : WRITELN('No File extensions changed.');
  106.             1  : WRITELN('1 file extension changed.');
  107.             ELSE WRITELN(counter,' file extensions changed.');
  108.         END; {case} { print out some crap at the end }
  109.     END ELSE
  110.         HALT(116); {required argument missing} { exit if the parameters were invalid }
  111. END; {main}
  112. { ================================ }
  113. BEGIN main END.
  114. { ================================ }