Pos / Zeichenketten herausfinden / Die Pure Verzweiflung!

[Firewing]

Guten Abend die Herren (und Damen? ),
ich habe da mal ein folgendes Problem. Und zwar lade ich mit Delphi einen circa 80 KB großen Quelltext runter in dem immer wieder diese Zeichenkette vorhanden ist:

Code:

    <div class="Image">
                <a href="http://www.test.de/Benutzer/d879b2749f4e2abc">
                [img]sdfsdfsdfsd/fdsfdsfssdf[/img]
                </a>
            </div>

Aus dieser soll er mir nun die
- Unique ID (die Zeichenfolge hinter dem "/Benutzer/")
- Vorname
- Nachname
in Variablen speichern.

Ich wäre sehr dankbar über nen Stückchen Code, da ich echt nicht weiterkomme. (Bevor jemand interessenhalber fragt, das Progrämmchen soll dazu dienen Forenbenutzerlisten speichern zu können.)

MfG Kristian

[mkinzler]

Wie hast du es schon versucht? Pos()/PosEx()/Copy()

[Firewing]

Ja mit allem, mir fehlt irgendwie der zündene Gedanke, hab mich irgendwie voll festgefahren.

Hab es angefangen so zu lösen (eine von gefühlten 100 Wegen):

Delphi-Quellcode:

for i := 0 to Memo1.Lines.Count - 1 do
  begin
  if (Pos('class="Image">', Memo1.Lines.Strings[i]) > 0)
  then
    begin
      s := '';
      for p := Pos('class="Image">', Memo1.Lines.Strings[i]) to
        Length(Memo1.Lines.Strings[i]) do
          s := s + Memo1.Lines.Strings[i][p];
          ListBox2.Items.Add(Utf8ToAnsi('[' + s + ']'));
...

So zeigt er mir immerhin schon 30 mal 'class="Image">'an, was auch der Benutzeranzahl auf der Seite entspricht. Aber gerade da dort Zeilenumbrüche usw drin sind, ist das echt ziemlich schwierig - oder ich bin inzwischen einfach nur müde

[mkinzler]

While PosEx(...) > 0 do

[kcx]

Kurz hingeklatscht:

Delphi-Quellcode:

uses
  StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
function ExtractBetween(const s, s1, s2: String): String;
var
  iPos, iPosLeft, iPosRight: Integer;
begin
  Result := '';
  iPos := Pos(s1, s);
  if iPos > 0 then
  begin
    iPosLeft := iPos + Length(s1);
    iPos := PosEx(s2, s, Succ(iPosLeft));
    if iPos > 0 then
    begin
      iPosRight := iPos;
      Result := Copy(s, iPosLeft, iPosRight - iPosLeft);
    end;
  end;
end;
var
  iPos, iPosLeft, iPosRight, iPosTemp: Integer;
  sTemp, sLink, sID, sVorNachname, sVorname, sNachname: String;
begin
  iPos := 0;
  repeat
    iPos := PosEx('<div class="Image">', Memo1.Text, Succ(iPos));
    if iPos > 0 then
    begin
      iPosLeft := iPos + 19;
      iPos := PosEx('</div>', Memo1.Text, Succ(iPosLeft));
      if iPos > 0 then
      begin
        iPosRight := iPos;
        sTemp := Copy(Memo1.Text, iPosLeft, iPosRight - iPosLeft);
        sLink := ExtractBetween(sTemp, '<a href="', '">');
        iPosTemp := Pos('Benutzer/', sLink);
        if iPosTemp > 0 then
          sID := Copy(sLink, iPosTemp + 9, MAXINT)
        else
          sID := '';
        //hier sID verarbeiten
        sVorNachname := ExtractBetween(sTemp, 'alt="', '"');
        iPosTemp := Pos(' ', sVorNachname);
        if iPosTemp > 0 then
        begin
          sVorname := Copy(sVorNachname, 1, Pred(iPosTemp));
          sNachname := Copy(sVorNachname, Succ(iPosTemp), MAXINT);
        end
        else
        begin
          sVorname := '';
          sNachname := '';
        end;
        //hier Namen verarbeiten
      end;
    end;
  until iPos = 0;
end;

kann man natürlich noch verbessern.

[omata]

Mit regulären Ausdrücken...

Delphi-Quellcode:

procedure GetData(HTML:string; Data:TStrings);
var RegEx: TRegExpr;
begin
  RegEx:=TRegExpr.Create;
  try
    RegEx.ModifierG:=false;
    RegEx.Expression:='Benutzer\/([0-9a-z]*)".*alt="(.*) (.*)"';
    if RegEx.Exec(HTML) then begin
      Data.Clear;
      repeat
        Data.Append(
          RegEx.Match[1] + ', ' +
          RegEx.Match[2] + ', ' +
          RegEx.Match[3]
        );
      until not RegEx.ExecNext;
    end;
  finally
    RegEx.Free;
  end;
end;

RegExpr

Gruss
Thorsten

[marabu]

Moin Kristian,

hier noch ein Ansatz, der deinen HTML-Parser verwendet:

Delphi-Quellcode:

procedure ExtractUsers(const markup: string; users: TStrings);
var
  doc, anchors, anchor: OleVariant;
  i, n: Integer;
  dir, url, user: string;
begin
  doc := {Mshtml.}CreateDocument(markup);
  anchors := doc.all.tags('a');
  n := anchors.length;
  for i := 0 to Pred(n) do
  begin
    anchor := anchors.item(i, null);
    url := SlashToBackSlash(anchor.href);
    user := {SysUtils.}ExtractFileName(url);
    dir := ExtractFileName(ExtractFileDir(url));
    if SameText(dir, 'Benutzer') then
      users.Add(user);
  end;
end;

Die Funktion ExtractUsers() arbeitet mit später Bindung, die Funktionen CreateDocument() und SlashToBackslash() findest du im Forum.

Freundliche Grüße

[Firewing]

Jungs, ganz große Klasse! Wunderbar, schnurrt wie ein Kätzchen!
Werde mich demnächst wohl mal wieder melden

Danke schön

[Firewing]

Eine klitze-kleine Frage noch:

Wie bekomme ich es realisiert, dass er meine Zeichenkette löscht, bis der erste unbekannte Buchstabe auftritt?

Quasi so:
Delete(zeichenkette, 1, Pos('x', zeichenkette));
Die Zeichenkette sieht etwa so aus: [Zeilenumbruch][Zeilenumbruch][Leerzeichen][Leerzeichen][Leerzeichen]xy Peter Pan ist ein toller...

(Die Zeilenumbruch/Leerzeichenanzahl wechselt und der erste Buchstabe auch...)


EDIT: Bräuchte in diesem Fall doch nochmal eure Hilfe. Und zwar ist die Lösung alle Leerzeichen durch '' zu ersetzten (mit Replace) nicht so dolle, da in der Zeichenkette die ausgelesen werden soll, noch weitere Leerzeichen vorhanden sind. Sprich er beschneidet auch Sätze usw.

Danke schön für eure kommende Hilfe :=)