PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

HTTPS Download File

https://www.purebasic.fr/german/viewtopic.php?t=30818

Seite 2 von 4

Re: HTTPS Download File

Verfasst: 21.05.2018 18:35
von RSBasic
Zeig mal deinen Beispielcode, der nicht funktioniert.

Re: HTTPS Download File

Verfasst: 21.05.2018 19:51
von lite
Hallo Zuerst ermittle ich die Größe der Datei.
Im Code hab ich von HTTP auf HTTPS ersetzt.

PB 5.24

Code: Alles auswählen

rocedure.s GetQueryInfo(hHttpRequest.l, iInfoLevel.l) 
  lBufferLength.l=0 
  lBufferLength = 1024 
  sBuffer.s=Space(lBufferLength) 
  HttpQueryInfo_(hHttpRequest, iInfoLevel, sBuffer, @lBufferLength, 0) 
 ; Debug sBuffer
  ProcedureReturn Left(sBuffer, lBufferLength) 
EndProcedure 

Procedure _CheckUrlFileSize(URL.s) 

  res.s="" 
  tmp.s="" 
  
  OpenType.b=1 
  INTERNET_FLAG_RELOAD.l = $80000000 
  INTERNET_DEFAULT_HTTP_PORT.l = 80 
  INTERNET_SERVICE_HTTP.l = 3 
  HTTP_QUERY_STATUS_CODE.l = 19 
  HTTP_QUERY_STATUS_TEXT.l = 20 
  HTTP_QUERY_RAW_HEADERS.l = 21 
  HTTP_QUERY_RAW_HEADERS_CRLF.l = 22 

  hInet = InternetOpen_("", OpenType, #Null, #Null, 0) 
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0) 
  
  ;get Filesize 
  domain.s = ReplaceString(Left(URL,(FindString(URL, "/",8) - 1)),"https://","") 
  hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0) 
  If hInetCon > 0 
    hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"https://"+domain+"/",""), "", #Null, 0, INTERNET_FLAG_RELOAD, 0) 
    If hHttpOpenRequest > 0 
      iretval = HttpSendRequest_(hHttpOpenRequest, #Null, 0, 0, 0) 
      If iretval > 0 
        tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE) 
        If Trim(tmp) = "200" 
          tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF) 
       ;   Debug tmp
          If FindString(tmp,"Content-Length:",1)>0 
            ii.l=FindString(tmp, "Content-Length:",1) + Len("Content-Length:") 
            tmp = Mid(tmp, ii, Len(tmp)-ii) 
            myMax = Val(Trim(tmp)) 
          EndIf 
        EndIf 
      EndIf 
    EndIf 
  EndIf 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet)
  ProcedureReturn myMax
EndProcedure

Debug _CheckUrlFileSize("https://www.rsbasic.de/downloads/live_backup_system.zip")
Nach Suche im Forum bin ich heute auf eine andere Funktion gestoßen.
Die alte hat über Jahre funktioniert.

Bin jetzt Happy, das es wieder läuft.
Möchte sie nicht vorenthalten.

Code: Alles auswählen

