PosExUltra - Ultimative Stringsuche/Parser

[Matze]

Ich würde die genannte Zeile einfach löschen. Der, der deine Funktion nutzen möchte, soll diese selbst in einen Thread auslagern. Da musst du nichts basteln. ;)

[Novo]

ok habs mal verbessert.

[himitsu]

Wenn eine Funktion oft sehr lange dauert:
Was du da machen könntest, wäre eine alternativer Parameter, bei welchem man eine Callback-Funktion angeben kann ... dort könnte der Benutzer deiner Funktion dann selber entscheiden, wie er dieses bei sich behandelt.

Wobei man bei sowas eigentlich Funktion besser in Threads auslagert.

PS: Wenn in deinem Code auf Application zugegriffen würde, dann könnte man diese Funktion nicht in einen Thread auslagern.
Allgemein sollte bei derartigen Funktionen sowieso nicht auf Externes zugegriffen werden (dazu zählen Application oder eine Form).

[alzaimar]

So, ich hab mich auch mal versucht und kurz getestet.

Delphi-Quellcode:

Procedure ExtractBetween (Const aSource, aPrefix, aSuffix : String;
  aFindAll : Boolean; aNewPrefix, aNewSuffix : String; aWords : TStrings);
Var
  PrefixLength, PosPrefix, PosSuffix, BestPos : Integer;
Begin
  PosPrefix := PosEx (aPrefix, aSource, 1);
  if PosPrefix=0 then exit;
  PrefixLength := Length (aPrefix);
  Repeat
    PosSuffix := PosEx (aSuffix, aSource, PosPrefix + PrefixLength);
    if PosSuffix=0 then Exit;

    While (PosPrefix<>0) and (PosPrefix<PosSuffix) Do Begin
      BestPos := PosPrefix;
      PosPrefix := PosEx (aPrefix, aSource, PosPrefix + PrefixLength);
    End;
    sWords.Add (aNewPrefix + Copy (aSource, BestPos+PrefixLength,PosSuffix-BestPos-PrefixLength) + aNewSuffix);
    If PosPrefix=0 then exit;
  Until not aFindall;
End;

Die ganzen Sonderfälle (leere Suchstrings usw) habe ich nicht abgefangen.

[omata]

Benötigte Unit: StrUtils, Classes

Novo überarbeitet:

Delphi-Quellcode:

procedure PosExUltra(source, searchwordbefore, searchwordafter,
                     addbefore, addafter: string;
                     continuesearch, reversesearch: boolean;
                     liste: TStrings);

  function Search(var Anfang, Ende, Posi: Integer): string;
  var P: Integer;
  begin
    P:=PosEx(searchwordbefore, source, Posi);
    while (P = 0) or (P > Posi) do begin
      Dec(Posi);
      P:=PosEx(searchwordbefore, source, Posi);
    end;
    Result := Copy(
      source,
      Posi + length(searchwordbefore),
      Anfang - (Posi + length(searchwordbefore))
    );
    if (Result <> '') or (Result <> ' ') then
      liste.Append(addbefore + Result + addafter);
  end;

var
  Anfang, Ende, Posi: Integer;
  Ergebnis: string;
begin
  Ende := 0;
  if reversesearch then begin
    if continuesearch then begin
      Anfang := PosEx(searchwordafter, source, Ende);
      while Anfang > 0 do begin
        Posi := Anfang;
        if Anfang > 0 then begin
          Ergebnis:=Search(Anfang, Ende, Posi);
          Ende :=
              Posi
            + length(searchwordbefore)
            + Length(Ergebnis)
            + Length(searchwordafter);
          Anfang := PosEX(searchwordafter, source, Ende);
        end;
      end;
    end
    else begin
      Anfang := PosEx(searchwordafter, source, Ende);
      Posi := Anfang;
      if Anfang > 0 then
        Ergebnis:=Search(Anfang, Ende, Posi);
    end;
  end
  else if continuesearch then begin
    repeat
      Anfang := PosEx(searchwordbefore, source, Ende);
      if Anfang > 0 then begin
        Ende := PosEx(searchwordafter, source, Anfang);
        Ergebnis := Copy(
          source,
          Anfang + length(searchwordbefore),
          (Ende - Anfang) - length(searchwordbefore)
        );
        if (Ergebnis <> '') or (Ergebnis <> ' ') then
          liste.Append(addbefore + Ergebnis + addafter);
        Anfang := Anfang + length(Ergebnis);
      end;
    until Anfang = 0;
  end
  else begin
    Anfang := PosEx(searchwordbefore, source, Ende);
    if Anfang > 0 then begin
      Ende := PosEx(searchwordafter, source, Anfang);
      Ergebnis := Copy(
        source,
        Anfang + length(searchwordbefore),
        (Ende - Anfang) - length(searchwordbefore)
      );
      if (Ergebnis <> '') or (Ergebnis <> ' ') then
        liste.Append(addbefore + Ergebnis + addafter);
    end;
  end;
