String aus HTML-Seitenquelltext auslesen

[lucy87]

Hallo,

ich bin langsam mit meinem Latein am Ende und Google hilft mir leider auch nicht mehr weiter.
Ich versuche seit zwei Tage aus dem Seitenquelltext einer Internetseite per Makro ein paar Strings automatisch auslesen zu lassen. Am besten sollte das direkt aus der Zwischenablage funktionieren.

Ich weiß welcher String vor und nach dem gewünschten String steht. Also dachte ich mir nutze ich FindPartString. Bisher ist mir das aber nur gelungen, wenn ich nicht den gesammten Quelltext kopiere sondern nur den Teil wo ungefähr meine Strings zu finden sind. Das ist natürlich nicht optimal, weil das mehr arbeit macht und ich das ganze auf mehrere Seiten anwenden möchte und das ganze dann ewig dauern würde, wenn ich erstmal per Hand die richtige Stelle finden möchte.

Kann es sein, dass es irgendwelche Zeichen gibt, die den Befehl FindPartString behindern? Könnte ich die dann mit einem anderen Befehl vorher bequem entfernen?
Meine erste Idee war dabei, dass vielleicht die Anführungszeichen und Kommas stören, weil die ja auch im Befehl FindPartString vorkommen. Allerdings hat das entfernen dieser auch nicht zum gewünschten erfolg geführt.
Vielleicht gibt es eine möglichkeit alle Zeichen außer normalem Text und Zahlen zu enfernen?

Weiteres Problem ist das Auslesen direkt aus der Zwischenablage. Ich habe dazu hier etwas gefunden:
viewtopic.php?f=1&t=4013
damit kann man die Zwischenablage in eine Variable speichern. Das funktioniert allerdings nur mit einfachem Text. Den Seitenquelltext, den mir der Firefox-HTML-Editor anzeigt kann mir dieser Befehl nicht richtig verarbeiten.

Code: Alles auswählen

Sub Main
    ClipBoardHandle = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
    DataObj = createUnoService("com.sun.star.datatransfer.XTransferable")
    DataObj = ClipBoardHandle.getContents()   
    DataTypSeq = DataObj.getTransferDataFlavors()   'Array aller Inhalte
    sClipBoardString = DataObj.getTransferData(DataTypSeq(0))
   	Dokument = thisComponent
	zielblatt = Dokument.Sheets().getByName("Tabelle1")
	ziel = zielblatt.getCellByPosition(6,6)
	ziel.string = sClipBoardString 
End Sub

dieser Code bringt mir die Fehlermeldung "Objektvariable nicht belegt" für sClipBoardString.

Das letzte Problem konnte ich zumindest umgehen indem ich Firefox angewiesen habe, den Seitenquelltext nicht mit dem Firefox-Editor anzuzeigen sondern mit dem Windows Editor. So wirklich schick ist die Lösung aber auch nicht. Gibt es da nicht eine Möglichkeit, das der Text auch so korrekt in eine variable gespeichert wird?

Ich hoffe ihr könnt mir etwas weiterhelfen. Langsam bin ich hier am durchdrehen.

lg, lucy

[lucy87]

ich glaub ich weiß nun wo das Problem mit FindPartString liegt. Der Text ist wohl zu lang. Ich bekomme nun die Fehlermeldung

Unzulläsiger Wert oder Datentyp.
Überlauf

Dann ist da so ein Pfeil im Modul Tools::Strings, welcher auf die Zeile "BigLen = Len(BigString)" zeigt.

Nur: wie verkleinere ich den Quelltext? Und wie viele Zeichen dürfen es am ende sein?
Ich hatte auch schon überlegt die Zwischenablage Zeile für Zeile auslesen zu lassen. Habe da aber nicht wirklich eine Lösung gefunden. Eine möglichkeit bei Dateien ist ja z.b. LineInput. Ich hab aber nicht verstanden wie ich mit diesem Befehl umgehen muss und er scheint auch nicht für die Zwischenablage anwendbar zu sein, oder doch?

