function CountSubtxt(Pattern, Txt: string; ignoreCase: boolean): Integer; 
var 
  lgp: integer; 
  pt, pp: PChar; 
begin 
  Result := 0; 
  lgp := length(Pattern); 
  if (lgp = 0) or (length(Txt) = 0) then exit; 
  if ignorecase then begin 
    Pattern := AnsiLowerCase(Pattern); 
    Txt := AnsiLowerCase(Txt); 
  end; 
  pt := @Txt[1]; 
  pp := @Pattern[1]; 
  repeat 
    while pt^ <> pp^ do begin 
      if pt^ = #0 then exit; 
      inc(pt); 
    end; 
    if comparemem(pt, pp, lgp) then begin 
      inc(Result); 
      inc(pt, lgp); 
    end else 
      inc(pt); 
  until pt^ = #0; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  showmessage(inttostr(CountSubtxt('Name', Memo1.Text, true))); 
end;