home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / findrepl.swg / 0005_CHGE.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  13KB  |  345 lines
  1. Program Chge;
  2.  
  3. { Copyright 1990 Trevor J Carlsen Version 1.06  24-07-90                    }
  4. { This Program may be used and distributed as if it was in the Public Domain}
  5. { With the following exceptions:                                            }
  6. {    1.  If you alter it in any way, the copyright notice must not be       }
  7. {        changed.                                                           }
  8. {    2.  If you use code excerpts in your own Programs, due credit must be  }
  9. {        given, along With a copyright notice -                             }
  10. {        "Parts Copyright 1990 Trevor J Carlsen"                            }
  11. {    3.  No Charge may be made For any Program using code from this Program.}
  12.  
  13. { Changes (or deletes) a String in any File. If an .EXE or .COM File then  }
  14. { the change must be of a similar length inorder to retain the executable  }
  15. { integrity.                                                               }
  16.  
  17. { If you find this Program useful here is the author's contact address -   }
  18.  
  19. {      Trevor J Carlsen                                                    }
  20. {      PO Box 568                                                          }
  21. {      Port Hedland Western Australia 6721                                 }
  22. {      Voice 61 [0]91 72 2026                                              }
  23. {      Data  61 [0]91 72 2569                                              }
  24.  
  25. Uses
  26.   BmSrch,
  27.   Dos;
  28.  
  29. Const
  30.   space       = #32;
  31.   quote       = #34;
  32.   comma       = #44;
  33.   copyright1  = 'CHGE - version 1.06 Copyright 1989,1990 Trevor Carlsen';
  34.   copyright2  = 'All rights reserved.';
  35.  
  36. Var
  37.   dirinfo     : SearchRec; { Dos }
  38.   f           : File;
  39.   FDir        : DirStr;    { Dos }
  40.   mask,
  41.   fname,
  42.   oldstr,
  43.   newstr      : String;
  44.   oldlen      : Byte Absolute oldstr;
  45.   newlen      : Byte Absolute newstr;
  46.   changes     : Word;
  47.   time        : LongInt Absolute $0000:$046C;
  48.   start       : LongInt;
  49.  
  50. Function ElapsedTime(start : LongInt): Real;
  51.   begin
  52.     ElapsedTime := (time - start) / 18.2;
  53.   end; { ElapsedTime }
  54.  
  55. Procedure ReportError(e : Byte);
  56. begin
  57.   Writeln('CHGE [path]Filename searchstr replacementstr|NUL');
  58.   Writeln(' eg:  CHGE c:\autoexec.bat "color" "colour"');
  59.   Writeln('      CHGE c:\autoexec.bat 12 13,10,13,10,13,10,13,10');
  60.   Writeln('      CHGE c:\wp\test.txt "Trevor" NUL');
  61.   Writeln;
  62.   Writeln('The first example will change every occurrence of the Word "color" to "colour"');
  63.   Writeln('The second will replace every formfeed Character (ascii 12) With 4 sets of');
  64.   Writeln('carriage return/linefeed combinations and the third will delete every');
  65.   Writeln('occurrence of "Trevor"');
  66.   Writeln('The prime requirements are:');
  67.   Writeln('  There MUST always be exactly three space delimiters on the command line -');
  68.   Writeln('  one between the Program name and the Filename, one between the Filename and');
  69.   Writeln('  the search String and another between the search String and the replacement');
  70.   Writeln('  String. Any other spaces may ONLY occur between quote Characters.');
  71.   Writeln('  The Program will not permit you to change the length of an .EXE or .COM File,');
  72.   Writeln('  therefore the replacement String MUST be the same length as the String');
  73.   Writeln('  that it is replacing in these cases.');
  74.   Writeln;
  75.   Writeln('  If using ascii codes, each ascii Character must be separated from another');
  76.   Writeln('  by a comma. The same rule applies to spaces as above - three required - no');
  77.   Writeln('  more - no less. If just deleting the NUL must not be in quotes.');
  78.   halt(e);
  79. end; { ReportError }
  80.  
  81. Function StUpCase(Str : String) : String;
  82. Var
  83.   Count : Integer;
  84. begin
  85.   For Count := 1 to Length(Str) do
  86.     Str[Count] := UpCase(Str[Count]);
  87.   StUpCase := Str;
  88. end;
  89.  
  90. Procedure ParseCommandLine;
  91. Var
  92.   parstr,                                      { contains the command line }
  93.   temp      : String;
  94.   len       : Byte Absolute parstr;           { the length Byte For parstr }
  95.   tlen      : Byte Absolute temp;               { the length Byte For temp }
  96.   CommaPos,
  97.   QuotePos,
  98.   SpacePos,
  99.   chval     : Byte;
  100.   error     : Integer;
  101.   DName     : NameStr;
  102.   DExt      : ExtStr;
  103.  
  104.   Function right(Var s; n : Byte): String;{ Returns the n right portion of s }
  105.   Var
  106.     st : String Absolute s;
  107.     len: Byte Absolute s;
  108.   begin
  109.     if n >= len then
  110.       right := st
  111.     else
  112.       right := copy(st,succ(len)-n,n);
  113.   end; { right }
  114.  
  115. begin
  116.   parstr        := String(ptr(PrefixSeg,$80)^);     { Get the command line }
  117.   if parstr[1]   = space then
  118.     delete(parstr,1,1);               { First Character is usually a space }
  119.   SpacePos      := pos(space,parstr);
  120.   if SpacePos    = 0 then                                      { No spaces }
  121.     ReportError(1);
  122.   mask          := StUpCase(copy(parstr,1,pred(SpacePos)));
  123.   FSplit(mask,Fdir,DName,DExt);       { To enable the directory to be kept }
  124.   delete(parstr,1,SpacePos);
  125.   QuotePos      := pos(quote,parstr);
  126.   if QuotePos   <> 0 then begin          { quotes - so must be quoted Text }
  127.     if parstr[1] <> quote then               { so first Char must be quote }
  128.       ReportError(2);
  129.     delete(parstr,1,1);                       { get rid of the first quote }
  130.     QuotePos    := pos(quote,parstr);            { and find the next quote }
  131.  
  132.     if QuotePos  = 0 then                    { no more - so it is an error }
  133.       ReportError(3);
  134.     oldstr    := copy(parstr,1,pred(QuotePos));{ search String now defined }
  135.     if parstr[QuotePos+1] <> space then            { must be space between }
  136.       ReportError(1);
  137.     delete(parstr,1,succ(QuotePos));             { the quotes - else error }
  138.     if parstr[1] <> quote then begin                     { may be a delete }
  139.       tlen      := 3;
  140.       move(parstr[1],temp[1],3);
  141.       if temp <> 'NUL' then                              { is not a delete }
  142.         ReportError(4)                  { must be quote after space or NUL }
  143.       else
  144.         newlen  := 0;               { is a delete - so nul the replacement }
  145.     end
  146.     else begin
  147.       delete(parstr,1,1);                           { get rid of the quote }
  148.       QuotePos   := pos(quote,parstr); { find next quote For end of String }
  149.       if QuotePos = 0 then                            { None? - then error }
  150.         ReportError(5);
  151.       newstr := copy(parstr,1,pred(QuotePos));{ Replacement String defined }
  152.     end;
  153.   end
  154.   else begin                                   { must be using ascii codes }
  155.     oldlen       := 0;
  156.     SpacePos     := pos(space,parstr);     { Find end of search Characters }
  157.     if SpacePos   = 0 then                           { No space - so error }
  158.       ReportError(6);
  159.     temp         := copy(parstr,1,SpacePos-1);
  160.     delete(parstr,1,SpacePos);          { get rid of the search Characters }
  161.     CommaPos     := pos(comma,temp);                    { find first comma }
  162.     if CommaPos   = 0 then             { No comma - so only one ascii code }
  163.       CommaPos   := succ(tlen);
  164.     Repeat                                      { create the search String }
  165.       val(copy(temp,1,CommaPos-1),chval,error); { convert to a numeral and }
  166.       if error <> 0 then                   { if there is an error bomb out }
  167.         ReportError(7);
  168.       inc(oldlen);
  169.       oldstr[oldlen] := Char(chval);{ add latest Char to the search String }
  170.       delete(temp,1,CommaPos);
  171.       CommaPos   := pos(comma,temp);
  172.       if CommaPos = 0 then
  173.         CommaPos := succ(tlen);
  174.     Until tlen = 0;
  175.     newlen       := 0;
  176.     CommaPos     := pos(comma,parstr);
  177.     if CommaPos   = 0 then
  178.       CommaPos   := succ(len);
  179.     Repeat                                 { create the replacement String }
  180.       val(copy(parstr,1,pred(CommaPos)),chval,error);
  181.       if error <> 0 then                              { must be ascii code }
  182.         ReportError(8);
  183.       inc(newlen);
  184.       newstr[newlen] := Char(chval);
  185.       delete(parstr,1,CommaPos);
  186.       CommaPos   := pos(comma,parstr);
  187.       if CommaPos = 0 then CommaPos := len+1;
  188.     Until len = 0;
  189.   end; { else }
  190.   if ((right(mask,3) = 'COM') or (right(mask,3) = 'EXE')) and
  191.     (newlen <> oldlen) then
  192.     ReportError(16);
  193. end; { ParseCommandLine }
  194.  
  195. Function OpenFile(fn : String): Boolean;
  196.   begin
  197.     assign(f,fn);
  198.     {$I-} reset(f,1); {$I+}
  199.     OpenFile := IOResult = 0;
  200.   end; { OpenFile }
  201.  
  202. Procedure CloseFile;
  203.   begin
  204.     {$I-}
  205.     truncate(f);
  206.     Close(f);
  207.     if IOResult <> 0 then;                          { dummy call to IOResult }
  208.     {$I+}
  209.   end; { CloseFile }
  210.  
  211. Procedure ChangeFile(Var chge : Word);
  212.   Const
  213.     bufflen     = 65000;                    { This is the limit For BMSearch }
  214.     searchlen   = bufflen - 1000;      { Allow space For extra Characters in }
  215.   Type                                              { the replacement String }
  216.     buffer      = Array[0..pred(bufflen)] of Byte;
  217.     buffptr     = ^buffer;
  218.   Var
  219.     table       : BTable;                         { Boyer-Moore search table }
  220.     old,                                             { Pointer to old buffer }
  221.     nu          : buffptr;                           { Pointer to new buffer }
  222.     count,
  223.     result,
  224.     oldpos,
  225.     newpos      : Word;
  226.     oldfpos,
  227.     newfpos     : LongInt;
  228.     finished    : Boolean;
  229.  
  230.   Procedure AllocateMemory(Var p; size : Word);
  231.     Var
  232.       buff : Pointer Absolute p;
  233.     begin
  234.       if MaxAvail >= size then
  235.         GetMem(buff,size)
  236.       else begin
  237.         Writeln('Insufficient memory available.');
  238.         halt(10);
  239.       end;
  240.     end; { AllocateMemory }
  241.  
  242.   begin
  243.     oldfpos := 0; newfpos := 0;
  244.     chge := 0;
  245.     AllocateMemory(old,searchlen);
  246.     AllocateMemory(nu,bufflen);      { make room on the heap For the buffers }
  247.     BMMakeTable(oldstr,table);           { Create a Boyer-Moore search table }
  248.     {$I-}
  249.     BlockRead(f,old^,searchlen,result);                    { Fill old buffer }
  250.     oldfpos := FilePos(f);
  251.     {$I+}
  252.     if IOResult <> 0 then begin
  253.       CloseFile; ReportError(11);
  254.     end;
  255.     Repeat
  256.       oldpos := 0; newpos := 0; count := 0;
  257.       finished := (result < searchlen); { if buffer<>full then no more reads }
  258.       Repeat                              { Do a BM search For search String }
  259.         count := BMSearch(old^[oldpos],result-oldpos,table,oldstr);
  260.         if count = $FFFF then begin   { search String not found so copy rest }
  261.           move(old^[oldpos],nu^[newpos],result-oldpos);   { of buffer to new }
  262.           inc(newpos,result-oldpos);  { buffer and update the buffer markers }
  263.           inc(oldpos,result-oldpos);
  264.         end
  265.         else begin                                     { search String found }
  266.           if count <> 0 then begin       { not at position one in the buffer }
  267.             move(old^[oldpos],nu^[newpos],count);{ transfer everything prior }
  268.             inc(oldpos,count);          { to the search String to new buffer }
  269.             inc(newpos,count);               { and update the buffer markers }
  270.           end;
  271.           move(newstr[1],nu^[newpos],newlen);  { copy the replacement String }
  272.           inc(oldpos,oldlen);        { to the new buffer and update the buffer }
  273.           inc(newpos,newlen);                                      { markers }
  274.           inc(chge);
  275.         end;
  276.       Until oldpos >= result;               { keep going Until end of buffer }
  277.       if not finished then begin       { Fill 'er up again For another round }
  278.         {$I-}
  279.         seek(f,oldfpos);
  280.         BlockRead(f,old^,searchlen,result);
  281.         oldfpos := FilePos(f);
  282.         {$I+}
  283.         if IOResult <> 0 then begin
  284.           CloseFile; ReportError(13);
  285.         end; { if IOResult }
  286.       end; { if not finished }
  287.       {$I-}
  288.       seek(f,newfpos);
  289.       BlockWrite(f,nu^,newpos);                   { Write new buffer to File }
  290.       newfpos := FilePos(f);
  291.       {$I+}
  292.       if IOResult <> 0 then begin
  293.         CloseFile; ReportError(12);
  294.       end;
  295.     Until finished;
  296.     FreeMem(old, searchlen); FreeMem(nu,bufflen);
  297.   end;  { ChangeFiles }
  298.  
  299. Procedure Find_and_change_all_Files;
  300.   Var
  301.     Filefound : Boolean;
  302.  
  303.   Function padstr(ch : Char; len : Byte): String;
  304.   
  305.     Var
  306.       temp : String;
  307.     
  308.     begin
  309.       FillChar(temp[1],len,ch);
  310.       temp[0] := chr(len);
  311.       padstr  := temp;
  312.     end; { padstr }
  313.  
  314.   begin
  315.     Filefound := False;
  316.     FindFirst(mask,AnyFile,dirinfo);
  317.     While DosError = 0 do begin
  318.       Filefound := True;
  319.       start := time;
  320.       fname := FDir + dirinfo.name;
  321.       if OpenFile(fname) then begin
  322.         Write(fname,PadStr(space,30-length(fname)),FileSize(f):7,'  ');
  323.         ChangeFile(changes);
  324.         CloseFile;
  325.         if changes = 0 then
  326.           Writeln
  327.         else
  328.           Writeln('Made ',changes,' changes in ',ElapsedTime(start):4:2,' seconds.')
  329.       end
  330.       else
  331.         Writeln('Unable to process ',fname);
  332.       FindNext(dirinfo);
  333.     end; { While DosError = 0 }
  334.     if not Filefound then
  335.       Writeln('No Files found.');
  336.   end; { Find_and_change_all_Files }
  337.  
  338. begin { main }
  339.   Writeln(copyright1);
  340.   Writeln(copyright2);
  341.   ParseCommandLine;
  342.   Find_and_change_all_Files;
  343. end.
  344.  
  345.