program forEach;
{$M 15000, 0, 0} { uses about 30k. can be loaded high }
{
foreach is a funky batch utility
see foreach.txt for syntax and examples
written using turbo pascal 7. not very portable code - makes assumptions
on how tp stores its strings, and other dos/memory related stuff.
public domain
byron jones
to compile :
1. build foreach.pas to disk -> foreach.exe
2. run makehelp.pas. this will modify the exeSizeId constant in the
complied exe to the correct value, then prepend the file foreach.txt
to the end of the end of foreach.exe
or
run make.bat :)
}
uses
dos;
type
{ source types }
srcProcT = procedure (
var fileName : string;
var attr : word;
var moreFiles : boolean
);
fileSpecT =
record
spec : string;
search : searchRec;
end;
listFileT =
record
fileName : string;
t : text;
end;
const
exeSizeId : array[1..4] of char = 'tman';
power26 : array[1..6] of longInt = (26, 676, 17576, 456976, 11881376, 308915776); { 26 ^ n }
var
exeSize : longInt absolute exeSizeId;
recursive : boolean; { process directories recursivly }
verbose : boolean; { displays individual commands }
quiet : boolean; { supress foreach output except error messages }
ultraQuiet : boolean; { supress foreach output including error messages }
incdir : boolean; { include directories when expanding <filespec> }
incFile : boolean; { include files when expanding <filespec> }
incHidden : boolean; { include hidden files when expanding <filespec> }
test : boolean; { test mode - don't execute commands }
interactive : boolean; { y/n/a/q for each file }
processAll : boolean; { true if answered 'a' in interactive mode }
padLength : byte; { length to pad $# & $a to }
fileCount : word; { count of files matching <filespec> }
rootPath : string; { root path - usually cwd }
srcFirst : srcProcT; { proc for returning first file }
srcNext : srcProcT; { proc for returning sucessive files }
srcBuffer : array[0..sizeOf ({ biggest source type }listFileT)] of byte;
fileSpecData : fileSpecT absolute srcBuffer;
listFileData : listFileT absolute srcBuffer;
command : string; { command to execute }
dd : string[2]; { current day }
mm : string[2]; { current month }
yy : string[2]; { current year }
yyyy : string[4]; { current year }
tmpFile : string; { full path to temp file }
{--
tools
--}
var
kbdHead : word absolute $0000:$041a;
kbdTail : word absolute $0000:$041c;
function keyPressed : boolean; assembler;
asm
xor ax, ax
mov es, ax
mov ax, [es:kbdHead]
sub ax, [es:kbdTail]
jz @@1
mov ax, 1
@@1:
sti
end;
function readKey : word; assembler;
asm
xor ax, ax
int $16
end;
function fileExist (fileName : string) : boolean;
var
tmpF : file;
attr : word;
begin
assign (tmpF, fileName);
getFAttr (tmpF, attr);
fileExist := dosError = 0;
end;
function dirExist (dirName : string) : boolean;
var
tmpF : file;
noError : boolean;
dirNameLen : byte absolute dirName;
begin
if dirName[dirNameLen] <> '\' then dirName := dirName + '\';
assign (tmpF, dirName + 'NUL.EXT');
{$I-}
reset (tmpF);
{$I+}
noError := ioResult = 0;
if noError then close (tmpF);
dirExist := noError;
end;
function cleanStr (s : string) : string;
const
whiteSpace : set of char = [' ', #9{tab}];
var
sLen : byte absolute s;
begin
while (sLen <> 0) and (s[sLen] in whiteSpace) do
dec (sLen);
while (sLen <> 0) and (s[1] in whiteSpace) do
begin
dec (sLen);
move (s[2], s[1], sLen);
end;
cleanStr := s;
end;
{--
init / deinit
--}
procedure quit (message : string; errorCode : byte);
{
foreach exit procedure
if message is 'help' the help file is displayed otherwise the
message is displayed
}
var
ch : char;
tmpF : file;
keyPressed : boolean;
s : string[79];
numRead : integer;
begin
{ delete the temp file if it exists }
if fileExist (tmpFile) then
begin
assign (tmpF, tmpFile);
{$I-}
erase (tmpF);
{$I+}
if ioResult <> 0 then { i don't care };
end;
if message = 'help' then { show help }
begin
assign (tmpF, fExpand (paramStr (0)));
{$I-}
reset (tmpF, 1);
{$I+}
if (ioResult <> 0) or (exeSize = $6E616D74 {tman}) then quit ('help!', 255);
{ exeSize is replaced with the real size by makehelp.pas }
seek (tmpF, exeSize);
blockread (tmpF, s, sizeOf (s), numRead);
while numRead <> 0 do
begin
writeln (s);
blockread (tmpF, s, sizeOf (s), numRead);
end;
close (tmpF);
end
else if not ultraQuiet then
writeln ('foreach: ', message);
halt (errorCode);
end;
{$F+}
procedure fileSpecFirst (var fileName : string; var attr : word; var moreFiles : boolean); forward;
procedure fileSpecNext (var fileName : string; var attr : word; var moreFiles : boolean); forward;
procedure listFileFirst (var fileName : string; var attr : word; var moreFiles : boolean); forward;
procedure listFileNext (var fileName : string; var attr : word; var moreFiles : boolean); forward;
{$F-}
procedure initialise;
{
this procedure parses the command line parameters and sets the globals
}
var
param : string[80];
paramLen : byte absolute param;
n,
m : integer;
commandLen : byte absolute command;
t,
u : text;
day,
month,
year,
w : word;
dir : dirStr;
name : nameStr;
ext : extStr;
buffer : string absolute srcBuffer;
tmpFileLen : byte absolute tmpFile;
rootPathLen : byte absolute rootPath;
begin
randomize;
{ set temp file name }
tmpFile := getEnv ('TEMP');
if tmpFile = '' then tmpFile := 'C:\';
if tmpFile[tmpFileLen] <> '\' then tmpFile := tmpFile + '\';
tmpFile := tmpFile + 'foreach.tmp';
{ default options }
rootPath := '.\';
srcFirst := nil;
srcNext := nil;
recursive := false;
verbose := false;
quiet := false;
ultraQuiet := false;
incDir := false;
incFile := true;
incHidden := false;
test := false;
interactive := false;
processAll := false;
padLength := 1;
fileCount := 0;
{ get complete command line }
move (ptr (preFixSeg, $80)^, command, 127);
command := cleanStr (command);
{ read foreach command line options }
n := 1;
param := paramStr (n);
while (n <= paramCount) and (param[1] in ['-', '/']) and (param <> '-') do
begin
w := 2;
while w <= paramLen do
begin
case param[w] of
'?' : quit ('help', 0);
'd' : incdir := true;
'D' :
begin
incdir := true;
incFile := false;
end;
'h' : incHidden := true;
'i' : interactive := true;
'p' :
begin
inc (w);
val (param[w], padLength, m);
if (m <> 0) or (w > paramLen) then quit ('invalid pad length: ' + param[w], 14);
end;
'q' : quiet := true;
'Q' : ultraQuiet := true;
'r' : recursive := true;
't' :
begin
test := true;
verbose := true;
end;
'v' : verbose := true;
else
quit ('invalid parameter: ' + param[w], 11);
end;
inc (w);
end;
dec (commandLen, paramLen);
move (command[paramLen + 1], command[1], commandLen);
command := cleanStr (command);
inc (n);
param := paramStr (n);
end;
if padLength > 6 then padLength := 6;
if (paramCount < 2) or (n > paramCount) then
if incHidden then { -h by itself = show help }
quit ('help', 0)
else
quit ('not enough parameters (-? for help)', 10);
{ check for a list file }
if param[1] = '@' then
begin
listFileData.fileName := copy (param, 2, paramLen - 1);
if not fileExist (listFileData.fileName) then quit ('couldn''t open list file: ' + listFileData.fileName, 30);
srcFirst := listFileFirst;
srcNext := listFileNext;
if verbose then writeln ('reading from: ', listFileData.fileName);
end
else if param = '-' then { reading from stdin }
begin
{ so input to foreach from stdin isn't passed onto programs that
foreach runs, read all stdin into a temp file }
assign (t, tmpFile);
{$I-}
rewrite (t);
{$I+}
if ioResult <> 0 then quit ('couldn''t create temp file: ' + tmpFile, 32);
assign (u, '');
reset (u);
while not eof (u) do
begin
readln (u, buffer);
writeln (t, buffer);
end;
close (u);
close (t);
listFileData.fileName := tmpFile;
srcFirst := listFileFirst;
srcNext := listFileNext;
if verbose then writeln ('reading from: stdin');
end
else
begin
{ parse filespec }
rootPath := fExpand (param);
if dirExist (rootPath) then
if rootPath[rootPathLen] <> '\' then
rootPath := rootPath + '\';
{ split root path and filespec }
fSplit (rootPath, dir, name, ext);
if name = '' then name := '*';
if ext = '' then ext := '.*';
fileSpecData.spec := name + ext;
rootPath := dir;
srcFirst := fileSpecFirst;
srcNext := fileSpecNext;
if verbose then writeln ('reading from: ', fileSpecData.spec);
end;
{ read command from command line }
m := pos (param, command);
inc (m, paramLen);
if m > commandLen then
command := ''
else
begin
dec (commandLen, m);
move (command[m + 1], command[1], commandLen);
command := cleanStr (command);
end;
if command = '' then quit ('no command specified', 12);
if verbose then writeln ('command line: ', command);
{ replace literial ;'s & $'s here because it's easier :) }
n := 1;
while n <= commandLen do
begin
if command[n] = '$' then
if command[n + 1] = ';' then
begin
dec (commandLen);
move (command[n + 1], command[n], 255);
command[n] := #0;
end
else if command[n + 1] = '$' then
begin
dec (commandLen);
move (command[n + 1], command[n], 255);
command[n] := #1;
end
else
inc (n);
inc (n);
end;
{ get date and time }
getDate (year, month, day, w);
str (day, dd);
str (month, mm);
str (year, yyyy);
str ((year - 1900), yy);
end;
{--
source processing
--}
procedure processPath (path : string); forward;
procedure fileSpecFirst (var fileName : string; var attr : word; var moreFiles : boolean);
begin
{ set findfirst attibute }
attr := archive;
if incDir then inc (attr, directory);
if incHidden then inc (attr, hidden);
findFirst (fileName + fileSpecData.spec, attr, fileSpecData.search);
fileName := fileName + fileSpecData.search.name;
attr := fileSpecData.search.attr;
moreFiles := dosError = 0;
end;
procedure fileSpecNext (var fileName : string; var attr : word; var moreFiles : boolean);
begin
findNext (fileSpecData.search);
fileName := fileName + fileSpecData.search.name;
attr := fileSpecData.search.attr;
moreFiles := dosError = 0;
end;
procedure listFileNext (var fileName : string; var attr : word; var moreFiles : boolean);
var
p : byte;
f : file;
begin
moreFiles := not eof (listFileData.t);
if moreFiles then
begin
readln (listFileData.t, fileName);
{ grab only the first 'word' on each line }
p := pos (' ', fileName);
if p <> 0 then fileName := copy (fileName, 1, p - 1);
{ convert from unix to dos slashes }
while pos ('/', fileName) <> 0 do
fileName[pos ('/', fileName)] := '\';
assign (f, fileName);
getFAttr (f, attr);
if dosError <> 0 then attr := 0;
end;
end;
procedure listFileFirst (var fileName : string; var attr : word; var moreFiles : boolean);
begin
assign (listFileData.t, listFileData.fileName);
{$I-}
reset (listFileData.t);
{$I+}
if ioResult <> 0 then quit ('invalid list file ' + listFileData.fileName, 30);
listFileNext (fileName, attr, moreFiles);
end;
{--
main procs
--}
procedure execute (cmd : string);
{
calls comspec to run 'command'
}
begin
if verbose then writeln (cmd);
if not test then
begin
swapVectors;
exec (getEnv ('COMSPEC'), '/C ' + cmd);
swapVectors;
if dosError <> 0 then quit ('couldn''t execute command ' + cmd, 20);
end;
if port[$60] = 46 {^C} then quit ('program terminated by user', 1);
end;
function parseCommand (command, fileName : string) : string;
{
parses command for special characters denoted with "$"
}
var
p : byte;
w : word;
r : string;
d : dirStr;
n : nameStr;
e : extStr;
commandLen : byte absolute command;
rLen : byte absolute r;
eLen : byte absolute e;
begin
{ expand file name }
fileName := fExpand (fileName);
fSplit (fileName, d, n, e);
e := copy (e, 2, eLen - 1);
p := 1;
while p <= commandLen do
begin
{ look for meta characters }
if (command[p] = '$') and (p <> commandLen) then
begin
r := #0;
case command[p + 1] of
'f' : r := fileName; { filename }
'd' : r := d; { directory }
'n' : r := n; { name }
'e' : r := e; { extension }
'$' : r := '$';
#0 : r := ';'; { $; gets converted to #0 by parseParams }
#1 : r := '$'; { $$ gets converted to #1 by parseParams }
'g' : r := '>';
'l' : r := '<';
'p' : r := '|';
'D' : r := dd;
'M' : r := mm;
'Y' : r := yyyy;
'y' : r := yy;
'r' : { random characters }
begin
rLen := padLength;
for w := 1 to padLength do
r[w] := char (random (26) + ord ('A'));
end;
'R' : { random numbers }
begin
rLen := padLength;
for w := 1 to padLength do
r[w] := char (random (10) + ord ('0'));
end;
'a' : { alpha counter : aa, ab..az, ba..bz .. }
begin
fillChar (r, sizeOf (r), 'a');
rLen := padLength;
inc (r[rLen], fileCount mod 26);
for w := 1 to padLength - 1 do
inc (r[rLen - w], (fileCount div power26[w]) mod 26);
end;
'#' : { numeric counter }
begin
str ((fileCount + 1), r);
while rLen < padLength do
r := '0' + r;
end;
else
inc (p);
end;
if r <> #0 then
begin
{ found replace character - insert it into string }
command := copy (command, 1, p - 1) + r + copy (command, p + 2, commandLen - p);
inc (p, rLen);
end;
end
else
inc (p);
end;
parseCommand := command;
end;
{--
mainline
--}
procedure askUser (var fileName : string; var process : boolean);
var
c : char;
begin
write (fileName, ' ? (Y/n/a/q) : ');
repeat
repeat
until keyPressed;
c := upCase (char (lo (readKey)));
until c in ['Y', 'N', 'A', 'Q', #13, #27];
case c of
'Y', #13 :
begin
writeln ('yes');
process := true;
end;
'N' :
begin
writeln ('no');
process := false;
end;
'A' :
begin
writeln ('all');
processAll := true;
end;
'Q', #27 :
begin
writeln ('quit');
quit ('user cancelled', 1);
end;
end;
end;
procedure processPath (path : string);
var
search : searchRec;
s,
fileName : string;
n,
p : byte;
attr : word;
t : text;
f : file;
moreFiles : boolean;
process : boolean;
sLen : byte absolute s;
commandLen : byte absolute command;
begin
if recursive then
{ process sub directories }
begin
findFirst (path + '*.*', directory, search);
while dosError = 0 do
begin
if (search.attr and directory <> 0) and (search.name <> '.') and (search.name <> '..') then
processPath (path + search.name + '\');
findNext (search);
end;
end;
fileName := path;
srcFirst (fileName, attr, moreFiles);
while moreFiles do
begin
if (fileName <> '') and (search.name <> '.') and (search.name <> '..') then
if (incDir and (attr and directory <> 0)) or (incFile and (attr and directory = 0)) then
begin
process := true;
{ interactive }
if interactive and (not processAll) then askUser (fileName, process);
if process or processAll then
begin
{ all this stuff executes each command seperated by ;'s }
n := 1;
while n <= commandLen do
begin
s := copy (command, n, 255);
p := pos (';', s);
if (p = 0) or ((p > 1) and (s[p - 1] = '$')) then
p := sLen
else
sLen := p - 1;
s := cleanStr (s);
execute (parseCommand (s, fileName));
inc (n, p);
end;
inc (fileCount);
end;
end;
{ get next file name }
fileName := path;
srcNext (fileName, attr, moreFiles);
end;
end;
var
s : string[10];
begin
initialise;
processPath (rootpath);
if fileCount = 0 then
quit ('no matching files', 3)
else if not quiet then
begin
str (fileCount, s);
quit (s + ' file(s) processed', 0);
end;
end.