home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SSWITCH.ZIP / SSWITCH.PAS < prev   
Pascal/Delphi Source File  |  1993-07-14  |  3KB  |  96 lines
  1. program textsearchandreplace;
  2. uses dos;
  3. const
  4.      ProgData = 'SSWITCH- Free DOS utility: text file search and replace.';
  5.      ProgDat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  6.  
  7.       usage = 'Usage:  SSWITCH source_file new_destination_file';
  8.       usag2 = '    You must use the DOS command SET as follows:';
  9.       usag3 = '        set switch_s=search_text';
  10.       usag4 = '        set switch_r=replace_text';
  11. var
  12.    ps1, ps2,
  13.    stext, rtext,
  14.    line_current           : string;
  15.    source_file,dest_file  : text;
  16.  
  17. procedure showusage;
  18. begin
  19.         writeln(usage);
  20.         writeln(usag2);
  21.         writeln(usag3);
  22.         writeln(usag4);
  23.         halt;
  24. end;
  25.  
  26. procedure initvars;
  27. begin
  28.      writeln(progdata);
  29.      writeln(progdat2);
  30.      writeln;
  31.      if paramcount < 2 then
  32.         showusage;
  33.      ps1 := paramstr(1);
  34.      ps2 := paramstr(2);
  35.      stext := getenv('switch_s');
  36.      if stext = '' then begin
  37.         writeln('!!! switch_s is not SET !!!');
  38.         showusage;
  39.      end;
  40.      rtext := getenv('switch_r');
  41.      if rtext = '' then begin
  42.         writeln('!!! switch_r is not SET !!!');
  43.         showusage;
  44.      end;
  45.      writeln('Old string: ',stext,' - New string: ',rtext,'.');
  46. end;
  47.  
  48. procedure openfiles;
  49. begin
  50.      assign(source_file,ps1);
  51. {$i-} reset(source_file); {$i+}                    { check if file exists.}
  52.      if (ioresult <> 0) then                       { if it                }
  53.      begin                                         {    doesn't, then     }
  54.          writeln('Unable to open "', PS1, '".');   {  quit with message.  }
  55.          showusage;
  56.      end;
  57.  
  58.      assign(dest_file,ps2);
  59. {$i-} reset(dest_file);  {$i+}
  60.       if (ioresult <> 0) then
  61.          rewrite(dest_file)
  62.       else begin
  63. writeln('Destination "',PS2,'" exists!  Rename, delete, or specify alternate.');
  64.          showusage;
  65.       end;
  66.       writeln('Old file: ',PS1,' - New file: ',PS2,'.');
  67. end;
  68.  
  69. function replstr(theline,thesearch,thereplace : string) : string;
  70. var
  71.    stridx, slength  : integer;
  72. begin
  73.      stridx  := 300;
  74.      slength := length(thesearch);
  75.      while (pos(thesearch,theline) <> 0) do begin
  76.            stridx := (pos(thesearch,theline));
  77.            delete (theline,stridx,slength);
  78.            insert (thereplace,theline,stridx);
  79.      end;
  80.      replstr := theline;
  81. end;
  82.  
  83. begin
  84.      initvars;
  85.      openfiles;
  86.      while not eof(source_file) do
  87.      begin
  88.           readln(source_file,line_current);
  89.           if (pos(stext,line_current) <> 0) then
  90.              line_current := replstr(line_current,stext,rtext);
  91.           writeln(dest_file,line_current);
  92.      end;
  93.      close(source_file);
  94.      close(dest_file);
  95. end.
  96.