Procedure _CheckUrlFileSizenew(URL.s) 
  FileSize=0
  FileSizet.s=Space(20)
  OpenType.b=1 
  INTERNET_FLAG_RELOAD.l = $80000000 
  INTERNET_DEFAULT_HTTP_PORT.l = 80 
  INTERNET_SERVICE_HTTP.l = 3 
  HTTP_QUERY_STATUS_CODE.l = 19 
  HTTP_QUERY_STATUS_TEXT.l = 20 
  HTTP_QUERY_RAW_HEADERS.l = 21 
  HTTP_QUERY_RAW_HEADERS_CRLF.l = 22 

  hInet = InternetOpen_("", OpenType, #Null, #Null, 0) 
 ; Debug hInet
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, 0, 0) 
 
  StateCode =Val( GetQueryInfo(hURL,  #HTTP_QUERY_STATUS_CODE) )
 ; Debug StateCode 
  If StateCode =200 
  
    Size=Len(FileSizet)
    #HTTP_QUERY_CONTENT_LENGTH=5
    HttpQueryInfo_(hURL,#HTTP_QUERY_CONTENT_LENGTH,@FileSizet,@Size,#Null)
    FileSize=Val(FileSizet)
    ; Debug FileSize
  EndIf
  
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet)
  ProcedureReturn FileSize
EndProcedure


debug _CheckUrlFileSizenew("https://www.rsbasic.de/downloads/live_backup_system.zip")

Re: HTTPS Download File

Verfasst: 23.06.2018 15:22
von lite
Hallo

Tests ergaben, mit Windows XP funktioniert der Beispielcode nicht.
Windows 7 und größer läufts.
Gibt es eine Möglichkeit das es auf Windows XP funktioniert ?

Code: Alles auswählen

InitNetwork()

If ReceiveHTTPFile("https://www.rsbasic.de/downloads/live_backup_system.zip", "D:\live_backup_system.zip")
  Debug "Success"
Else
  Debug "Failed"
EndIf

Re: HTTPS Download File

Verfasst: 23.06.2018 15:26
von RSBasic
Das ist komisch, dass die selbe Funktion unter XP nicht funktioniert. Ich teste gleich mal in der VM.

Re: HTTPS Download File

Verfasst: 23.06.2018 15:32
von RSBasic
Das kann ich bestätigen. Der Download schlägt fehl. Anscheinend arbeitet die Funktion beim HTTPS-Protokoll unter XP anders.
Das Problem besteht bei URLDownloadToFile_() ebenfalls. Ich habe es auch mit einer älteren PB-Version (5.31) getestet.

Aber da XP schon ziemlich alt ist, wäre das auch nicht so schlimm, wenn du XP nicht unterstützen würdest.

Re: HTTPS Download File

Verfasst: 23.06.2018 19:06
von Sicro
Windows XP unterstützt bei SSL-Verbindungen keine Elliptische-Kurven-Kryptografie. Diese wird inzwischen aber von vielen Webservern gefordert.
Siehe: Why can't Windows XP handle newer SSL certificate versions?

Re: HTTPS Download File

Verfasst: 23.06.2018 19:07
von RSBasic
Danke Sicro für diese Information, gut zu wissen.

Re: HTTPS Download File

Verfasst: 24.06.2018 09:52
von lite
Danke für die Infos. Das ist natülich Mist.

Gibt es eine Möglichkeit durch eine externe .dll oder lib eine solche Unterstützung hinzu zu bekommen ?

Grüße

Lite

Re: HTTPS Download File

Verfasst: 24.06.2018 10:19
von RSBasic
Ich kenne keine Lib oder DLL, die damit funktioniert. Ich habe mit dem Code GetHTTPFile von HeX0R getestet. Neuer als XP funktioniert, unter XP fehlgeschlagen.
Ich habe per VBS mit dem Objekt Microsoft.XMLHTTP versucht, die Datei herunterzuladen. Neuer als XP funktioniert, unter XP fehlgeschlagen.
Das Problem liegt nicht am Code, sondern am System dahinter. Wenn es möglich ist, müsstest du die fehlende Funktion (Elliptische-Kurven-Kryptografie) nachträglich installieren ( https://github.com/argp/ecc-lib-win32 :?: ) oder einen Server ohne HTTPS für den Download bereitstellen.
Aber warum ist ein über 16 Jahre altes Betriebssystem XP für dich so wichtig?

Re: HTTPS Download File

Verfasst: 24.06.2018 10:26
von Bisonte
RSBasic hat geschrieben:Aber warum ist ein über 16 Jahre altes Betriebssystem XP für dich so wichtig?
Ich kenne eine Menge Betriebe, die an ihrem geliebten XP festhalten... Da wird der einst angeschaffte Rechner
solange benutzt bis der absolut nicht mehr reparabel ist ;)

Es sind meist kleinere, die ihre Buchhaltung oder andere Geschäftstätigkeiten noch selbst machen.
Auch "ältere" (jenseits der 60) Kunden lassen ihre Rechner noch mit XP laufen, weil sie beinahe schon "Angst" haben was
neues lernen zu müssen.
Alle Zeiten sind UTC+02:00
Seite 2 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de