end;

alzaimar überarbeitet:

Delphi-Quellcode:

procedure ExtractBetween(const aSource, aPrefix, aSuffix : string;
                         aFindAll : Boolean; aNewPrefix, aNewSuffix : string;
                         aWords : TStrings);
var
  PrefixLength, PosPrefix, PosSuffix, BestPos : Integer;
begin
  PosPrefix := PosEx(aPrefix, aSource, 1);
  if PosPrefix > then begin
    PrefixLength := Length (aPrefix);
    repeat
      PosSuffix := PosEx(aSuffix, aSource, PosPrefix + PrefixLength);
      if PosSuffix > 0 then begin
        while (PosPrefix <> 0) and (PosPrefix < PosSuffix) do begin
          BestPos := PosPrefix;
          PosPrefix := PosEx(aPrefix, aSource, PosPrefix + PrefixLength);
        end;
        aWords.Append(
            aNewPrefix
          + Copy(aSource, BestPos + PrefixLength, PosSuffix-BestPos - PrefixLength)
          + aNewSuffix
        );
      end;
    until not aFindall or (PosPrefix = 0);
  end;
end;

[alzaimar]

Hi omata,

Danke.

[GPRSNerd]

Hallo omata,

da hat sich ein kleiner Copy&Paste-Fehler in der 2. Procedure versteckt:

In

Delphi-Quellcode:

procedure ExtractBetween(const aSource, aPrefix, aSuffix : string;
                         aFindAll : Boolean; aNewPrefix, aNewSuffix : string;
                         aWords : TStrings);
var
  PrefixLength, PosPrefix, PosSuffix, BestPos : Integer;
begin
  PosPrefix := PosEx(aPrefix, aSource, 1);
  if PosPrefix > then begin

sollte die letzte Zeile wohl so lauten:

Delphi-Quellcode:

  if PosPrefix > 0 then begin

Gruß,
Stefan

[Hawkeye219]

Hallo,

noch einige Anmerkungen:

- Wenn aPrefix gefunden wird, aSuffix aber nicht, kommt es zu einer Endlosschleife für aFindAll = True. Im Code von alzaimar war dieser Fall durch eine Exit-Anweisung abgedeckt.
- Der Compiler warnt, dass die Variable BestPos möglicherweise nicht initialisiert wird.
- Das Füllen der Stringliste sollte mit einem BeginUpdate..EndUpdate geklammert werden.

Ist eine Routine mit sieben bzw. acht Parametern wirklich sinnvoll? Wie testet man solch ein Ungetüm?

Gruß Hawkeye

[himitsu]

Zitat:

Zitat von Hawkeye219

Ist eine Routine mit sieben bzw. acht Parametern wirklich sinnvoll? Wie testet man solch ein Ungetüm?

Jupp, als Klasse wäre es bestimmt nicht schlecht.

[omata]

Zitat:

Zitat von GPRSNerd

da hat sich ein kleiner Copy&Paste-Fehler in der 2. Procedure versteckt...

Zitat:

Zitat von Hawkeye219

...kommt es zu einer Endlosschleife ... Im Code von alzaimar war dieser Fall durch eine Exit-Anweisung abgedeckt.

Ups, ja ihr habt recht, danke für die Hinweise.

Hier die Korrektur...

Delphi-Quellcode:

procedure ExtractBetween(const aSource, aPrefix, aSuffix : string;
                         aFindAll : Boolean; aNewPrefix, aNewSuffix : string;
                         aWords : TStrings);
var
  PrefixLength, PosPrefix, PosSuffix, BestPos : Integer;
begin
  PosPrefix := PosEx(aPrefix, aSource, 1);
  if PosPrefix > 0 then begin
    PrefixLength := Length (aPrefix);
    repeat
      PosSuffix := PosEx(aSuffix, aSource, PosPrefix + PrefixLength);
      if PosSuffix > 0 then begin
        while (PosPrefix <> 0) and (PosPrefix < PosSuffix) do begin
          BestPos := PosPrefix;
          PosPrefix := PosEx(aPrefix, aSource, PosPrefix + PrefixLength);
        end;
        aWords.Append(
            aNewPrefix
          + Copy(aSource, BestPos + PrefixLength, PosSuffix-BestPos - PrefixLength)
          + aNewSuffix
        );
      end;
    until not aFindall or (PosSuffix = 0) or (PosPrefix = 0);
  end;
end;