Contributor: SWAG SUPPORT TEAM
Program Chge;
{ Copyright 1990 Trevor J Carlsen Version 1.06 24-07-90 }
{ This Program may be used and distributed as if it was in the Public Domain}
{ With the following exceptions: }
{ 1. If you alter it in any way, the copyright notice must not be }
{ changed. }
{ 2. If you use code excerpts in your own Programs, due credit must be }
{ given, along With a copyright notice - }
{ "Parts Copyright 1990 Trevor J Carlsen" }
{ 3. No Charge may be made For any Program using code from this Program.}
{ Changes (or deletes) a String in any File. If an .EXE or .COM File then }
{ the change must be of a similar length inorder to retain the executable }
{ integrity. }
{ If you find this Program useful here is the author's contact address - }
{ Trevor J Carlsen }
{ PO Box 568 }
{ Port Hedland Western Australia 6721 }
{ Voice 61 [0]91 72 2026 }
{ Data 61 [0]91 72 2569 }
Uses
BmSrch,
Dos;
Const
space = #32;
quote = #34;
comma = #44;
copyright1 = 'CHGE - version 1.06 Copyright 1989,1990 Trevor Carlsen';
copyright2 = 'All rights reserved.';
Var
dirinfo : SearchRec; { Dos }
f : File;
FDir : DirStr; { Dos }
mask,
fname,
oldstr,
newstr : String;
oldlen : Byte Absolute oldstr;
newlen : Byte Absolute newstr;
changes : Word;
time : LongInt Absolute $0000:$046C;
start : LongInt;
Function ElapsedTime(start : LongInt): Real;
begin
ElapsedTime := (time - start) / 18.2;
end; { ElapsedTime }
Procedure ReportError(e : Byte);
begin
Writeln('CHGE [path]Filename searchstr replacementstr|NUL');
Writeln(' eg: CHGE c:\autoexec.bat "color" "colour"');
Writeln(' CHGE c:\autoexec.bat 12 13,10,13,10,13,10,13,10');
Writeln(' CHGE c:\wp\test.txt "Trevor" NUL');
Writeln;
Writeln('The first example will change every occurrence of the Word "color" to "colour"');
Writeln('The second will replace every formfeed Character (ascii 12) With 4 sets of');
Writeln('carriage return/linefeed combinations and the third will delete every');
Writeln('occurrence of "Trevor"');
Writeln('The prime requirements are:');
Writeln(' There MUST always be exactly three space delimiters on the command line -');
Writeln(' one between the Program name and the Filename, one between the Filename and');
Writeln(' the search String and another between the search String and the replacement');
Writeln(' String. Any other spaces may ONLY occur between quote Characters.');
Writeln(' The Program will not permit you to change the length of an .EXE or .COM File,');
Writeln(' therefore the replacement String MUST be the same length as the String');
Writeln(' that it is replacing in these cases.');
Writeln;
Writeln(' If using ascii codes, each ascii Character must be separated from another');
Writeln(' by a comma. The same rule applies to spaces as above - three required - no');
Writeln(' more - no less. If just deleting the NUL must not be in quotes.');
halt(e);
end; { ReportError }
Function StUpCase(Str : String) : String;
Var
Count : Integer;
begin
For Count := 1 to Length(Str) do
Str[Count] := UpCase(Str[Count]);
StUpCase := Str;
end;
Procedure ParseCommandLine;
Var
parstr, { contains the command line }
temp : String;
len : Byte Absolute parstr; { the length Byte For parstr }
tlen : Byte Absolute temp; { the length Byte For temp }
CommaPos,
QuotePos,
SpacePos,
chval : Byte;
error : Integer;
DName : NameStr;
DExt : ExtStr;
Function right(Var s; n : Byte): String;{ Returns the n right portion of s }
Var
st : String Absolute s;
len: Byte Absolute s;
begin
if n >= len then
right := st
else
right := copy(st,succ(len)-n,n);
end; { right }
begin
parstr := String(ptr(PrefixSeg,$80)^); { Get the command line }
if parstr[1] = space then
delete(parstr,1,1); { First Character is usually a space }
SpacePos := pos(space,parstr);
if SpacePos = 0 then { No spaces }
ReportError(1);
mask := StUpCase(copy(parstr,1,pred(SpacePos)));
FSplit(mask,Fdir,DName,DExt); { To enable the directory to be kept }
delete(parstr,1,SpacePos);
QuotePos := pos(quote,parstr);
if QuotePos <> 0 then begin { quotes - so must be quoted Text }
if parstr[1] <> quote then { so first Char must be quote }
ReportError(2);
delete(parstr,1,1); { get rid of the first quote }
QuotePos := pos(quote,parstr); { and find the next quote }
if QuotePos = 0 then { no more - so it is an error }
ReportError(3);
oldstr := copy(parstr,1,pred(QuotePos));{ search String now defined }
if parstr[QuotePos+1] <> space then { must be space between }
ReportError(1);
delete(parstr,1,succ(QuotePos)); { the quotes - else error }
if parstr[1] <> quote then begin { may be a delete }
tlen := 3;
move(parstr[1],temp[1],3);
if temp <> 'NUL' then { is not a delete }
ReportError(4) { must be quote after space or NUL }
else
newlen := 0; { is a delete - so nul the replacement }
end
else begin
delete(parstr,1,1); { get rid of the quote }
QuotePos := pos(quote,parstr); { find next quote For end of String }
if QuotePos = 0 then { None? - then error }
ReportError(5);
newstr := copy(parstr,1,pred(QuotePos));{ Replacement String defined }
end;
end
else begin { must be using ascii codes }
oldlen := 0;
SpacePos := pos(space,parstr); { Find end of search Characters }
if SpacePos = 0 then { No space - so error }
ReportError(6);
temp := copy(parstr,1,SpacePos-1);
delete(parstr,1,SpacePos); { get rid of the search Characters }
CommaPos := pos(comma,temp); { find first comma }
if CommaPos = 0 then { No comma - so only one ascii code }
CommaPos := succ(tlen);
Repeat { create the search String }
val(copy(temp,1,CommaPos-1),chval,error); { convert to a numeral and }
if error <> 0 then { if there is an error bomb out }
ReportError(7);
inc(oldlen);
oldstr[oldlen] := Char(chval);{ add latest Char to the search String }
delete(temp,1,CommaPos);
CommaPos := pos(comma,temp);
if CommaPos = 0 then
CommaPos := succ(tlen);
Until tlen = 0;
newlen := 0;
CommaPos := pos(comma,parstr);
if CommaPos = 0 then
CommaPos := succ(len);
Repeat { create the replacement String }
val(copy(parstr,1,pred(CommaPos)),chval,error);
if error <> 0 then { must be ascii code }
ReportError(8);
inc(newlen);
newstr[newlen] := Char(chval);
delete(parstr,1,CommaPos);
CommaPos := pos(comma,parstr);
if CommaPos = 0 then CommaPos := len+1;
Until len = 0;
end; { else }
if ((right(mask,3) = 'COM') or (right(mask,3) = 'EXE')) and
(newlen <> oldlen) then
ReportError(16);
end; { ParseCommandLine }
Function OpenFile(fn : String): Boolean;
begin
assign(f,fn);
{$I-} reset(f,1); {$I+}
OpenFile := IOResult = 0;
end; { OpenFile }
Procedure CloseFile;
begin
{$I-}
truncate(f);
Close(f);
if IOResult <> 0 then; { dummy call to IOResult }
{$I+}
end; { CloseFile }
Procedure ChangeFile(Var chge : Word);
Const
bufflen = 65000; { This is the limit For BMSearch }
searchlen = bufflen - 1000; { Allow space For extra Characters in }
Type { the replacement String }
buffer = Array[0..pred(bufflen)] of Byte;
buffptr = ^buffer;
Var
table : BTable; { Boyer-Moore search table }
old, { Pointer to old buffer }
nu : buffptr; { Pointer to new buffer }
count,
result,
oldpos,
newpos : Word;
oldfpos,
newfpos : LongInt;
finished : Boolean;
Procedure AllocateMemory(Var p; size : Word);
Var
buff : Pointer Absolute p;
begin
if MaxAvail >= size then
GetMem(buff,size)
else begin
Writeln('Insufficient memory available.');
halt(10);
end;
end; { AllocateMemory }
begin
oldfpos := 0; newfpos := 0;
chge := 0;
AllocateMemory(old,searchlen);
AllocateMemory(nu,bufflen); { make room on the heap For the buffers }
BMMakeTable(oldstr,table); { Create a Boyer-Moore search table }
{$I-}
BlockRead(f,old^,searchlen,result); { Fill old buffer }
oldfpos := FilePos(f);
{$I+}
if IOResult <> 0 then begin
CloseFile; ReportError(11);
end;
Repeat
oldpos := 0; newpos := 0; count := 0;
finished := (result < searchlen); { if buffer<>full then no more reads }
Repeat { Do a BM search For search String }
count := BMSearch(old^[oldpos],result-oldpos,table,oldstr);
if count = $FFFF then begin { search String not found so copy rest }
move(old^[oldpos],nu^[newpos],result-oldpos); { of buffer to new }
inc(newpos,result-oldpos); { buffer and update the buffer markers }
inc(oldpos,result-oldpos);
end
else begin { search String found }
if count <> 0 then begin { not at position one in the buffer }
move(old^[oldpos],nu^[newpos],count);{ transfer everything prior }
inc(oldpos,count); { to the search String to new buffer }
inc(newpos,count); { and update the buffer markers }
end;
move(newstr[1],nu^[newpos],newlen); { copy the replacement String }
inc(oldpos,oldlen); { to the new buffer and update the buffer }
inc(newpos,newlen); { markers }
inc(chge);
end;
Until oldpos >= result; { keep going Until end of buffer }
if not finished then begin { Fill 'er up again For another round }
{$I-}
seek(f,oldfpos);
BlockRead(f,old^,searchlen,result);
oldfpos := FilePos(f);
{$I+}
if IOResult <> 0 then begin
CloseFile; ReportError(13);
end; { if IOResult }
end; { if not finished }
{$I-}
seek(f,newfpos);
BlockWrite(f,nu^,newpos); { Write new buffer to File }
newfpos := FilePos(f);
{$I+}
if IOResult <> 0 then begin
CloseFile; ReportError(12);
end;
Until finished;
FreeMem(old, searchlen); FreeMem(nu,bufflen);
end; { ChangeFiles }
Procedure Find_and_change_all_Files;
Var
Filefound : Boolean;
Function padstr(ch : Char; len : Byte): String;
Var
temp : String;
begin
FillChar(temp[1],len,ch);
temp[0] := chr(len);
padstr := temp;
end; { padstr }
begin
Filefound := False;
FindFirst(mask,AnyFile,dirinfo);
While DosError = 0 do begin
Filefound := True;
start := time;
fname := FDir + dirinfo.name;
if OpenFile(fname) then begin
Write(fname,PadStr(space,30-length(fname)),FileSize(f):7,' ');
ChangeFile(changes);
CloseFile;
if changes = 0 then
Writeln
else
Writeln('Made ',changes,' changes in ',ElapsedTime(start):4:2,' seconds.')
end
else
Writeln('Unable to process ',fname);
FindNext(dirinfo);
end; { While DosError = 0 }
if not Filefound then
Writeln('No Files found.');
end; { Find_and_change_all_Files }
begin { main }
Writeln(copyright1);
Writeln(copyright2);
ParseCommandLine;
Find_and_change_all_Files;
end.