// Mit dem folgenden Code kann man Strings in Dateien ersetzen. Falls es sich
// nicht um Textdateien handelt, sollte die Länge des Suchbegriffes mit der
// Länge des Ersatzbegriffes übereinstimmen. Mit der Variablen "
wieoft" wird
// gesteuert, wie viele Begriffe ersetzt werden. Ist sie kleiner als Null,
// werden alle Begriffe ersetzt. Die Variable "
ignoreCase" steuert, ob die Groß-
// und Kleinschreibung beachtet werden soll. Zusätzlich kann man in einer
// externen Funktion bestimmmte Bedingungen angeben. Aber denken Sie daran:
// Wenn Quelldatei gleich Zieldatei ist, haben Sie keine Sicherungskopie falls
// etwas schief geht!


// Getestet mit D4 unter XP

type 
  func = function(p: pchar; offs, i, grsse: integer): boolean; 
 
function ersetze(such, ersatz, quelldatei, zieldatei: string; 
  wieoft: integer; ignoreCase: boolean; bedingung: func): word; 
var 
  ps, pm: PChar; 
  ms, fs: TMemorystream; 
  lgs, lge, x, stelle, ende: integer; 
  flag: DWord; 
begin 
  result := 0; 
  lgs := length(such); 
  lge := length(ersatz); 
  if lgs = 0 then begin 
    messagebox(0, pchar('Sie müssen einen Suchbegriff eingeben!   '), 
      'ACHTUNG', MB_ICONINFORMATION); 
    exit; 
  end; 
  if (lgs <> lge) and (lowercase(extractfileext(quelldatei)) <> '.txt') then 
    if messagebox(0, pchar('Die Länge des Such- und des Ersatzbegriffes' + 
      ' ist unterschiedlich.   '#13'Wollen Sie wirklich weitermachen???' + 
      #13#10#13#10'(nicht empfohlen)'), 'ACHTUNG', 
      MB_OKCANCEL or MB_ICONQUESTION) <> mrok then exit; 
  if fileexists(zieldatei) then 
    if messagebox(0, pchar('Die Zieldatei existiert bereits.'#13 + 
      'Soll sie überschrieben werden?   '), 'ACHTUNG', 
      MB_OKCANCEL or MB_ICONQUESTION) <> mrok then exit; 
  ms := TMemorystream.create; 
  fs := TMemorystream.create; 
  try 
    flag := ord(ignorecase) * NORM_IGNORECASE; 
    ms.loadfromfile(quelldatei); 
    ende := ms.size - lgs; 
    ms.position := 0; 
    if (ende >= 0) and (wieoft <> 0) 
      then begin 
      ps := pchar(such); 
      pm := ms.memory; 
      stelle := 0; 
      x := 0; 
      repeat 
        if CompareString(LOCALE_USER_DEFAULT, flag, pm, lgs, ps, lgs) = 2 then 
        begin 
          if (@bedingung = nil) or (bedingung(pm, lgs, x, ms.size)) then begin 
            if stelle < x then 
              fs.copyfrom(ms, x - stelle); 
            ms.position := x + lgs; 
            stelle := ms.position; 
            inc(x, pred(lgs)); 
            if lge > 0 then 
              fs.writebuffer(ersatz[1], lge); 
            inc(result); 
            if result = wieoft then break 
            else inc(pm, pred(lgs)); 
          end; 
        end; 
        inc(pm); 
        inc(x); 
      until x > ende; 
    end; 
    if ms.position < ms.size then 
      fs.copyfrom(ms, ms.size - ms.position); 
    fs.savetofile(zieldatei); 
  finally 
    fs.free; 
    ms.free; 
  end; 
end;
// ****************************************************** 
 
// Beispielaufrufe 
 
// ****************************************************** 
 
// Button1, Button10 ... Button19 werden umbenannt in 
// ButtonX, ButtonX0 ... ButtonX9 
// Sollten die Captions der Button genauso heißen, 
// werden diese natürlich auch mit umbenannt. 
// Groß- und Kleinschreibung wird ignoriert. 
 
procedure TForm1.Button7Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := ersetze('Button1', 'ButtonX', Application.Exename, 
    'C:\Test.exe', -1, true, nil); 
  showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ****************************************************** 
 
// Button1 wird in ButtonA umbenannt. 
// Button10 ... Button19 werden ignoriert, da bei ihnen das 
// Zeichen hinter Button1 in '0'..'9' liegt. 
 
function testen_0_9(p: pchar; o, i, g: integer): boolean; 
const ausschluss = ['0'..'9']; 
begin 
  result := not ((p + o)^ in ausschluss); 
end; 
 
procedure TForm1.Button8Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := ersetze('Button1', 'ButtonA', Application.Exename, 
    'C:\Test.exe', -1, true, @testen_0_9); 
  showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ******************************************************
 
// bestimmte Captions werden umbenannt, egal ob Button oder Label etc. 
// Abbrechen (ohne &) wird aber nicht ersetzt. 
 
procedure TForm1.Button9Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := ersetze('&Abbrechen', ' C&ancel  ', Application.Exename, 
    'C:\Test.exe', -1, true, nil); 
  showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ****************************************************** 
 
// Es wird 2 mal die Beschriftung Button10 oder Panel10 
// in ButtonXY und PanelXY geändert
// (wobei auf Groß- und Kleinschreibung geachtet wird) 
 
const 
  pb = '&Button'; 
  pp = '&Panel'; 
  lb = 7; // length('&Button') 
  lp = 6; // length('&Panel') 
 
function testen_B_P(p: pchar; o, i, g: integer): boolean; 
var 
  bb, bp: boolean; 
begin 
  if i >= lp // also nicht vor dem Datei-Anfang 
    then bp := comparemem(p - lp, pchar(pp), lp) // Groß- und Kleinschreibung! 
  else bp := false; 
  if i >= lb 
    then bb := comparemem(p - lb, pchar(pb), lb) // Groß- und Kleinschreibung! 
  else bb := false; 
  result := bb or bp; 
end; 
 
procedure TForm1.Button10Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := ersetze('10', 'XY', Application.Exename, 
    'C:\Test.exe', 2, false, // Groß- und Kleinschreibung! 
    @testen_B_P); 
  showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ******************************************************
 
// In einer Textdatei werden alle Wörter, die mit maus beginnen, 
// durch das großgeschriebenen Wort Maus ersetzt. 
// Wörter wie Feldmaus werden nicht beachtet, aber maus wird zu Maus 
// und mausefalle wird zu Mausefalle. 
 
function testen(p: pchar; o, i, g: integer): boolean; 
const delimiters = 
  [#0..#47, #58..#64, #91..#96, #123..#191, #215, #216, #247, #248];
begin 
  result := ((i = 0) // Dateianfang 
    or ((p - 1)^ in delimiters)); 
end; 
 
procedure TForm1.Button11Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := ersetze('maus', 'Maus', 'c:\test.txt', 
    'c:\test_2.txt', -1, false, @testen); 
  showmessage('Der Begriff wurde ' + inttostr(i) + ' mal bearbeitet.'); 
end;

// ******************************************************
 
// Ersetzen von Wörtern mit Bestätigung. Auf Form1.Canvas wird
// immer ein kleiner Datei-Ausschnitt angezeigt und man muss
// einen von drei Button anklicken.

const 
  links = 10; 
  oben = 50; 
 
var 
  ja, nein, abbruch: boolean; 
  zaehler: DWord; 
 
function testen(p: pchar; o, i, g: integer): boolean; 
var 
  w, x, y, z: integer; 
  s1, s2, s3: string; 
  s: TSize; 
  function dbz(txt: string): string; 
  var k: integer; 
  begin 
    result := txt; 
    for k := 1 to length(result) do 
      if result[k] in [#0..#31, #127..#255] then result[k] := #183; 
  end; 
begin 
  if abbruch then begin 
    result := false; 
    exit; 
  end; 
  inc(zaehler); 
  s1 := ''; 
  if i > 0 then begin 
    w := i - 10; 
    if w < 0 then w := 0; 
    dec(p, i - w); 
    if w > 0 then s1 := '...'; 
    for x := w to pred(i) do begin 
      s1 := s1 + p^; 
      inc(p); 
    end; 
  end; 
  s1 := dbz(s1); 
  s2 := ''; 
  for x := i to pred(i + o) do begin 
    s2 := s2 + p^; 
    inc(p); 
  end; 
  s2 := dbz(s2); 
  s3 := ''; 
  w := i + o + 10; 
  if w > g then w := g; 
  for x := i + o to pred(w) do begin 
    s3 := s3 + p^; 
    inc(p); 
  end; 
  if w < g then s3 := s3 + '...'; 
  s3 := dbz(s3); 
  with Form1 do begin 
    Button1.enabled := true; 
    Button2.enabled := true; 
    Button3.enabled := true; 
    with Canvas do begin 
      Font.color := clNavy; 
      Font.Style := []; 
      textout(links, oben, s1); 
      s := textextent(s1); 
      y := s.cx; 
      Font.color := clRed; 
      Font.Style := [fsBold]; 
      textout(penpos.x, oben, s2); 
      s := textextent(s2); 
      inc(y, s.cx); 
      z := s.cy; 
      Font.color := clNavy; 
      Font.Style := []; 
      textout(penpos.x, oben, s3); 
      s := textextent(s3); 
      Label1.caption := 'Fundstelle ' + inttostr(zaehler); 
      repeat 
        Application.processmessages; 
      until ja or nein or abbruch or Application.terminated; 
      Button1.enabled := false; 
      Button2.enabled := false; 
      Button3.enabled := false; 
      brush.color := color; 
      fillrect(rect(links, oben, links + y + s.cx, oben + z)); 
    end; 
  end; 
  result := ja; 
  ja := false; 
  nein := false; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
// --- kann im Objektinspektor eingestellt werden --- 
  Button1.enabled := false; 
  Button2.enabled := false; 
  Button3.enabled := false; 
  Button1.width := 85; 
  Button2.width := 85; 
  Button3.width := 85; 
  Button1.left := links; 
  Button2.left := links + 90; 
  Button3.left := Button2.left + 90; 
  Button1.top := oben + 30; 
  Button2.top := Button1.top; 
  Button3.top := Button1.top; 
  Button1.caption := '&Ersetzen'; 
  Button2.caption := '&Nicht ersetzen'; 
  Button3.caption := '&Abbrechen'; 
  Label1.left := links; 
  Label1.top := oben - 30; 
  Label1.caption := ''; 
// -------------------------------------------------- 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ja := true; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  nein := true; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  abbruch := true; 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  Canvas.brush.style := bsclear; 
  ja := false; 
  nein := false; 
  abbruch := false; 
  zaehler := 0; 
  ersetze('Muttertag', 'Vatertag', 'c:\Rede.txt', 
    'c:\Fasching.txt', -1, true, @testen); 
  Label1.caption := ''; 
  showmessage('Fertig'); 
end;

// ******************************************************



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke