sarekhl
Goto Top

Datei aus dem Web mit VisualBasic 6 öffnen

Hallo zusammen,

ich habe hier ein VB6-Programm, welches monatlich automatisch eine bestimmte PDF-Datei aus dem Web (z.B. http://www.erzbistum-hamburg.de/_amtsblatt/2016/201611.pdf) herunterladen und speichern soll. Die Kernroutine dieser Funktion, das Öffnen der URL, scheint aber seit einem knappen Jahr nicht mehr zu funktionieren. Habt Ihr eine Ahnung, warum - und wie es stattdessen gehen kann?


Public Function OpenURL( _
    ByVal URL As String, _
    Optional ByVal OpenType As InternetOpenType = IOTPreconfig _
  ) As String
  Const INET_RELOAD = &H80000000
  Dim hInet As Long
  Dim hURL As Long
  Dim Buffer As String * 2048
  Dim Bytes As Long
  
  'Inet-Connection öffnen:  
  hInet = InternetOpenA( _
      "VB-Tec:INET", OpenType, _  
      vbNullString, vbNullString, 0)
  hURL = InternetOpenUrlA( _
      hInet, URL, vbNullString, 0, INET_RELOAD, 0)
  
  'Daten sammeln:  
  Do
    InternetReadFile hURL, Buffer, Len(Buffer), Bytes
    If Bytes = 0 Then Exit Do
    OpenURL = OpenURL & Left$(Buffer, Bytes)
  Loop
  
  'Inet-Connection schließen:  
  InternetCloseHandle hURL
  InternetCloseHandle hInet
End Function


Danke im Voraus,
Sarek \\//_

Content-Key: 326161

Url: https://administrator.de/contentid/326161

Ausgedruckt am: 19.03.2024 um 02:03 Uhr

Mitglied: H41mSh1C0R
H41mSh1C0R 12.01.2017 um 07:20:56 Uhr
Goto Top
Moin,

was kommt denn als Fehler?

VG
Mitglied: SarekHL
SarekHL 12.01.2017 um 07:29:44 Uhr
Goto Top
Zitat von @H41mSh1C0R:

was kommt denn als Fehler?

Keiner, aber der Wert Bytes, der in Zeile 21 abgefragt wird, ist dann 0, so dass die Routine abgebrochen wird. Frag mich nicht, welche Funktion diese Variable hat, ich habe die Funktion von dieser Seite. Und bis Februar 2016 hat alles funktioniert, also die Deklarationen und so weiter sind alle in Ordnung ...
Mitglied: Clijsters
Clijsters 12.01.2017 um 08:55:01 Uhr
Goto Top
Hallo Sarek,

Ist dir klar, dass...
  • die URL, die du angegeben hast, auf eine HTTPS://-Version der URL weiterleitet? (Ich könnte mir vorstellen, hier liegt der Wurm)
  • Es quasi unzählig viele Programme gibt, die die von dir geforderte Funktionalität erfüllen?
  • Windows(-Anwendungen) (VB6/VS lässt mich davon ausgehen) keine Probleme mit http-Pfaden haben, was das öffnen / kopieren von Dateien angeht

Wenn du unbedingt dieses Programm zum Herunterladen deiner Datei verwenden möchtest, solltest du ein Analysetool wie Wireshark zu Rate ziehen. Ich denke, das bringt Licht in's dunkle.

Wenn nicht:
Invoke-WebRequest "http://www.erzbistum-hamburg.de/_amtsblatt/2016/201611.pdf" -OutFile .\test.pdf  
hat in meiner Windows 10 PowerShell sofort zum gewünschten Ergebnis geführt.
curl "http://www.erzbistum-hamburg.de/_amtsblatt/2016/201611.pdf" -o .\test.pdf  
funktioniert sogar sowohl dort, als auch woanders ;)

Beste Grüße
Dominique
Mitglied: 131381
131381 12.01.2017 aktualisiert um 10:07:45 Uhr
Goto Top
Diesen VBS-Code kannst du dir mit minimalen Anpassungen an VB auch nehmen:
Function DownloadFile(ByVal strURL As String, ByVal strTarget As String) As Boolean
    On Error GoTo Error
    Dim objhttp As Object, objStream As Object
    Set objhttp = CreateObject("Microsoft.XMLHTTP")  
    Set objStream = CreateObject("ADODB.Stream")  
    With objhttp
        .Open "GET", strURL, False  
        .send
        If .Status = 200 Then
            objStream.Open
            objStream.Type = 1
            objStream.Write .responseBody
            objStream.SaveToFile strTarget, 2 'Overwrite target  
            objStream.Close
            DownloadFile = True
        Else
            DownloadFile = False
        End If
    End With
    Exit Function
Error:
    DownloadFile = False
End Function
Gruß mik
Mitglied: runasservice
runasservice 12.01.2017 aktualisiert um 13:59:56 Uhr
Goto Top
Deinen Code solltest Du wie folgt ändern:

 
Dim breturn as Long
  '  
  'Daten sammeln:   
  '  
 Do
     breturn = InternetReadFile(hURL, Buffer, Len(Buffer), Bytes)
     OpenURL = OpenURL & Left$(Buffer, Bytes)
    '  
 Loop Until Bytes < Len(Buffer) Or breturn = 0
'  
if breturn = 0 then
   'GetLastError abfragen  
endif

MfG
Mitglied: SarekHL
SarekHL 16.01.2017 um 17:51:42 Uhr
Goto Top
Hallo runasservice ..

Dein Codevorschlag funktioniert nicht. Bei dieser Zeile:

breturn = InternetReadFile(hURL, Buffer, Len(Buffer), Bytes)

beschwert VB sich, dass dort eine Funktion oder eine Variable erwartet wird. InternetReadFile wird ja (gemäß dem Beispiel hier) als Sub deklariert. Ändere ich das, mache ich also aus dem

Private Declare Sub InternetReadFile Lib "wininet.dll" ( _  
    ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)

ein

Private Declare Function InternetReadFile Lib "wininet.dll" ( _  
    ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)

meldet er einen Laufzeitfeler 49: Falsche DLL-Aufrufkonvention.
Mitglied: 131381
131381 16.01.2017 aktualisiert um 18:29:59 Uhr
Goto Top
meldet er einen Laufzeitfeler 49: Falsche DLL-Aufrufkonvention.
Ich schätze weil der Rückgabetyp der Funktion (Boolean) nicht deklariert wurde (as Boolean).
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) as Boolean  
Alternative siehe oben.
Mitglied: SarekHL
SarekHL 17.01.2017 um 22:37:07 Uhr
Goto Top
Zitat von @131381:

Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) as Boolean

Ja, dann kommt keine Fehlermeldung mehr - er lädt aber auch nichts herunter face-confused-alt


Alternative siehe oben.

Ja, aber da sagtest Du ja, dass ich da was anpassen müsste, damit es unter VB6 läuft. Dazu brauche ich mehr Ruhe, sowas schüttel ich nicht aus dem Ärmel.
Mitglied: runasservice
runasservice 18.01.2017 aktualisiert um 11:56:44 Uhr
Goto Top
Für VB6:
Private Declare Function InternetReadFile Lib "wininet" _  
        (ByVal hFile As Long, ByVal sBuffer As String, ByVal _
        lNumBytesToRead As Long, lNumberOfBytesRead As Long) _
        As Integer

und für die genaue Fehlermeldung:

Private Declare Function GetLastError Lib "kernel32" () As Long  

Wenn Du dir das gedönse mit GetlastError sparen möchstest sollte auch ein:

debug.print err.LastDllError

reichen.Wir haben noch einige tausend Anwender die jeden Tag damit Ihre Dateien per HTTP downloaden (VB6 ist einfach nicht tot zu bekommen, nur weil die Anwender keine Updates auf neuere Versionen wollen - Auch hier ist Geiz geil).

MfG