// Mit dem folgenden Code kann man nachträglich in Dateien die Captions
// von Controls ersetzen. Die Länge des Suchbegriffes muss 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! In den Beispielen werden beispielsweise "Button1" oder
// auch "Label1" verwendet, das wird in der Realität nicht so vorkommen. Dort
// müssen dann eben die richtigen Begriffe eingesetzt werden.
// Der Code ist nicht für UTF-16 Textdateien geeignet.
// Wichtig! Auch andere gefundene Begriffe, die keine Captions sind, werden
// ebenfalls ersetzt. Das kann zur Zerstörung der Funktion führen.
// Beispielsweise sollte man nicht den Begriff "Start" ersetzen, den Begriff
// "&Start" aber schon.


// Getestet mit RS 10.4 unter W11

type 
  func = function(p: pansichar): boolean; 
 
function ersetze(such, ersatz, quelldatei, zieldatei: string; wieoft: integer; 
  ignoreCase: boolean; bedingung: func; out OK: boolean): word; 
var 
  ps, pm: pansichar; 
  ms, fs: TMemorystream; 
  lgs, lge, x, stelle, ende: integer; 
  s: string; 
  a: ansistring; 
begin 
  result := 0; 
  if ignoreCase then 
    such := lowercase(such); 
  a := ansistring(ersatz); 
  lgs := length(such); 
  lge := length(a); 
  if lgs = 0 then 
  begin 
    messagebox(0, Pchar('Sie müssen einen Suchbegriff eingeben! '), 'ACHTUNG', 
      MB_ICONINFORMATION); 
    exit; 
  end; 
  if (lgs <> lge) then 
  begin 
    messagebox(0, Pchar('Die Länge des Such- und des Ersatzbegriffes' + 
      ' ist unterschiedlich. '), 'FEHLER', MB_OK); 
    OK := false; 
    exit; 
  end; 
  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 
    begin 
      OK := false; 
      exit; 
    end; 
  Screen.Cursor := crHourglass; 
  ms := TMemorystream.create; 
  fs := TMemorystream.create; 
  try 
    ms.loadfromfile(quelldatei); 
    ende := ms.size - lgs; 
    ms.position := 0; 
    if (ende >= 0) and (wieoft <> 0) then 
    begin 
      pm := ms.memory; 
      stelle := 0; 
      x := 0; 
      repeat 
        if pm <> '' then 
        begin 
          s := string(pm); 
          setlength(s, lgs); 
          if ignoreCase then 
            s := lowercase(s); 
        end 
        else 
          s := ''; 
        if s = such then 
        begin 
          ps := pm + lge; 
          if (@bedingung = nil) or bedingung(ps) 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(a[1], lge); 
            inc(result); 
            if result = wieoft then 
              break 
            else 
            begin 
              inc(pm, pred(lgs)); 
            end; 
          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); 
    OK := true; 
  finally 
    fs.free; 
    ms.free; 
  end; 
  Screen.Cursor := crDefault; 
end; 
 
// --- Beispielaufrufe --- 
 
// ****************************************************** 
 
// Die Caption Button1, Button10 ... Button19 werden umbenannt in 
// ButtonA, ButtonA0 ... ButtonA9 
// Groß- und Kleinschreibung wird ignoriert 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: integer; 
  b: boolean; 
begin 
  i := ersetze('Button1', 'ButtonA', Application.exename, 'D:\Test.exe', -1, 
    true, nil, b); 
  if b then 
    showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ****************************************************** 
 
// Der Caption eines Buttons mit der Beschriftung &Start wird ersetzt 
procedure TForm1.Button7Click(Sender: TObject); 
var 
  i: integer; 
  b: boolean; 
begin 
  i := ersetze('&Start', ' &Los ', Application.exename, 'D:\Test.exe', -1, 
   false, nil, b); 
 end; 
 
// ****************************************************** 
 
// Nur das Caption Button1 wird in Taster1 umbenannt. 
// Button10 ... Button19 werden ignoriert, da bei ihnen das 
// Zeichen hinter Button1 in '0'..'9' liegt. 
function testen(p: pansichar): boolean; 
const 
  ausschluss = ['0' .. '9']; 
begin 
  result := not(p^ in ausschluss); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  i: integer; 
  b: boolean; 
begin 
  i := ersetze('Button1', 'Taster1', Application.exename, 'D:\Test.exe', -1, 
    true, @testen, b); 
  if b then 
    showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ****************************************************** 
 
// Die beiden zuerst gefundenen Captions werden umbenannt, 
// egal ob Button oder Label etc. 
// Abbrechen (ohne &) wird aber nicht ersetzt. 
procedure TForm1.Button3Click(Sender: TObject); 
var 
  i: integer; 
  b: boolean; 
begin 
  i := ersetze('&Abbrechen', ' C&ancel  ', Application.exename, 'D:\Test.exe', 
    2, true, nil, b); 
  if b then 
    showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end; 
 
// ****************************************************** 
 
// Die Captions Label1, Label15 und  Label17 werden umbenannt 
var 
  nur: array [0 .. 2] of ansistring = ( 
    '1', 
    '15', 
    '17' 
  ); 
 
const 
  nicht = ['0' .. '9']; 
 
function testen2(px: pansichar): boolean; 
var 
  lg, i: integer; 
  s: ansistring; 
  n: ansichar; 
begin 
  result := false; 
  for i := Low(nur) to High(nur) do 
  begin 
    lg := length(nur[i]); 
    s := px; 
    if s <> '' then 
      n := s[lg + 1] 
    else 
      n := '0'; 
    s := copy(px, 1, lg); 
    if (s = nur[i]) and not(charinset(n, nicht)) then 
    begin 
      result := true; 
      break; 
    end; 
  end; 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
var 
  i: integer; 
  b: boolean; 
begin 
  i := ersetze('Label', 'XXXXX', Application.exename, 'D:\Test.exe', -1, false, 
    @testen2, b); 
  if b then 
    showmessage('Der Begriff wurde ' + inttostr(i) + ' mal ersetzt.'); 
end;