foreach source

Unfortunately I no longer have the time or resources to provide any support or updates to foreach source.
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.