[Back to FINDREPL SWAG index] [Back to Main SWAG index] [Original]

    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.

[Back to FINDREPL SWAG index] [Back to Main SWAG index] [Original]