home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d9xx
/
d996
/
newext.lha
/
NewExt
/
Source
/
NewExt.pas
next >
Wrap
Pascal/Delphi Source File
|
1994-04-05
|
4KB
|
114 lines
PROGRAM NewExt;
USES DOS, AmigaDOS; { CLI utility to change multiple files extensions }
{ Lee S Kindness 7.13.93 v1.0 }
{ ================================ }
FUNCTION CheckParams(progname, vernum : string) : BOOLEAN;
BEGIN
IF (PARAMCOUNT = 0) OR (PARAMSTR(1) = '?') THEN BEGIN
WRITELN(progname,' v',vernum,' (c)Lee Kindness 5.12.93');
WRITELN('Usage: ',progname,' <wldcrd.ext> <.newext>');
WRITELN('Eg : ',progname,' #?.pic .ILBM');
WRITELN(' will remove the .pic extension on all matching files');
WRITELN(' and replace with an extension of .ILBM');
WRITELN(progname,': required argument missing');
CheckParams := FALSE;
END ELSE
checkparams := TRUE;
END;
{ ================================ }
PROCEDURE DoTheNaming(InitialName : string; DOSReturnStr : SEARCHREC;
VAR counter : INTEGER);
VAR
NewName : PATHSTR; { new name for the file }
DirBit : dirstr; { directory file is in }
NameBit : NAMESTR; { base name of the file }
ExtBit : extstr; { extension of the file name }
outinitialname : string; { name outputted to screen }
n, myIO : INTEGER; { for loop counter }
OK : boolean;
FUNCTION IsFile(filename : PATHSTR) : BOOLEAN;
VAR attrs : INTEGER;
BEGIN
GETFATTR(filename,Attrs);
IF attrs = Directory THEN
IsFile := FALSE { we don't want to rename a directory with }
ELSE IsFile := TRUE; { an extension if #? is specified }
END;
BEGIN
counter := 0;
WHILE (DosError = 0) DO BEGIN
InitialName := DOSReturnStr.name;
outinitialname := initialname + ' ';
IF IsFile(initialname) THEN BEGIN
FOR n := (length(outinitialname)+1) TO 30 DO
outinitialname := outinitialname + '.'; { pad to make output nicer }
WRITE(' ',outinitialname,' ');
FSPLIT(InitialName,DirBit,NameBit,ExtBit); { split name into individual bits }
NewName := DirBit + NameBit + PARAMSTR(2) + #0; { and glue new name together }
Initialname := Initialname + #0;
OK := RENAME_(@InitialName[1], @NewName[1]);
myIO := IOErr;
CASE myIO OF
0 : BEGIN
WRITELN(newname);
counter := counter + 1; { changed the name of 1 more file }
END; {0}
202 : WRITELN('Can''t rename, in use');
203 : WRITELN('Can''t rename, already exists');
205 : WRITELN('Can''t rename, not found');
213 : WRITELN('Can''t rename, disk not validated');
214 : WRITELN('Can''t rename, disk write protected');
223 : WRITELN('Can''t rename, protected from writing');
225 : WRITELN('Can''t rename, not DOS disk');
226 : WRITELN('Can''t rename, no disk in drive');
ELSE WRITELN('Error ',myIO,' Use Fault command to determine');
END; {case}
END; {if}
FINDNEXT(DOSReturnStr); { patern matching }
END;
END;
{ ================================ }
{ ================================ }
PROCEDURE Main;
CONST
Vernum : string = '1.0'; { current version number }
ver : string = '$VER: NewExt v1.0 (7.12.93) (c)Lee Kindness.';
{ string to be given by version command }
VAR
initialName : PATHSTR; { initial file name/probably a wildcard }
Progname : NAMESTR; { current name of this program }
DOSReturnStr : SEARCHREC; { holds info returned by findfirst/findnext }
counter : INTEGER; { amount of file names changed }
p : pointer; { used to suppress disk insertion alerts }
BEGIN
progname := PARAMSTR(0); { get the program name }
IF CheckParams(ProgName, vernum) THEN BEGIN { check parameters }
p := LOCKALERTWINDOW(NIL);
FINDFIRST(PARAMSTR(1), AnyFile, DOSReturnStr); { find first pattern match }
DoTheNaming(InitialName,DOSReturnStr,counter); { rename and find next matches }
p := LOCKALERTWINDOW(p);
CASE Counter OF
0 : WRITELN('No File extensions changed.');
1 : WRITELN('1 file extension changed.');
ELSE WRITELN(counter,' file extensions changed.');
END; {case} { print out some crap at the end }
END ELSE
HALT(116); {required argument missing} { exit if the parameters were invalid }
END; {main}
{ ================================ }
BEGIN main END.
{ ================================ }