lg, lucy

[komma4]

Am besten sollte das direkt aus der Zwischenablage funktionieren.

Da sehe ich das Hauptproblem.
Warum nicht die Seite (temporär) lokal speichern und mit LineInput arbeiten?

Ein Beispiel hat schon die F1 Hilfe, ansonsten können wir hier weiter helfen, falls da etwas hakt.


Mit FindPartString hatte ich bislang noch keine Probleme (was das Finden von bestimmten Zeichen angeht).

[lucy87]

Ok, ich hab mir Line Input nochmal genauer angeschaut und jetzt etwas besser verstanden. Hätte ich vielleicht schon etwas früher verstanden, wenn der Code in der OpenOffice Hilfe nicht einen Fehler enthielte:

Sub ExampleWorkWithAFile
Dim iNumber As Integer
Dim sLine As String
Dim aFile As String
Dim sMsg as String
aFile = "c:\daten.txt"
iNumber = Freefile
Open aFile For Output As #iNumber
Print #iNumber, "Das ist eine Zeile Text"
Print #iNumber, "Das ist eine weitere Zeile Text"
Close #iNumber
iNumber = Freefile
Open aFile For Input As iNumber
While not eof(iNumber)
Line Input #iNumber, sLine
If sLine <>"" then
sMsg = sMsg & sZeile & chr(13)
end if
wend
Close #iNumber
Msgbox sMsg
End Sub

Kann ich das irgendwo melden, damit das korrigiert wird?

Was ich bei dem Code noch nicht verstehe ist, wozu dieser Befehl ist:

Code: Alles auswählen

If sLine <> "" then
...
end if

Der scheint überhaupt keinen einfluss auf das Ergebnis zu haben. Es bleibt zumindest das selbe wenn ich diese Zeilen mit ' auskommentiere.
Edit: jetzt habe ich es verstanden. Es prüft ob die Zeile leer ist.

Bis jetzt habe ich folgendes als Code, was aber noch nicht richtig funktioniert:

Code: Alles auswählen

Sub ExampleWorkWithAFile
	Dim iNumber As Integer
	Dim sLine As String
	Dim aFile As String
	Dim Str as String
' Lade Tools:
	Globalscope.BasicLibraries.LoadLibrary("Tools")
' Hier soll gearbeitet werden:
	dokument = thisComponent
	tabelle1 = dokument.Sheets().getByName("Tabelle1")
'-------------------------------------------
	aFile = "d:\daten.txt"		' Datei in die geschrieben werden soll
	iNumber = Freefile
	Open aFile For Output As #iNumber 'öffnet die Datei zum Schreiben
		Print #iNumber, "anfang1 hallo ende"
		Print #iNumber, "anfang2 halli ende"
		Print #iNumber, "anfang3 olla ende"
	Close #iNumber
	iNumber = Freefile
	Open aFile For Input As iNumber
	While not eof(iNumber)
	Line Input #iNumber, sLine
	If sLine <>"" then
	For i=1 to 3
	Str = FindPartString(sLine, "anfang" & i, "ende",1)
	ziel = tabelle1.getCellByPosition(3,i)
	ziel.String = Trim(Str)
	Next i
	end if
	wend
	Close #iNumber
End Sub

Was es eigentlich tun soll ist, dass in der Zelle (3,1) hallo steht, in der Zelle (3,2) halli und in der Zelle (3,3) olla.
Was es aber tut ist nur in die Zelle (3,3) olla zu schreiben.

Da habe ich wohl noch irgendetwas falsch gemacht. Ich weiß aber nicht wie es richtig gehen soll.

lg, lucy

[Stephan]

Kann ich das irgendwo melden, damit das korrigiert wird?

ja, siehe:
http://www.openoffice.org/de/dev/pre_submission_de.html

Was ich bei dem Code noch nicht verstehe ist, wozu dieser Befehl ist:

damit wird verhindert das die Code-Zeile:

Code: Alles auswählen

