[Algorithmus] HTML2TXT
Silvio Wangler
Ich bin auf der Suche nach einem schnellen und effizienten
Algorithmus für Stringoperationen. Ich möchte jegliche
HTML Tags ausscheiden, damit nur noch der Body (Text
zwischen einem Tag) vorhanden ist.
Kennt jemand von Euch einen solchen Algorithmus? Mein
Algorithmus ist leider bei grossen HTML Dokumenten nicht
sehr schnell und füllt unnötigerweise den Speicher bis zum
Systemgrenzwert. D.h. ich kriege regelmässig einen Runtime
Error 'Out of memory' bei 256 MB RAM.
Besten Dank für die Hilfe.
Mit freundlichen Grüssen
Silvio Wangler
<code>
Public Function cutHTML(htmlSourcecode As String) As String
Dim leftPos As Long, rightPos As Long
' Position der Klammer '<'
leftPos = InStr(htmlSourcecode, "<")
' Position der Klammer '>'
rightPos = InStr(htmlSourcecode, ">")
' Ausscheiden.
While leftPos <> 0 And rightPos <> 0
htmlSourcecode = Left(htmlSourcecode, leftPos - 1)
& Mid(htmlSourcecode, rightPos + 1, Len(htmlSourcecode))
leftPos = InStr(htmlSourcecode, "<")
rightPos = InStr(htmlSourcecode, ">")
Wend
' Sonderzeichen ersetzen
' New break space ' ' durch Zeilenumbruch ersetzen
htmlSourcecode = Replace(htmlSourcecode, " ",
vbNewLine)
' Deutsche Umlaute von HTML --> ASCII
htmlSourcecode = Replace(htmlSourcecode, "ü", "ü")
htmlSourcecode = Replace(htmlSourcecode, "ä", "ä")
htmlSourcecode = Replace(htmlSourcecode, "ö", "ö")
htmlSourcecode = Replace(htmlSourcecode, "Ü", "Ü")
htmlSourcecode = Replace(htmlSourcecode, "Ä", "Ä")
htmlSourcecode = Replace(htmlSourcecode, "Ö", "Ö")
' Allfällige Whitespaces entfernen.
cutHTML = Trim(htmlSourcecode)
End Function
</code>
Josef Vetter
Vorrausgesetzt du kannst das WebBrowser-Control einsetzen, geht das wie
folgt sehr schnell...
Private Sub Command1_Click()
WebBrowser1.Navigate "yourURL"
Set obj = WebBrowser1.Document
MsgBox obj.Body.innerText
End Sub
...und schon sind the HTML-Tags alle weg.
Gruß
Josef Vetter
"Silvio Wangler" <saw...@gmx.ch> wrote in message
news:010f01c2a0ef$db824210$8af82ecf@TK2MSFTNGXA03...
Silvio Wangler
>-----Originalnachricht-----
>Vorrausgesetzt du kannst das WebBrowser-Control
>einsetzen, geht das wie folgt sehr schnell...
>
>Private Sub Command1_Click()
> WebBrowser1.Navigate "yourURL"
> Set obj = WebBrowser1.Document
> MsgBox obj.Body.innerText
>End Sub
>
>....und schon sind the HTML-Tags alle weg.
Mal ganz doof gefragt.. muss der IE dafür geöffnet werden?
Ich nehme an das dies der Fall ist -->
WebBrowser1.Navigate "yourURL"
Gruss,
Silvio
Josef Vetter
Der IE ist eine Control. Die IE-EXE ist nur eine "kleiner" Wrapper der das
Control einbettet (Vereinfacht beschrieben).
D.h. Ja, der IE ist geladen als Control auf deiner Form.
Das Control kann aber .visble=false sein, so daß man nichts vom IE bemerkt.
Gruß
Josef Vetter
"Silvio Wangler" <saw...@gmx.ch> wrote in message
news:014201c2a0f4$e55c21c0$8af82ecf@TK2MSFTNGXA03...
Jost Schwider
VB ist relativ langsam beim Zusammenfügen von Strings.
Außerdem kosten unnötige Typ-Umwandlungen ebenfalls Zeit.
Wirf daher mal einen Blick auf folgende Artikel:
- Strings schnell aneinander hängen
http://vb-tec.de/concat.htm
- String-Funktionen mit Dollar
http://vb-tec.de/strdollr.htm
- Blitzschnelle Replace-Funktion
http://vb-tec.de/replace.htm
Weitere VB-Tipps gibt es übrigens hier: http://vbFAQ.de/
Viele Grüße
Jost aus Soest (sprich: "joost aus soost")
--
http://vb-tec.de/ - Visual Basic FAQ, Beispiele, Tipps, ...
http://www.schwider.de/ - Web-Technik, -Beratung, -Support.
Schmidt
"Silvio Wangler" <saw...@gmx.ch> schrieb im Newsbeitrag
news:010f01c2a0ef$db824210$8af82ecf@TK2MSFTNGXA03...
> Ich bin auf der Suche nach einem schnellen und effizienten
> Algorithmus für Stringoperationen. Ich möchte jegliche
> HTML Tags ausscheiden, damit nur noch der Body (Text
> zwischen einem Tag) vorhanden ist.
Versuch's mal mit folgendem, noch ausbaufähigen Ansatz:
(derzeit nur gegen heise.de getestet)
Am besten das Ganze in eine separate DLL stecken und zu NativeCode
kompilieren (alle Options checken).
Dürfte dann etwa 200 mal so schnell sein, wie die Routine von Benjamin.
Private Function GetText$(HTML$)
Dim B() As Byte, S() As Byte, BB As Byte
Dim i&, j&, k&, o&, Tag&, Amp&
B = StrConv(HTML, vbFromUnicode)
For i = 0 To UBound(B)
BB = B(i)
If BB = 60 Then Tag = i: GoTo nxt
If BB = 9 Or BB = 10 Or BB = 13 Then GoTo nxt
If BB = 62 Then CheckForBreak B, i, o: Tag = 0: GoTo nxt
If Tag Then GoTo nxt
If BB = 38 Then Amp = i: GoTo nxt
If BB = 59 Then
k = i - Amp - 1
If Amp > 0 And k > 1 And k < 7 Then
ReDim Preserve S(k - 1): k = 0
For j = Amp + 1 To i - 1: S(k) = B(j): k = k + 1: Next
CheckSpecials StrConv(S, vbUnicode), B, o
End If
Amp = 0: GoTo nxt
End If
If BB = 33 Or BB = 44 Or BB = 46 Or BB = 58 Or BB = 63 Then
If B(o - 1) = 10 Then If o > 1 Then o = o - 2
End If
B(o) = BB: o = o + 1
nxt: Next i
If o Then
ReDim Preserve B(o - 1): GetText = StrConv(B, vbUnicode)
End If
End Function
Private Sub CheckForBreak(B() As Byte, ByVal i&, o&)
If B(i) = 47 Then i = i - 2 Else i = i - 1
If B(i) = 112 Or B(i) = 80 Then 'P
B(o) = 13: o = o + 1: B(o) = 10: o = o + 1
ElseIf B(i) = 97 Or B(i) = 65 Then 'A
If B(o - 1) <> 10 And B(o - 1) <> 32 Then
B(o) = 13: o = o + 1: B(o) = 10: o = o + 1
End If
ElseIf B(i) = 114 Or B(i) = 82 Then 'BR
If B(i - 1) = 98 Or B(i - 1) = 66 Then
B(o) = 13: o = o + 1: B(o) = 10: o = o + 1
End If
End If
End Sub
Private Sub CheckSpecials(S$, B() As Byte, o&)
Static BSp() As Byte, A$(), Done As Boolean, i&, BL As Byte
If Not Done Then
Done = True
BSp = StrConv("""<>& äÄöÖüÜß&²³£¥¢±°©®§«»·øØ÷", vbFromUnicode)
A = Split("quot gt lt amp nbsp auml Auml ouml Ouml uuml Uuml " & _
"szlig amp sup2 sup3 pound yen cent plusm deg copy " & _
"reg sect laquo raquo middot oslash Oslash divide", " ")
End If
For i = 0 To UBound(A)
If S = A(i) Then
o = o - Len(S)
If BL = 32 And BSp(i) = 32 Then Exit Sub Else BL = BSp(i)
B(o) = BSp(i): o = o + 1: Exit Sub
End If
Next i
End Sub
Olaf
Franco Erpf
> Versuch's mal mit folgendem, noch ausbaufähigen Ansatz:
> (derzeit nur gegen heise.de getestet)
> Am besten das Ganze in eine separate DLL stecken und zu NativeCode
> kompilieren (alle Options checken).
> Dürfte dann etwa 200 mal so schnell sein, wie die Routine von Benjamin.
In der Tat, Du schiesst wieder mal den Vogel ab :-) Deine Routine ist sogar
schneller, als das WebBrowser-Control! (Allerdings musst Du den HTMLSource
auch nicht erst für die Darstellung interpretieren <g>)
Falls es euch interessiert, ich hab das Testprojekt, das ich in den letzten
Tagen für den Vergleich von verschiedenen Routinen gemacht habe, ins Netz
gestellt:
http://www.deha.ch/inside/ ---> HTML2TextTest
BTW Olaf... falls Du Dir das Projekt saugst, wirst Du in der EnDeC-Klasse
auf einen alten Bekannten treffen <s>.
Ciao
Franco
Franco Erpf
> Das Control kann aber .visble=false sein, so daß man nichts vom IE
bemerkt.
Kann sein, dass es an meinen Systemeinstellungen oder weiss der Geier woran
liegt, aber seit einem der letzten Patches von MS führt .Visible=False bei
mir zu Fehlern. Alternativ habe ich jetzt das WebBwrowser-Control auf
.Visible=True und einfach ausserhalb der Form, bzw. in einem nicht
sichtbaren Bereich der Form plaziert - und es funktioniert wieder.
Ciao
Franco
Schmidt
"Franco Erpf" <f.e...@deha.ch> schrieb im Newsbeitrag
news:eOHLFhZoCHA.2688@TK2MSFTNGP12...
> In der Tat, Du schiesst wieder mal den Vogel ab :-) Deine Routine ist
sogar
> schneller, als das WebBrowser-Control!
Ja, etwa 20 mal so schnell (wenn man native mit allen Optionen kompiliert
hat).
> (Allerdings musst Du den HTMLSource
> auch nicht erst für die Darstellung interpretieren <g>)
Ok, bei einem 20'tel der Zeit für's reine Text-Parsing bleibt ja noch genug
Luft für die paar Funktionen, die zu einem vollständigen Browser noch
fehlen. ;-)
Ich hab anhand Deiner Beispiel-App-HTML-Texte noch eine Pre-Tag-Erkennung
nachgerüstet, so dass jetzt auch die in der "Harald-Seite" enthaltenen
VB-Sourcen relativ ordentlich aussehen.
Private Function GetText$(HTML$)
Dim B() As Byte, S() As Byte, BB As Byte, Pre As Boolean
Dim i&, j&, k&, o&, Tag&, Amp&
B = StrConv(HTML, vbFromUnicode)
For i = 0 To UBound(B)
BB = B(i)
If BB = 60 Then Tag = i: GoTo nxt
If BB = 62 Then CheckForPre Pre, B, Tag, o
If (BB = 9 Or BB = 10 Or BB = 13) And Not Pre Then GoTo nxt
Private Sub CheckForPre(Pre As Boolean, B() As Byte, ByVal i&, o&)
Dim TClosed As Boolean
i = i + 1: If B(i) = 47 Then i = i + 1: TClosed = True
If B(i) = 112 Or B(i) = 80 Then i = i + 1 Else Exit Sub
If B(i) = 114 Or B(i) = 82 Then i = i + 1 Else Exit Sub
If B(i) = 101 Or B(i) = 69 Then
Pre = Not TClosed
B(o) = 13: o = o + 1: B(o) = 10: o = o + 1
End If
End Sub
Olaf
Franco Erpf
> Ok, bei einem 20'tel der Zeit für's reine Text-Parsing bleibt ja noch
genug
> Luft für die paar Funktionen, die zu einem vollständigen Browser noch
> fehlen. ;-)
Ganz im Gegenteil, wir wollen ja das absolute antibrowsing ;-))
Und ja, Du hast recht, Deine Version bietet dermassen viel Luft, dass sich
da noch etliche Luxus-Optionen (z.B. alle vbCrLf mit " " ersetzen, alle " "
mit " " ersetzen, Pre-Tags berücksichtigen oder nicht, Links und/oder Bilder
innerhalb des Plaintextes gesondert kennzeichnen (<-- Benjamins Idee),
Page-Title ja/nein etc.pp.) einpflanzen lassen, und es immer noch schneller
ist, als alle anderen gängigen Versionen :-)
Ein echt geniales Stück Code!
Ciao
Franco
Benjamin Schulte
> > Ok, bei einem 20'tel der Zeit für's reine Text-Parsing bleibt ja noch
> genug
> > Luft für die paar Funktionen, die zu einem vollständigen Browser noch
> > fehlen. ;-)
>
> Ganz im Gegenteil, wir wollen ja das absolute antibrowsing ;-))
>
> Und ja, Du hast recht, Deine Version bietet dermassen viel Luft, dass sich
> da noch etliche Luxus-Optionen (z.B. alle vbCrLf mit " " ersetzen, alle "
"
> mit " " ersetzen, Pre-Tags berücksichtigen oder nicht, Links und/oder
Bilder
> innerhalb des Plaintextes gesondert kennzeichnen (<-- Benjamins Idee),
Wo Du das ansprichst: Hab bei PSC ein "HTML2Text Extended" hochgeladen. Ist
aber noch ein Stück langsamer als mein erstes HTML2Text. ;)
Franco Erpf
> Wo Du das ansprichst: Hab bei PSC ein "HTML2Text Extended" hochgeladen.
Ist
> aber noch ein Stück langsamer als mein erstes HTML2Text. ;)
Ich denke, es wäre geschickter, auf der Basis von Olafs Routine
weiterzumachen <s>. Die war zwar am Anfang für mich absolut undurchschaubar,
aber ich glaube, mir ist da inzwischen das Licht aufgegangen ;-))
Im Prinzip macht er da auch nix anderes, als Du es mit den Strings machst,
nur dass er nicht auf Strings baut, sondern auf deren Byte-Werte (wenn man
dem so sagen kann), die in ein Array gepackt wurden. Er durchläuft nicht
einen String, sondern das ByteArray, und schaut sich nicht den String "A"
an, sondern den Char-Wert "65" an - und der Geschwindigkeitsvorteil ist
dermassen frappant, dass sich da ein Umdenken alleweil lohnt... wäre sogar
überlegenswert, sich eine eigene Replace-Funktion auf dieser Basis
aufzubauen... auf jeden Fall werde ich mir zumindest meine EnDeC-Klasse
demnächst auf ein ByteArray umstellen.
Wie ("meine") Traum-HTML2PlainText-Klasse aussehen könnte, weiss ich auch
schon, und der Ideen sind da sicher noch mehr...
Function HTML2PlainText( _
ByVal strHTML As String, _
Optional ByVal blnIncludeMetaDescription As Boolean = False, _
Optional ByVal blnIncludeMetaKeyWords As Boolean = False, _
Optional ByVal blnIncludeMetaAuthor As Boolean = False, _
Optional ByVal blnIncludeMetaCopyRight As Boolean = False, _
Optional ByVal blnIncludePageTitle As Boolean = False, _
Optional ByVal strLinkDescription As String = "", _
Optional ByVal strImageDescription As String = "", _
Optional ByVal blnNoCRLF As Boolean = True, _
Optional ByVal blnNoDoubleSpaces As Boolean = True) _
As String
Klar, wenn alle Optionen und alle HTML-Maskierungen (99 Stück dürften's
sein) eingebaut sind, wird's langsamer werden, aber da ist so viel "Luft"
drin, dass es immer noch massiv schneller sein wird, als alle anderen mir
bekannten Versionen. Gibt auch 'ne riesen Fleissarbeit, aber es wird sich
lohnen!
Ciao
Franco
Benjamin Schulte
> > Wo Du das ansprichst: Hab bei PSC ein "HTML2Text Extended" hochgeladen.
> > Ist aber noch ein Stück langsamer als mein erstes HTML2Text. ;)
>
> Ich denke, es wäre geschickter, auf der Basis von Olafs Routine
> weiterzumachen <s>.
In der Hinsicht sage ich: Never touch a running system. In meinem
Anwendungsbereich und bei heutigen Rechnern ist der Durchlauf meiner Routine
nicht zu bemerken und sie läuft fehlerfrei. Da habe ich keinen Antrieb, was
zu ändern. ;)
> Function HTML2PlainText( _
> ByVal strHTML As String, _
> Optional ByVal blnIncludeMetaDescription As Boolean = False, _
> Optional ByVal blnIncludeMetaKeyWords As Boolean = False, _
> Optional ByVal blnIncludeMetaAuthor As Boolean = False, _
> Optional ByVal blnIncludeMetaCopyRight As Boolean = False, _
> Optional ByVal blnIncludePageTitle As Boolean = False, _
> Optional ByVal strLinkDescription As String = "", _
> Optional ByVal strImageDescription As String = "", _
> Optional ByVal blnNoCRLF As Boolean = True, _
> Optional ByVal blnNoDoubleSpaces As Boolean = True) _
> As String
Die letzten beiden Optionen auf False zu setzen ergibt für mich keinen
Sinn..?
Franco Erpf
> In der Hinsicht sage ich: Never touch a running system. In meinem
> Anwendungsbereich und bei heutigen Rechnern ist der Durchlauf meiner
Routine
> nicht zu bemerken und sie läuft fehlerfrei. Da habe ich keinen Antrieb,
was
> zu ändern. ;)
Yep, das ist natürlich ein fast nicht zu toppendes Argument <s>. Wenn's die
Aufgabe tut und die Nebenwirkungen keine Rolle spielen, würd ich das auch so
halten ;-)
> > Optional ByVal blnNoCRLF As Boolean = True, _
> > Optional ByVal blnNoDoubleSpaces As Boolean = True) _
> > As String
>
> Die letzten beiden Optionen auf False zu setzen ergibt für mich keinen
> Sinn..?
Naja, ich brauch halt den völlig unformatierten Plaintext ohne CRLFs, die
bei True z.B. durch ein Leerzeichen zu ersetzen wären. Die doppelten, bzw.
mehrere Leerzeichen hintereinander grad auch noch rauszufiltern ist
eigentlich nur noch polishing... ist mir halt auch noch so eingefallen....
und jetzt fällt mir grad auf, CR, LF und TAB könnte man dann grad auch noch
erschlagen...
Ciao
Franco