// Eine Datei wird nach einem bestimmten Zeichen durchsucht
// und dessen Positionen in einem dynamischen Array gespeichert.
// Siehe dazu auch eine Textdatei nach einer Zeichenfolge durchsuchen

// Getestet mit D4 unter Win98

Variante 1

var 
  Form1: TForm1; 
  a: array of longint; 
  lng: longint; 
  datei: string; 
  zusuchen: char; 
 
implementation 
 
{$R *.DFM} 
 
procedure finden; 
var 
  x: longint; 
  f: file of char; 
  c: char; 
begin 
  lng := 0; 
  x := 0; 
  assignfile(f, datei); 
  reset(f); 
  while not eof(f) do begin 
    inc(x); 
    read(f, c); 
    if c = zusuchen then begin 
      setlength(a, (lng + 1) * sizeof(longint)); 
      a[lng] := x; 
      inc(lng); 
    end; 
  end; 
  closefile(f); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var i: integer; 
  posi, anz, anf: string; 
begin 
  screen.cursor := crHourGlass; 
 
  datei := 'c:\autoexec.bat'; 
  zusuchen := '\'; 
 
  if fileexists(datei) then begin 
    finden; 
    anf := 'Das Zeichen ' + zusuchen + ' wurde '; 
    if lng = 0 then 
      showmessage(anf + 'nicht in ' + datei + ' gefunden.') 
    else begin 
      if lng = 1 then anz := ' der Position ' 
      else anz := ' den Positionen '; 
      posi := ''; 
      for i := 0 to lng - 1 do 
        posi := posi + #32 + inttostr(a[i]); 
      showmessage(anf + inttostr(lng) + 
        ' mal in ' + datei + ' gefunden, und zwar an' + anz + posi); 
    end; 
  end else 
    showmessage('Datei nicht gefunden.'); 
  screen.cursor := crdefault; 
end;

// ----------------------------------------------------------------

Variante 2

// Da sich Variante 1 nicht eignet große Dateien schnell zu durchsuchen,
// hier ein weiterer Code, der das erste Vorkommen einer Zeichenfolge
// ermittelt. Auf meinem Rechner wurde damit eine Datei von 17 Megabyte
// in 0,4 Sekunden komplett durchsucht.

 

function findeBytes(zeichenfolge: array of byte; datei: TFilename): longint; 
var 
  m: TMemorystream; 
  p: ^byte; 
  lg: integer; 
  x: longint;
begin 
  result := -1; 
  m := TMemorystream.create; 
  m.loadfromfile(datei); 
  lg := length(zeichenfolge); 
  p := m.memory; 
  for x := 0 to m.size - lg do begin 
    if comparemem(@zeichenfolge, p, lg) 
      then begin 
      result := x; 
      break; 
    end; 
    inc(p); 
  end; 
  m.free; 
end; 
 
function findeString(zeichenfolge: string; datei: TFilename): longint; 
var 
  a: array of byte; 
  x: integer; 
begin 
  setlength(a, length(zeichenfolge)); 
  for x := 0 to high(a) do 
    a[x] := ord(zeichenfolge[x + 1]); 
  result := findeBytes(a, datei); 
end; 
 

// -- Beispielaufrufe ---

// eine Byte-Folge wird gesucht
procedure TFormx.Button7Click(Sender: TObject); 
var 
  offs: Longint; 
begin 
  offs := findeBytes([$44, $42, $52], 'C:\FILE0011.CHK'); 
  if offs < 0 then showmessage('nicht gefunden') 
  else showmessage('gefunden an Offset ' + inttostr(offs)); 
end; 
 
// ein String wird gesucht
procedure TFormx.Button8Click(Sender: TObject); 
var 
  offs: Longint; 
begin 
  offs := findeString('Desktop', 'c:\regsic.reg'); 
  if offs < 0 then showmessage('nicht gefunden') 
  else showmessage('gefunden an Offset ' + inttostr(offs)); 
end;