sMsg = sMsg & sZeile & chr(13)

abgearbeitet wird, wenn die aktuell eingelesene Zeile eine leere Zeile ist. In Folge werden in:

Code: Alles auswählen

Msgbox sMsg

leere Zeilen auch nicht angezeigt.

Ich weiß aber nicht wie es richtig gehen soll.

dann gehe den Code zeilenweise durch und überlege was passiert:

Code: Alles auswählen

If sLine <>"" then

wenn das das erste mal der Fall ist ist sLine gleich "anfang1 hallo ende"

nun wird ausgeführt:

Code: Alles auswählen

For i=1 to 3
   Str = FindPartString(sLine, "anfang" & i, "ende",1)
   ziel = tabelle1.getCellByPosition(3,i)
   ziel.String = Trim(Str)
Next i

was aber eigentlich garnicht ausgeführt werden soll, da ja für die erste Zeile garnicht i=2 und i=3 benutzt werden soll, sondern nur i=1

das gleiche Spiel wiederholt sich für die anderen 2 Zeilen und somit werden nacheinander folgende Werte in die Zellen geschrieben und überschreiben dabei jeweils den Vorgängerwert so das am Ende nur noch eine Zelle einen Inhalt hat:

1.Durchlauf:

(3,1): hallo
(3,2): "" (also nichts)
(3,3): "" (also nichts)

2.Durchlauf:

(3,1): "" (also wird hallo überschrieben durch nichts)
(3,2): halli
(3,3): "" (also nichts)

3.Durchlauf:

(3,1): "" (also nichts)
(3,2): "" (also wird halli überschrieben durch nichts)
(3,3): olla


Der einfachst mögliche und funktionierende Code ist im Konkreten also:

Code: Alles auswählen

i = 0
While not eof(iNumber)
   Line Input #iNumber, sLine
   If sLine <>"" then
   i = i + 1
   Str = FindPartString(sLine, "anfang" & i, "ende",1)
   ziel = tabelle1.getCellByPosition(3,i)
   ziel.String = Trim(Str)
   end if
wend

dieser Code funktioniert natürlich nur im Konkreten, nicht bei beliebigen Dateien, d.h. nicht für Dateien in denen mehr als die gewünschten 3 Zeilen vorkommen, dazu müßte der Code erweitert werden.



Gruß
Stephan

[lucy87]

Ich weiß aber nicht wie es richtig gehen soll.

dann gehe den Code zeilenweise durch und überlege was passiert:

Code: Alles auswählen

If sLine <>"" then

wenn das das erste mal der Fall ist ist sLine gleich "anfang1 hallo ende"

nun wird ausgeführt:

Code: Alles auswählen

For i=1 to 3
   Str = FindPartString(sLine, "anfang" & i, "ende",1)
   ziel = tabelle1.getCellByPosition(3,i)
   ziel.String = Trim(Str)
Next i

was aber eigentlich garnicht ausgeführt werden soll, da ja für die erste Zeile garnicht i=2 und i=3 benutzt werden soll, sondern nur i=1

das gleiche Spiel wiederholt sich für die anderen 2 Zeilen und somit werden nacheinander folgende Werte in die Zellen geschrieben und überschreiben dabei jeweils den Vorgängerwert so das am Ende nur noch eine Zelle einen Inhalt hat:

1.Durchlauf:

(3,1): hallo
(3,2): "" (also nichts)
(3,3): "" (also nichts)

2.Durchlauf:

(3,1): "" (also wird hallo überschrieben durch nichts)
(3,2): halli
(3,3): "" (also nichts)

3.Durchlauf:

(3,1): "" (also nichts)
(3,2): "" (also wird halli überschrieben durch nichts)
(3,3): olla

Ahh, so habe ich das bisher gar nicht gesehen. muss wohl etwas mehr wie openoffice denken.
deine erklärung hat mich auf den richtigen weg gebracht. ist nur eine kleine veränderung damit mein code wie gewünscht funktioniert:

