VB.NET Klasse HTMLReader
Zweck
In vielen Fällen kommt es vor, dass man eine HTML Seite oder HTML Datei auswerten muss. Das kann sehr mühsam werden, wenn man mit Bordmittel arbeitet.
Es gibt verschiedene Methoden (Nicht abschliessend):
- Man überlässt dies der von der MSHTML Bibliothek verfügbaren Klasse HTMLDocument, dass ist für die vor .NET-Framework Zeit eine der besten Boardmittel.
- Der HTML-Quellcode wird eingelesen und mit Regex (Regulären Ausdrücken) zu analysieren.
- Man benutzt das Html Agility Pack.
- Man schreibt selber einen Parser.
Stolpersteine
Der Code des HTML ist je nach Herkunft unterschiedlich aufgebaut. Es gibt bei der HTML Codierung zwei Positionen, an der man sich festhalten kann.
- Die erste Zeile ist meist der Dokumenttyp bzw. die Kennung welche HTML Version benutzt wurde.
- Es gibt ein HTML Grundgerüst mit den Tags-Abschnitten HTML, HEAD, TITLE, BODY und dessen End-Tags.
- Die meisten Tags (ausser META, und LINK) haben ein Kleiner-Als () Schlusszeichen.
Man könnte nun mithilfe des Kleiner-Als (<) Zeichen die HTML Tags (Befehle) ermitteln. Doch es gibt folgende Stolpersteine:
In Kommentarabschnitten (), in Scriptabschnitten und Styleabschnitten können ebenfalls Tags vorkommen, die unter Umständen nicht an diese Positionen gehören oder unfertig gebaut sind. Zum Beispiel ruft ein Javascript ein HTMLCode Zeichenkette per Funktion auf. Das kann dazu führen, dass man innerhalb eines HEAD-Abschnittes (Kopfzeile) einen BODY-Abschnitt findet. Manchmal sind solche Fragmente absichtlich eingebaut worden, damit die Seite nicht analysiert werden kann.
Deshalb muss, bevor man eine Analyse oder eine Auftrennung des HTML Inhaltes vornimmt, muss man die Kommentare, Scripts und Styles in dem, für die zu eingelesenden HTML Seite, verfügbaren Variable entfernen.
Danach kann der restliche Inhalt der HTML Seite nach Tags-Abschnitten aufgetrennt werden.
Ein weitere Stolperstein ist, dass Identifikationsmerkmale, wie Klassenname (class), Identitäten (id) oder Überschriften (….</h*) nicht an der Stelle auftaucht, in der sich die gewünschte Information befindet. Beispielsweise stehen zwischen der Information und einem Klassennamen etliche Tags-Abschnitte dazwischen.
Deshalb ist es nützlich, dass man während dem Auftrennen der Tags-Abschnitte, den Wert der Identifikationsmerkmale sich merkt und weitervererbt.
Nützlich wäre auch, dass man die Tabellen innerhalb des HTML Inhalts bereits als Tabellen strukturiert aufnimmt.
Ein weiter Stolperstein ist das HTML Codes grundsätzlich Verschachtelt daher kommt. Das heisst es Verschachtelungen der Tags-Abschnitte, aber auch von Tabellen. Beispielsweise kann innerhalb einer Tabellenzelle, eine Untertabelle auftauchen.
Keine Chance bei Verschachtelten HTML Codes hat man, wenn man nirgends eine Identifikationsmerkmal definiert hat.
Um möglichst den HTML Inhalt Datenbank mässig zu analyisieren und gezielt werte auszuwerten habe ich folgenden Quellcode geschrieben.
Aufbau der Klasse HTMLReader
Aufruf
- DIM objectvariable as new HTMLReader(Internet-Adresse oder Dateipfad)
Datentypen
- Table (Tabellen)
- TableRow (Tabellenzeilen)
- TableCell (Tabellenzellen)
- Tag (Der Tag Abschnitt und seine Informationen)
Eigenschaften
- GetValueFromObject (Zugreifen auf Werte von Variabeln, Eigenschaften via Name)
- Content (Der Inhalt der HTML Seite)
- Url (Die Adresse oder der Pfad der HTML Seite)
- Tags (Der Auflistungscontainer für die Tags)
- Tables (Der Auflistungscontainter für die Tabellen)
Methoden
- Close (Schliessen des HTML Inhaltes)
Funktionen
- GetSelectTags (Auswerten nach einem Tag-Name)
- GetSelectAttributs (Auswerten nach einem Attribut-Schlüsselnamen)
- GetSelectAttributsByTag (Auswerten nach einem Attribut-Schlüsselnamen innerhalb eines bestimmten Tag-Abschnittes)
- GetSelect (Auswerten der Tags-Auflistung nach verschieden Kriterien)
- GetValueFromSelect (Wie GetSelect, nur übermittle mir den Wert des ersten Treffers)
Quellcode
Imports System
Imports System.IO
Imports System.Net
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Linq
Public Class HTMLReader : Implements IDisposable
'Klasse: HTMLReader
'Ziel: Datenbankorientiertes Lesen eines HTMLCodes
'Autor: Daniel Schück, Hubstrasse 55a, CH-9500 Wil
'Version: 1.0.0 von 2017
'History
'-------
'1.0.0 07.10.2017 Eröffnung der Klasse
Private pv_Content As String 'HTML Inhalt
Private pv_Url As String 'Url
Private pv_Tags As List(Of Tag) 'Tags
Private pv_Tables As List(Of Table) 'Tabellen
'Schalter für FilterOptionen
Public Enum FilterOptionEnum
SingleLine = 0 'Rückgabe erster Wert
MultiLine = 1 'Rückgabe aller Werte
End Enum
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Shared Function pv_GetValueFromObject(ByVal FromObject As Object, ByVal Name As String)
Dim oFieldInfo As Reflection.FieldInfo 'Eröffne Feldinformationen Objekt
Dim oPropertyInfo As Reflection.PropertyInfo 'Eröffne Eigenschaftinformationen Objekt
Dim oFieldValue As Object = Nothing 'Eröffne Wert Objekt
Dim vName As String = Name 'Temporäre Variable für Name des Objektes
Dim vKey As String = "" 'Schlüsselname
'Wenn der Name des Objektes einen Punkt hat trenne in auf.
If vName.IndexOf(".") >= 0 Then
vKey = vName.Substring(vName.IndexOf(".") + 1).Trim
vName = vName.Substring(0, vName.IndexOf(".")).Trim
End If
oFieldInfo = FromObject.GetType.GetField(vName) 'Suche ein Feld mit dessen Namen
If Not oFieldInfo Is Nothing Then
'Der Feldname ist gültig und nun hohle aktuellen Wert
oFieldValue = oFieldInfo.GetValue(FromObject)
If Not vKey = "" Then
If oFieldValue.Contains(vKey) Then
oFieldValue = oFieldValue(vKey)
End If
End If
Else
'Der Feldname ins ungültig
oPropertyInfo = FromObject.GetType.GetProperty(Name) 'Suche anstelle des Felds in den Eigenschaften
If Not oPropertyInfo Is Nothing Then
'Der Eigenschaftsname ist gültige und nun hohle aktuellen Wert
oFieldValue = oPropertyInfo.GetValue(FromObject, Nothing)
End If
End If
'Gib ermittelten Wert zurück
Return oFieldValue
End Function
'Datentyp Table für Tabellen
Public Structure Table
Public Nr As String 'Nummer der Tabelle
Public Name As String 'Name der Tabelle
Public Rows As List(Of TableRow) 'Zeilen innerhalb der Tabelle
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Public ReadOnly Property GetValueFromObject(ByVal Name As String)
Get
'Gib ermittelten Wert zurück
Return pv_GetValueFromObject(Me, Name)
End Get
End Property
End Structure
'Datentyp TableRow für Tabellenzeilen
Public Structure TableRow
Public Nr As Long 'Nummer der Zeile
Public Name As String 'Name der Zeile
Public Cells As List(Of TableCell) 'Zellen innerhalb der Zeilen
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Public ReadOnly Property GetValueFromObject(ByVal Name As String)
Get
'Gib ermittelten Wert zurück
Return pv_GetValueFromObject(Me, Name)
End Get
End Property
End Structure
'Datentyp TableCell für Tabellenzellen
Public Structure TableCell
Public Nr As Long 'Nummer der Zelle
Public Name As String 'Name der Zelle
Public Content As String 'HTML Inhalt der Zelle
Public Text As String 'Text der Zelle
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Public ReadOnly Property GetValueFromObject(ByVal Name As String)
Get
'Gib ermittelten Wert zurück
Return pv_GetValueFromObject(Me, Name)
End Get
End Property
End Structure
'Datentyp Tag für Tag-Abschnitte in einer HTML Struktur
'* Diese Variabeln befinden sich auch in der Sections Collection
Public Structure Tag
Public Nr As Long 'Fortlaufende Zahl
Public Name As String 'Name des Tags
Public Content As String 'HTML Inhalt
Public OuterTag As String 'Ausserhalb des Tags (Text)
Public InnerTag As String 'Innerhalb des Tags
Public Attributs As Collection 'Attribute innerhalb des Tags
Public Hierarchy As String 'Hierachie
Public InnerBody As Boolean 'Tag befindet sich im Body-Abschnitt
Public Sections As Collection 'Vererbten Identifikationsmerkmale (Tabellenname, Überschriften, Klassennamen, Ids)
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Public ReadOnly Property GetValueFromObject(ByVal Name As String)
Get
'Gib ermittelten Wert zurück
Return pv_GetValueFromObject(Me, Name)
End Get
End Property
End Structure
'Eigenschaft GetValueFromObject für Rückgabe des Wertes eines bestimmten Objekt
Public ReadOnly Property GetValueFromObject(ByVal Name As String)
Get
'Gib ermittelten Wert zurück
Return pv_GetValueFromObject(Me, Name)
End Get
End Property
'Eigenschaft HTML für Rückgabe des HTML Inhaltes (Codes)
Public ReadOnly Property Content() As String
Get
Return pv_Content
End Get
End Property
'Eigenschaft URL für Rückgabe der URL Adresse
Public ReadOnly Property Url() As String
Get
Return pv_Url
End Get
End Property
'Eigenschaft Tags für Auflistung der Tags
Public ReadOnly Property Tags() As List(Of Tag)
Get
Return pv_Tags
End Get
End Property
'Eigenschaft Tables für Auflistung der Tabellen
Public ReadOnly Property Tables() As List(Of Table)
Get
Return pv_Tables
End Get
End Property
'Das Objekt wird eröffnet
'Eingabeparameter URL: URL-Adresse oder Dateiname
Public Sub New(ByVal URL As String)
Dim oWebRequest As HttpWebRequest 'Webanfrage Objekt
Dim oWebResponse As WebResponse = Nothing 'Webantwort Objekt
Dim oDataStreamReader As StreamReader 'Lesedatenfolge Objekt
If URL Like "?:\*" Or URL Like "\\*" Then
'Die URL ist eine Datei
oDataStreamReader = New StreamReader(New FileStream(URL, FileMode.Open))
Else
'Stelle die Webanfrage an die angebenen URL Adresse
oWebRequest = WebRequest.Create(URL)
'Verwendet Standard Authentifizierung
oWebRequest.Credentials = CredentialCache.DefaultCredentials
'Hohle die Antwort der Webanfrage
oWebResponse = oWebRequest.GetResponse()
'Hohle die Datenfolge der Webanfrage
oDataStreamReader = New StreamReader(oWebResponse.GetResponseStream)
End If
'Lese Dateninhalt der HTML Inhaltsdatenfolge aus Datei oder Web
pv_Content = oDataStreamReader.ReadToEnd 'Übertrage Dateninhalt auf pv_Content
pv_Url = URL 'Übertrage URL Adresse auf pv_Url
oDataStreamReader.Close() 'Schliesse Datenleser Onbjekt
oDataStreamReader.Dispose() 'Zerstöre Datenleser Objekt
oDataStreamReader = Nothing 'Zerstöre Datenleser Objekt
If Not oWebResponse Is Nothing Then
'Schliese die Webanfrage
oWebResponse.Close()
oWebResponse = Nothing
oWebRequest = Nothing
End If
'Fülle die Auflistungen von Tags und Tabellen
pv_Tags = fillTags()
pv_Tables = fillTables()
End Sub
'Schliesse das Objekt und leere Variabeln und Auflistungen
Public Sub Close()
pv_Content = ""
pv_Url = ""
pv_Tags.Clear()
pv_Tables.Clear()
End Sub
'fillTags füllt die Auflistungsvariable der Tags
'Rückgabewert Liste vom Datentyp Tag
Private Function fillTags() As List(Of Tag)
Dim oTag As New Tag 'Objekt eines einzelnen Tag-Abschnitt <.....>.....<
Dim oTags As New List(Of Tag) 'Objekt der Tag-Abschnitt Auflistung
Dim AttributKey As String 'Schlüssel des Attributes ....=xxxxxx
Dim AttributValue As String 'Wert des Attributes xxxx=....
Dim Hierarchy As String = "" 'Hierarchy innerhalb des HTML Inhaltes
Dim ChildItr As Long = 0 'Kinderzähler (Untergeordnete Objekte)
Dim vContent As String = Content 'Inhalt des HTMLs (Code)
Dim vTableItr As Long = 0 'Tabellenzähler
Dim vTableRowItr As Long = 0 'Tabellenzeilenzähler
Dim vTableCellItr As Long = 0 'Tabellenzellenzähler
Dim vLastHeading As String = "" 'Letzter Überschriftentext
Dim vLastClass As String = "" 'Letzter Attributwert des Attributs Class
Dim vLastID As String = "" 'Letzter Attributwert des Attributs Id
Dim vLastTableName As String = "" 'Letzter Name der Tabelle
'Entferne Störende HTML Code Inhalte vor der Tag-Abschnittermittlung
vContent = vContent.Replace(vbCr, " ").Replace(vbLf, " ") 'Zeilenumschaltungen
vContent = Regex.Replace(vContent, "(?=<!--)([\s\S]*?)-->", "") 'Kommentareblöcke
vContent = Regex.Replace(vContent, "(?=<script)([\s\S]*?)</script>", "") 'Scriptblöcke
vContent = Regex.Replace(vContent, "(?=<style)([\s\S]*?)</style>", "") 'Styleblöcke
vContent = vContent.Replace(" ", "") 'Unzulässige Textinhalte
oTag.InnerBody = False 'Befindet sich der Tag-Abschnitt im Body-Abschnittblock
'Teile den HTML Codes auf einzelene Tag-Abschnitte auf <......>......|<
For Each Tag As String In vContent.Split("<")
oTag.Content = ("<" & Tag).Trim 'Gesamtinhalt des Tag-Abschnitt
oTag.Nr = oTag.Nr + 1 'Tag-Abschnittzähler
oTag.Name = "" 'Der Tagname "<.... xxxxxxxx>xxxxxxxx|<
oTag.OuterTag = "" 'Ausserhalb des Tags <xxxxxxxx>........|<
oTag.InnerTag = "" 'Innerhalb des Tags <......>xxxxxxxxx|<
'Trenne Innerhalb und Ausserhalb des Tags ab
If Tag.IndexOf(">") > 0 Then
oTag.InnerTag = Tag.Substring(0, Tag.IndexOf(">")).Trim
oTag.OuterTag = Tag.Substring(Tag.IndexOf(">") + 1).Trim
End If
'Trenne der Names des Tags von Innerhalb des Tags ab
If oTag.InnerTag.IndexOf(Chr(32)) > 0 Then
oTag.Name = oTag.InnerTag.Substring(0, oTag.InnerTag.IndexOf(Chr(32))).Trim
oTag.InnerTag = oTag.InnerTag.Substring(oTag.InnerTag.IndexOf(Chr(32)) + 1).Trim
Else
oTag.Name = oTag.InnerTag
End If
'Ermittle die Attribute des Tagabschnitts
Dim ColAttributs As New Collection 'Temporäre Attribut Collection Objekt
'Teile diesen Variable nach jedem Leerzeichen (32) auf
For Each Attributs As String In oTag.InnerTag.Replace(Chr(34), "").Split(Chr(32))
'Finde ein Gleichzeichen
If Attributs.IndexOf("=") > 0 Then
'Trenne die Zeichenkette in Schlüssel und dessen Wert auf
AttributKey = Attributs.Substring(0, Attributs.IndexOf("="))
AttributValue = Attributs.Substring(Attributs.IndexOf("=") + 1)
'Speichere dies in die Temporären Attributs Collection und Auflistungs Objekte
ColAttributs.Add(AttributValue, AttributKey)
End If
Next Attributs
oTag.Attributs = ColAttributs 'Übertrage die Temporäre Attribut Collection in die Tag Auflistung
'Ermittle die Hierarchie und fülle dies in die Hierarchie Variable ab.
If Not oTag.Name = "" Then 'Es gibt einen Tagname
If oTag.Name = "html" Then 'Der Tag HTML ist immer eine Stammhierarchie
Hierarchy = "/html"
ElseIf oTag.Name = "head" Or oTag.Name = "body" Then 'Die Tags HEAD und BODY sind immer dem Tag HTML unterstellt.
Hierarchy = "/html/" + oTag.Name
ElseIf oTag.Name.IndexOf("/") = 0 Or oTag.Name.IndexOf("\/") = 0 Then 'Der Tag ist ein Abschliessender Tag
'</Abschschliesender Tag>
'<\/Falscher Abschliessender Tag> in codierungen
If Hierarchy.LastIndexOf("/") >= 0 Then 'Es ist ein richtiger Abschliessender Tag
'Die Variable Hierarchy, wird auf die übergeordenete Tag-Struktur zurückversetzt
Hierarchy = Hierarchy.Substring(0, Hierarchy.LastIndexOf("/"))
End If
ElseIf oTag.Name = "meta" Or oTag.Name = "link" Or oTag.Name.IndexOf("!") = 0 Or oTag.Name.IndexOf("\!") = 0 Then
'Ist der Tagname META, LINK hat er ein ! oder ein \! ist er nicht Hierarchisch abbildbar, da er sofort wieder geschlossen wird.
Else
'Die Variable Hierarchy erweitert sich um einen Untergeordneten Tag
Hierarchy = Hierarchy + "/" + oTag.Name
End If
oTag.Hierarchy = Hierarchy 'Übertrage die Variable Hierarchy in die Tag Auflistung
End If
'Wenn der Tagname BODY heisst setzte die Variable InnerBody auf Richtig ein.
If oTag.Name = "body" Then
oTag.InnerBody = True
End If
'Wenn der Tagname ein Abschliessender BODY Tag aufweisst setzte die Variable InnerBody auf Falsch ein.
If oTag.Name = "/body" Then
oTag.InnerBody = False
End If
'Befülle weitere Variablen des Tag, wenn er sich in einer Body struktur befindet.
If oTag.InnerBody Then
'Setzte und behalte denn letzte Überschriffttext, sofern er nicht leer ist
If oTag.Name Like "h*" And Not oTag.OuterTag = "" Then
If IsNumeric(oTag.Name.Substring(1, 1)) Then
vLastHeading = oTag.OuterTag
End If
End If
'Setzte und behalte den letzten Wert eines class Attributs
If oTag.Attributs.Contains("class") Then
vLastClass = oTag.Attributs("class")
End If
'Setzte und behalte den letzten Wert eines id Attributs
If oTag.Attributs.Contains("id") Then
vLastID = oTag.Attributs("id")
End If
'Setzte und behalte die Tabelleninformation
If oTag.Name = "table" Then 'Tabellen-Tag ist eröffnet
vTableItr = vTableItr + 1 'Tabellenzähler erhöhen um eins
'Tabellenname wird erweitert durch einen Untergeordneten Tabellenname
'|\Tabellename1|Tabellename2|_______ usw.
'Tabellenname = \Letzter Überschrifttext\Letzter ID-Attributwert\Letzter CLASS-Attributwert:Fortlaufende Zahl
vLastTableName = vLastTableName & "|"
vLastTableName = vLastTableName & "\" & vLastHeading.Replace("\", "").Replace("|", "")
vLastTableName = vLastTableName & "\" & vLastID.Replace("\", "").Replace("|", "")
vLastTableName = vLastTableName & "\" & vLastClass.Replace("\", "").Replace("|", "")
vLastTableName = vLastTableName & ":" & vTableItr.ToString
End If
'Wenn die Tabelle geschlossen wurde müssen die Informationen rückgesetzt werden
If oTag.Name = "/table" Then 'Tabellen-Tag ist geschlossen
If vLastTableName.LastIndexOf("|") >= 0 Then 'Die Tabelle ist eine Untertabelle
oTags.Add(oTag) 'Sichere HTML-Abschlusstag und die gesammelten Tabelleinformationen
'Setzte den Tabellenname auf das Obergeordnete Tabellenname element zurück
vLastTableName = vLastTableName.Substring(0, vLastTableName.LastIndexOf("|"))
oTag.Name = "tableclosed" 'Führe es als Künstliches Tag "tableclosed" als neuen Tag eintrag.
End If
End If
End If
'Übertrage die Parent Variabeln in die Parent Collection
Dim ColSection As New Collection 'Temporäre Parent Collection
ColSection.Add(vLastTableName, "tablename") 'Übertrag der Variable vLastTableName auf die Temporäre Section Collection
ColSection.Add(vLastHeading, "heading") 'Übertrag der Variable vLastHeading auf die Temporäre Section Collection
ColSection.Add(vLastClass, "class") 'Übertrag der Variable vLastClass auf die Temporäre Section Collection
ColSection.Add(vLastID, "id") 'Übertrag der Variable vLastID auf die Temporäre Section Collection
oTag.Sections = ColSection 'Übertrag der Temporären Section Collection auf den Tag
oTags.Add(oTag) 'Übertrag das Tag Element in die Tags Auflistung
Next Tag
'Funktionsübertrag der Tags Auflistung
Return oTags
End Function
'Fülle die Tables Auflistung abhand der Tabelleninformation aus der Tags Auflistung
'Rückgabewert: Tables Auflistung
Public Function fillTables() As List(Of Table)
Dim oTable As New Table 'Tabellen Objekt
Dim oTables As New List(Of Table) 'Tabellen Auflistung Objekt
Dim oTableRow As New TableRow 'Tabellenzeile Objekt
Dim oTableRows As New List(Of TableRow) 'Tabellenzeilen Auflistung Objekt
Dim oTableCell As New TableCell 'Tabellenzellen Objekt
Dim oTableCells As New List(Of TableCell) 'Tabellenzeilen Auflistung Objekt
Dim vTableItr As Long = 0 'Zähler der Tabelle
Dim vTableRowItr As Long = 0 'Zähler der Tabellenzeile
Dim vTableCellItr As Long = 0 'Zähler der Tabellenzelle
Dim vTableContent As String = "" 'Inhalt (Code) der Tabellenzelle
Dim vTableText As String = "" 'Inhalt (Text) der Tabellenzelle
Dim vTableName As String = "" 'Name der Tabelle
Dim vTableRowName As String = "" 'Name der Tabellenzeile
Dim vTableCellName As String = "" 'Name der Tabellenzelle
'Filtere Auflistung aufgrund des Tabellennamen und Sortiere es nach Tabellenname und der Reihenfolge der Tags
For Each TableTag In From TableTags In Tags Where Not TableTags.Sections("tablename") = "" Order By TableTags.Sections("tablename"), TableTags.Nr
Select Case TableTag.Name
Case "table" 'Der Tag ist eine Tabelle
vTableItr = vTableItr + 1 'Erhöhen des Tabellenzählers um eins
vTableRowItr = 0 'Der Zähler der Tabellenzeile wird auf null zurückgesetzt
vTableCellItr = 0 'Der Zähler der Tabellenzelle wird auf null zurückgesetzt
vTableContent = "" 'Der Inhaltsammler wird geleert
vTableText = "" 'Der Textsammler wird geleert
Case "tr" 'Der Tag ist eine Tabellenzeile
vTableRowItr = vTableRowItr + 1 'Der Zähler Tabellenzeile wird um eins erhöht
vTableCellItr = 0 'DDer Zähler der Tabellenzelle wird auf null zurückgesetzt
vTableContent = "" 'Der Inhaltsammler wird geleert
vTableText = "" 'Der Textsammler wird geleert
'Der Tabellenzeilenname (Name) wird gebildet
'Name = \Letzter ID Attribut Wert\Letzer CLASS Attribut Wert\Aktueller ITEMPROP Attribut Wert (falls Vorhanden)
vTableRowName = "\" & TableTag.Sections("id").Replace("\", "")
vTableRowName = vTableRowName & "\" & TableTag.Sections("class").Replace("\", "")
'Falls Vorhanden füge den Wert des ITEMPROP Attributs dem Namen der Tabellenzeile dazu
If TableTag.Attributs.Contains("itemprop") Then
vTableRowName = vTableRowName & "\" & TableTag.Attributs("itemprop").Replace("\", "")
End If
Case "td" 'Der Tag ist eine Tabellenzelle
vTableCellItr = vTableCellItr + 1 'Der Zähler der Tabellenzelle wird um eins erhöht
vTableContent = "" 'Der Inhaltsammler wird geleert
vTableText = "" 'Der Textsammler wird geleert
'Der Tabellenzellenname (Name) wird gebildet
'Name = \Letzter ID Attribut Wert\Letzer CLASS Attribut Wert\Aktueller ITEMPROP Attribut Wert (falls Vorhanden)
vTableCellName = "\" & TableTag.Sections("id").Replace("\", "")
vTableCellName = vTableCellName & "\" & TableTag.Sections("class").Replace("\", "")
'Falls Vorhanden füge den Wert des ITEMPROP Attributs dem Namen der Tabellenzelle dazu
If TableTag.Attributs.Contains("itemprop") Then
vTableCellName = vTableCellName & "\" & TableTag.Attributs("itemprop").Replace("\", "")
End If
Case "/td" 'Der Tag ist eine Abschliessende Tabellenzelle
oTableCell.Nr = vTableCellItr 'Übertrag des Tabellenzellennummer in das Tabellenzellen Objekt
oTableCell.Name = vTableCellName 'Übertrag des Tabellenzellennamen in das Tabellenzellen Objekt
oTableCell.Content = vTableContent 'Übertrag des Inhaltsammlers in das Tabellenzellen Objekt
oTableCell.Text = vTableText.Trim 'Übertrag des Textsammlers in das Tabellenzellen Objekt
oTableCells.Add(oTableCell) 'Die Information der Tabellezelle wird in die Tabellenzellen Auflistung übernommen
Case "/tr" 'Der Tag ist eine Abschliessende Tabellezeile
oTableRow.Nr = vTableRowItr 'Übertrag des Tabellenzeilennummer in das Tabellenzeile Objekt
oTableRow.Name = vTableCellName 'Übertrag des Tabellenzeilennamen in das Tabellenzeilen Objekt
oTableRow.Cells = oTableCells 'Übertrag der Tabellenzellen Auflistung in das Tabellenzeile Objekt
oTableRows.Add(oTableRow) 'Übertrag des Tabellenzeile Objektes in die Tabellenzeile Auflistung
oTableCells = New List(Of TableCell) 'Die Tabellenzelle Auflistung wird neu eröffnet
Case "/table" 'Der Tag ist eine Abschliessende Tabelle
oTable.Name = TableTag.Sections("tablename") 'Übertrag des Tabellenname in das Tabelle Objekt
oTable.Nr = vTableItr 'Übertrag der Tabellennummer in das Tabelle Objekt
oTable.Rows = oTableRows 'Übertrag der Tabellenzeilen Auflistung in das Tabelle Objekt
oTables.Add(oTable) 'Übertrag des Tabelle Objekts in die Tabellen Auflistung
oTableRows = New List(Of TableRow) 'Die Tabellenzeile Auflistung wird neu eröffnet
End Select
vTableContent = vTableContent + TableTag.Content 'Der Inhaltsammler nimmt neue Information auf
vTableText = vTableText + TableTag.OuterTag 'Der Textsammler nimmt neue Information auf
Next TableTag
'Funktionsübergabe der Tabellen Auflistung
Return oTables
End Function
'Hohle für einen bestimmten Tag eine Auflistung
'Eingangsparameter: TagName = Name des gewünschten Tags
'Rückgabe: Auflistung der gewünschten Tags und seinen Werten
'Beispiel: divs = GetSelectTags("div")
' Stelle alle DIV-Tags als Auflistung bereit
Public Function GetSelectTags(ByVal TagName As String) As Object
Return From SelectTags In Tags Where SelectTags.Name = TagName
End Function
'Hohle zu einem bestimmten Attributschlüssel eine Auflistung
'Eingangsparameter: AttributName = Name des gewünschten Schlüssel des Attributes
'Rückgabe: Auflistung des gewünschten Attributsschlüssel und seinen Werten
'Beispiel: classes = GetSelectAttributs("class")
' Stelle alle CLASS-Attribute als Auflistung bereit
Public Function GetSelectAttributs(ByVal AttributName As String) As Object
Return From SelectTags In Tags Where SelectTags.Attributs.Contains(AttributName)
End Function
'Hohle zu einem bestimmten Tag und seinem bestimmten Attirbut eine Auflistung
'Eingabeparameter: TagName = Name des gewünschten Tags
' AttributName = Name des gewünschten Schlüssel des Attributes
'Rückgabe: Auflistung des gewünschten Attibutschlüssel innerhalb des Tags und seinen Werten
'Beispiel: GetSelectAttributsByTag("a","href")
' Stelle alle HREF-Attribute eines A-Tags als Auflistung bereit
Public Function GetSelectAttributsByTag(ByVal TagName As String, ByVal AttributName As String) As Object
Return From SelectTags In Tags Where SelectTags.Name = TagName And SelectTags.Attributs.Contains(AttributName)
End Function
'Hohle eine Auflistung von Text der von einem Bestimmten Tag und von einem bestimmten gemerkter Identität eines Abschnittes und/oder von einem Attribut erfolgt
'Eingabeparameter: TagName = Gewünschter Name des Tags
' FieldName = Der Name des Feldes (Variable/Eigenschaft), dass zurückgeholt werden wird
' SectionFilter = Kriterium des gemerkten Identität eines Abschnittes (Optional)
' AttributFilter = Filterkriterum des Attributs (Optional)
' FilterOption = Möchten wir nur den ersten gefunden Eintrag oder alle Einträge? (Optinal: Standard alle Einträge)
'Rückgabe: Auflistung des Abfrageergebniss
'Beispiel: getTextByFilter("a", "OuterTag", "caption=*Sound Mix:*", "href=*sound_mixes=*")
' Hohlt eine Auflistung der A-Tags die nach einer Überschrift "Sound Mix:" und einem HREF-Attributwert "sound_mixes=" zurück
Public Function GetSelect(ByVal TagName As String, ByVal FieldName As String, Optional ByVal SectionFilter As String = "", Optional ByVal AttributFilter As String = "", Optional ByVal FilterOption As FilterOptionEnum = FilterOptionEnum.MultiLine)
Dim r_GetSelect As New List(Of String) 'Rückgabeobjekt der Auflistung
Dim AttributFilterName As String = "" 'Name des zu filterndes Attributs
Dim AttributFilterValue As String = "" 'Wert des zu filterndes Attributs
Dim SectionFilterName As String = "" 'Name der zu filternden zu einem gemerkten Inhaltes in einem Abschnitt
Dim SectionFilterValue As String = "" 'Wert der zu filternden zu einem gemerkten Inhaltes in einem Abschnitt
Dim CollectionKey As String = "" 'Schlüssel der gewübschten Sammlung
Dim LinqSelection As Object 'Objekt der LINQ Auswertung
'Der AttributFilter ist mit einem Gleichzeichen (=) vorhanden
If AttributFilter.IndexOf("=") >= 0 Then
'Trennen von Attribut Name und Wert durch das Gleichzeichen
AttributFilterName = AttributFilter.Substring(0, AttributFilter.IndexOf("="))
AttributFilterValue = AttributFilter.Substring(AttributFilter.IndexOf("=") + 1)
End If
'Der SectionFilter ist mit einem Gleichzeichen (=) vorhanden
If SectionFilter.IndexOf("=") >= 0 Then
'Trennen von Parent Name und Wert durch das Gleichzeichen
SectionFilterName = SectionFilter.Substring(0, SectionFilter.IndexOf("="))
SectionFilterValue = SectionFilter.Substring(SectionFilter.IndexOf("=") + 1)
End If
'Der Filterzustand wird überprüft und die Abfrage Kriterien festgelegt
If AttributFilterName = "" And SectionFilterName = "" Then
'Namen der AttributFilter und SectionFilter fehlen
'Es wird nur nach dem Namen des Tag gesucht
LinqSelection = From SelectTags In Tags Where SelectTags.Name = TagName
ElseIf Not AttributFilterName = "" And SectionFilterName = "" Then
'Name des AttributFilter vorhanden, aber Name des SectionFilter fehlt
'Es wird nur nach dem Namen des Tag und des Vorhandenseins des Attributname gesucht
LinqSelection = From SelectTags In Tags Where SelectTags.Name = TagName And SelectTags.Attributs.Contains(AttributFilterName)
ElseIf AttributFilterName = "" And Not SectionFilterName = "" Then
'Name des AttribuFilter fehlt, aber Name des SectionFilter ist vorhanden
'Es wird nur nach dem Namen des Tag und des Vorhandenseins des Abschnittsname gesucht
LinqSelection = From SelectTags In Tags Where SelectTags.Name = TagName And SelectTags.Sections.Contains(SectionFilterName)
Else
'Alle Filternamen sind vorhanden
'Es wird nur nach dem Namen des Tag und des Vorhandenseins sowohl des Abschnittsname wie auch des Attributsnamen gesucht
LinqSelection = From SelectTags In Tags Where SelectTags.Name = TagName And SelectTags.Attributs.Contains(AttributFilterName) And SelectTags.Sections.Contains(SectionFilterName)
End If
'Die Abfrage wird gestartet
For Each oList In LinqSelection
'Werte analyse
If AttributFilterName = "" And SectionFilterName = "" Then
'Wenn der AttributFilterName und der SectionFilterName fehlt dann führe nur den Text eines Tags zurück
r_GetSelect.Add(Trim(oList.getValueFromObject(FieldName)))
ElseIf Not AttributFilterName = "" And SectionFilterName = "" Then
'Wenn der AttributFilterName vorhanden ist, aber der SectionFilterName nicht vorhanden ist, überprüfe ob das Attribut den bestimmten Wert hat
If oList.Attributs(AttributFilterName) Like AttributFilterValue Then
'Aufnahme in die Auflistung des Textes, wenn im Tagname und AttributFilter die Werte übereinstimmen
r_GetSelect.Add(Trim(oList.getValueFromObject(FieldName)))
End If
ElseIf AttributFilterName = "" And Not SectionFilterName = "" Then
'Wenn der AttributFilterName fehlt, aber der SectionFilterName vorhanden ist, überprüfe ob die Sectionsammlung den bestimmten Wert hat
If oList.Sections(SectionFilterName) Like SectionFilterValue Then
'Aufnahme in die Auflistung des Textes, wenn im Tagname und SectionFilter die Werte übereinstimmen
r_GetSelect.Add(Trim(oList.getValueFromObject(FieldName)))
End If
Else
'Alle Filternamen sind vorhanden. Überprüfe ob das Attribut den Attributwert und ob die Sectionsammlung einen bestimmten Wert enthält
If oList.Sections(SectionFilterName) Like SectionFilterValue And oList.Attributs(AttributFilterName) Like AttributFilterValue Then
'Aufnahme in die Auflistung des Textes, wenn im Tagname und SectionFilter und AttibutFilter die Werte übereinstimmen
r_GetSelect.Add(Trim(oList.getValueFromObject(FieldName)))
End If
End If
If FilterOption = FilterOptionEnum.SingleLine Then
If r_GetSelect.Count > 0 Then
'Wird nur der erste Treffer gewünscht, unterbreche die weiteren Auswertungen.
Exit For
End If
End If
Next oList
'Rückgabe der Auflistung an die Funktion
Return r_GetSelect
End Function
'Hohle den ersten Treffer einer getTextByFilters Auswertung in eine Zeichenkette zurück
'Gleiche Anwendung wie bei getTextByFilters
Public Function GetValueFromSelect(ByVal TagName As String, ByVal FieldName As String, Optional ByVal ParentFilter As String = "", Optional ByVal AttributFilter As String = "") As String
Dim r_GetValueFromSelect As String = ""
For Each oListItem As String In GetSelect(TagName, FieldName, ParentFilter, AttributFilter)
r_GetValueFromSelect = oListItem
Exit For
Next oListItem
Return r_GetValueFromSelect
End Function
'Hohle eine Auflistung von Tabellen zurück, die einen bestimmten Tabellennamen beinhaltet
'Eingabeparameter: Name der Tabelle
'Rückgabe: Auflistung der Tabellen
'Beispiel: getTable("|\Also Known As (AKA)\akas\subpage_data:*")
' Bringt eine Auflistung der Tabellen zurück, die mit dem Tabellennamen "|\Also Known As (AKA)\akas\subpage_data:" anfangen.
Public Function GetTable(ByVal Name As String) As Table
Dim r_GetTable As Table = Nothing 'Rückgabe Objekt der Auswertung
'Starte die Abfrage
For Each Table As Table In Tables
If Table.Name Like Name Then
'Hat er die bestimmte Tabelle gefunden, übertrage das Tabellenobjekt in die Rückantwort
r_GetTable = Table
Exit For
End If
Next
'Rückgabe der gefilterten Auswertung an die Funktion
Return r_GetTable
End Function
'Hohle den ersten Text zwischen zwei Wörtern oder Fragmenten
'Eingabeparameter: InputString = Text in der gesucht wird
' AfterPhrase = Suchbegriff vor dem gewünschten Text
' NextPhrase = Suchbegriff nach dem gewünschten Text
'Rückgabe: Der Text zwischen den zwei Wörtern als Zeichenkette
'Beispiel: getBetweenWord("Peter liest gerne Krimis und Western im Bett.","und","im") = Western
'Beispiel: getBetweenWord("c:\Schweiz\Thurgau\Orte","\","\") = Schweiz
'Beispiel: getBetweenWord("c:\Schweiz\Thurgau\Orte","Schweiz\","\") = Thurgau
Public Function getBetweenWords(ByVal InputString As String, ByVal AfterPhrase As String, ByVal NextPhrase As String) As String
Dim r_getBetweenWords As String = ""
Dim i_InputString As String = InputString
If i_InputString.IndexOf(AfterPhrase) >= 0 Then
i_InputString = i_InputString.Substring(i_InputString.IndexOf(AfterPhrase) + AfterPhrase.Length)
If i_InputString.IndexOf(NextPhrase) >= 0 Then
r_getBetweenWords = i_InputString.Substring(0, i_InputString.IndexOf(NextPhrase))
End If
End If
Return r_getBetweenWords
End Function
'Zerstören der Objekte
Private disposedValue As Boolean = False ' So ermitteln Sie überflüssige Aufrufe
' IDisposable
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
' TODO: Anderen Zustand freigeben (verwaltete Objekte).
End If
pv_Tables = Nothing
pv_Tags = Nothing
' TODO: Eigenen Zustand freigeben (nicht verwaltete Objekte).
' TODO: Große Felder auf NULL festlegen.
End If
Me.disposedValue = True
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
#Region " IDisposable Support "
' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster richtig zu implementieren.
Public Sub Dispose() Implements IDisposable.Dispose
' Ändern Sie diesen Code nicht. Fügen Sie oben in Dispose(ByVal disposing As Boolean) Bereinigungscode ein.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub<span data-mce-type="bookmark" id="mce_SELREST_start" data-mce-style="overflow:hidden;line-height:0" style="overflow:hidden;line-height:0" ></span>
#End Region
End Class
Schück VCR (Video, Computer, Reisen) 