MP4-Link holen - Lösung
17.02.2019 00:55:55
Zwenn
Hallo Silent,
um die von mir vorgeschlagene Sachlichkeit wieder einkehren zu lassen und Dir zu zeigen, dass ich es ernst damit meine, habe ich mich der Sache nun angenommen und auch eine Lösung gefunden.
Also eine XML Datei habe ich da nicht ausmachen können, in der der Link drinsteht. Vielmehr baut die Seite mindestens im Bereich des Players ihren Quellcode um, sobald man etwas macht. Die Lösung ist etwas unorthodox, aber bei mir funktioniert sie bei jedem Aufruf. Ich rufe den Player nochmal in einer eigenen Seite auf. Meine Ausgangsidee war, dass dort im Quelltext dann vielleicht der MP4-Link drinsteht. Das ist aber nicht so. Ich gehe aber trotzdem weiter über die Playerseite, weil dort das Video nicht direkt abgespielt wird und deshalb kein Werbefilm geladen wird. Ob das nun auch in der Ausgangsseite funktionieren würde habe ich nicht ausprobiert.
Ich habe es nicht geschafft eines der ganzen Player-Events auszulösen. Deshalb geht meine Lösung nur mit Sendkeys. Daher muss der IE sichtbar aufgerufen werden (sonst funktioniert Sendkeay nicht) und Du musst die Finger vom PC lassen, solange das Makro läuft bzw. der IE noch offen ist. Sendkeys haut alles an das Programm raus, das grade den Fokus hat.
Bitte lies Dir den Quelltext genau durch. Ich habe ihn gut kommentiert. Die Debug.Print Zeilen sind nur zur Veranschaulichung drin, was ja klar sein sollte. Wie man das Video dann mit der API Funktion URLDownloadToFile auf die Festplatte zieht weißt Du nehme ich an.
Achja, der IE braucht etwas, bis er wieder zu geht. Warum weiß ich nicht, aber er geht von allein zu.
Eventuell musst Du mit den Application.Wait Zeiten etwas rumspielen. Bei mir reichen jeweils die 2 Sekunden. Falls kein Link kommt, bzw. der Video-Tag zweimal gleich aussieht, erhöhe die zweite Wartezeit um ein paar Sekunden. Wenn gar kein Video-Tag gefunden wird, musst Du die erste Zeit erhöhen.
Hier ist der VBA-Code:
Option Explicit
Sub MP4URLvon4PlayersHolen()
'Für den Internetzugriff
Dim browser As Object
Dim url As String
Dim urlHilfA As String
Dim urlHilfB As String
Dim knotenStamm As Object
Dim knotenAst As Object
Dim embedAttrib As String
Dim embededURL As String
Dim mp4URL As String
'Link zur Ausgangsseite
'(HilfsURLs nur, um den undefinierten Umbruch im Forum zu verhindern)
urlHilfA = "http://www.4players.de/4players.php/tvplayer/4PlayersTV/Alle"
urlHilfB = "/4312/133758/AMD/Radeon_VII_Worlds_First_7nm_Gaming_GPU.html"
url = urlHilfA & urlHilfB
'Internet Explorer initialisieren und URL aufrufen
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True 'Muss in diesem Makro True, unten wird Sendkeys aufrufen
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
'Unter dem Video gibt es ein Eingabefeld, in dem eine Codezeile
'zu einem iFrame steht, die auch den Link zum eingebetteten Player
'selbst enthält. Diese Codezeile holen wir uns allerdings nicht, da
'das Value, also der enthaltene Text genau das ist ... Text. Kein DOM
'mehr an dieser Stelle. Da könnte man den Link zwar auch rausholen,
'aber nur über Stringoperationen.
'Den Link in der Codezeile gibt es auch in den Metatags der Seite, da
'holen wir ihn raus, weil dafür nur etwas Schleifenmechanik und der
'direkte DOM Zugriff notwendig sind.
Set knotenStamm = browser.document.getElementsByTagName("meta")
'Prüfen ob Meta-Tags eingelesen wurden
If Not knotenStamm Is Nothing Then
'Alle Metatags durchgehen
For Each knotenAst In knotenStamm
'Abfragen, ob das Attribut itemprob vorhanden ist
If knotenAst.hasAttribute("itemprop") Then
'Abfragen, ob das Attribut itemprob den Wert embedUrl enthält
embedAttrib = knotenAst.getAttribute("itemprop")
If embedAttrib = "embedUrl" Then
'Wurde das richtige Meta-Tag gefunden, den
'Link aus dem Attribut content holen
embededURL = knotenAst.getAttribute("content")
'Schleife verlassen, da der Link gefunden wurde
Exit For
End If
End If
Next knotenAst
Else
'Diese Messagebox sollte niemals erscheinen
MsgBox "Es wurden keine Meta-Tags ausgelesen"
End If
'Nur wenn ein Link ausgelesen werden konnte weitermachen
If Len(embededURL) = 0 Then
'Hinweis, dass kein Player-Link ausgelesen werden konnte
MsgBox "Der gesuchte Player-Link wurde nicht in den Meta-Tags gefunden"
Else
'Mit dem gefundenen Link den Player für sich aufrufen
browser.navigate embededURL
Do Until browser.readyState = 4: DoEvents: Loop
'Zusätzlich 2 Sekunden warten, sonst wird das
'Tag video(0) unten nicht gefunden
Application.Wait (Now + TimeSerial(0, 0, 2))
'HTML-Bereich eingrenzen, damit der Video-Tag direkt ausgelesen werden kann
Set knotenStamm = browser.document.getElementByID("tv-mediaplayer")
Set knotenAst = knotenStamm.getElementsByTagName("video")(0)
'An dieser Stelle ist der MP$-Link im Video-Tag noch nicht vorhanden
'Das kann man sich mal ansehen, indem man den Tag ausgeben lässt
Debug.Print knotenAst.outerhtml
'ACHTUNG!
'Hier wird Sendkeys verwendet. Deshalb während des Makrolaufs Finger weg
'von Maus und Tastatur. Sendkeys schickt gnadenlos alles an das Programm,
'das grade den Fokus hat. Da wir zuletzt den IE aufgerufen haben, hat
'dieser den Fokus und muss für Sendkeys an dieser Stelle nicht extra
'aktiviert werden
'Warum beim Einblenden der HTML-Tools der Video-Link mit dem ergänzt wird,
'was wir brauchen weiß ich nicht. Ich weiß dass die Leertaste (Video starten)
'nicht zum Ziel führt. Bei F12 konnte ich den Link aber immer sehen, deshalb
'bin ich überhaupt drauf gekommen es mit Sendkeys zu probieren
Application.SendKeys "{F12}", True
'Etwas warten, damit der Link vom IE in den Tag eingefügt werden kann
Application.Wait (Now + TimeSerial(0, 0, 2))
'An dieser Stelle ist der MP4-link dann im Video-Tag enthalten. Wohlgemerkt,
'es ist exakt das gleiche Video-Tag. Die Seite verändert den eigenen HTML-
'Quelltext mindestens des Players, sobald man etwas macht. Deshalb stehen
'im Inspector von Firefox die kleinen Event-Icons im entsprechenden
'Quelltextabschnitt. Zum Vergleich kann man sich den Video-Tag jetzt unter
'seiner ersten Version ausgeben lassen
Debug.Print knotenAst.outerhtml
'Den MP4-Link extrahieren
mp4URL = knotenAst.src
End If
'Weiterverarbeitung des MP4-Links, wenn vorhanden
If Len(mp4URL) > 0 Then
Debug.Print mp4URL
Else
MsgBox "Es wurde kein MP4-Link ausgelesen"
End If
'Aufräumen
browser.Quit 'dauert in diesem Makro etwas
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
End Sub
Ich hoffe das klappt bei Dir auch, denn in meinem IE wird kein Video abgespielt. Warum habe ich nicht untersucht. Das die Playerseite das Video nicht direkt abspielt weiß ich aus dem Firefox. Von dort weiß ich auch, dass dort ein Werbevideo geladen wird, sobald man Play auslöst.
Noch ein Hinweis:
Wenn das Makro beim Auslesen der Attribute itemprob und content rumzickt, ruf den Seitenquelltext im Browser auf und kopiere diese beiden Begriffe direkt von dort ins Makro. Bei mir hat die Abfrage mit hasAttribute für itemprob zuerst nicht funktioniert, obwohl ich es genau so geschrieben habe. Vielleicht sind die Zeichen anders codiert, keine Ahnung. Jedenfalls ging es, nachdem ich die Direktkopie gemacht habe.
Viele Grüße,
Zwenn