Code: Alles auswählen

	While not eof(iNumber)
	Line Input #iNumber, sLine
	If sLine <>"" then
	For i=1 to 3
	Str = FindPartString(sLine, "anfang" & i, "ende",1)
	if Str <> "" then
	ziel = tabelle1.getCellByPosition(3,i)
	ziel.String = Trim(Str)
	end if
	Next i
	end if
	wend

Wenn er den gewünschten String nicht findet schreibt er nun einfach nichts mehr in die zelle und kann so nicht das vorherige löschen.

für mein jetztiges beispiel funktioniert es und auch wenn es noch etwas erweitert wird. muss mal später schauen, ob es dann auch für den ernstfall richtig funktioniert.

Danke erstmal bis hierhin für die Hilfe. dadurch bin ich in wenigen Stunden weiter gekommen als in den ganzen letzten zwei tagen.

lg, lucy

[lucy87]

Update:
bis jetzt funktioniert der Code perfekt. Überträgt mir alle Daten aus dem Quelltext einwandfrei.

Erst war das etwas langsam, weil es ja für jede Zeile des Quelltextes erstmal nach anfang1, anfang2, anfang3 usw. suchen musste. wenn die Zahlen bis 100 raufgehen und danach sogar noch andere Strings auf die selbe Art gesucht werden müssen, dann kann das schon ordentlich dauern.

also habe ich diese Bedingung geändert:

Code: Alles auswählen

If sLine <>"" then

stattdessen steht da nun:

Code: Alles auswählen

bedingung = InStr (sLine, "anfang")
If bedingung > 0 then

nun führt es den Befehl FindPartString nur noch aus, wenn es denn überhaupt das Wort anfang gefunden hat. Damit geht es total fix.

Jetzt kann ich mir aber wirklich sehr stolz auf die Schulter klopfen.

lg, amily

[DPunch]

Servus

ich glaub ich weiß nun wo das Problem mit FindPartString liegt. Der Text ist wohl zu lang. Ich bekomme nun die Fehlermeldung (...)

"BigLen" ist in der Funktion FindPartString als Integer deklariert und kann daher eine maximale Textlänge von 32.767 Zeichen verarbeiten.
Du könntest mal schauen, ob es Dir reicht, die Deklaration von

Code: Alles auswählen

Dim BigLen%

in

Code: Alles auswählen

Dim BigLen as Double

zu ändern.

Davon ab hier eine Alternative zum Auslesen des Quellcodes.
Im Beispielfall habe ich mal den Quellcode dieser Seite genommen, dort wird die Besucherzahl in HTML folgendermassen dargestellt:

<p>Insgesamt sind <strong>71</strong> Besucher online: 3 registrierte, 1 unsichtbarer und 67 Gäste (basierend auf den aktiven Besuchern der letzten 5 Minuten)<br />Der Besucherrekord liegt be(......)

Wenn ich das weiss und auch weiss, was ich haben will, kann ich mir den gewünschten Teil ausschneiden.

Code: Alles auswählen

Sub readHTMLSourcecode
	oFileAccess = CreateUNOService ("com.sun.star.ucb.SimpleFileAccess")
	oInpDataStream = CreateUNOService ("com.sun.star.io.TextInputStream")
	sURL = "http://de.openoffice.info/index.php"
	oInpDataStream.setInputStream(oFileAccess.openFileRead(sUrl))
	sSearchString = "<p>Insgesamt sind <strong>"
	Do While NOT oInpDataStream.isEOF
		s = oInpDataStream.readLine
		nPos = Instr(s,sSearchString)
		If nPos > 0 Then
			s = Replace(s,sSearchString,"")
			s = Replace(s,Chr(9),"")
			nPos = Instr(s,"</strong>")
			If nPos > 0 Then
				MsgBox "Es sind " & Mid(s,1,nPos-1) & " Besucher auf " & sURL
				Exit Do
			End If
		End If
	Loop
	oInpDataStream.closeInput	
End Sub