PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Another 'download with progressbar' example

https://www.purebasic.fr/english/viewtopic.php?t=8331

Page 1 of 1

Another 'download with progressbar' example

Posted: Thu Nov 13, 2003 5:42 pm
by V2
Code updated For 5.20+

Hope it's usefull - enjoy...

Code: Select all

Enumeration
  #Window
  #cmdStart
  #progressbar
  #Frame
  #cmdExit
  #Label
  #Label2
  #URL
EndEnumeration


Procedure.s Reverse(s.s)
  O.s=Mid(s,Len(s),1)
  P=Len(s)-1
  While P>0
    O.s=O+Mid(s,P,1)
    P=P-1
  Wend
  ProcedureReturn O
EndProcedure

Procedure SetProgressbarRange(Gadget, Minimum, Maximum)
  ;? SetProgressbarRange(#progressbar, 0, 100)
  PBM_SETRANGE32 = $400 + 6
  SendMessage_(GadgetID(Gadget), PBM_SETRANGE32, Minimum, Maximum)
EndProcedure

Procedure DoEvents()
  msg.MSG
  If PeekMessage_(msg,0,0,0,1)
    TranslateMessage_(msg)
    DispatchMessage_(msg)
  Else
    Sleep_(1)
  EndIf
EndProcedure

Procedure.s GetQueryInfo(hHttpRequest, iInfoLevel)
  lBufferLength=0
  lBufferLength = 1024
  sBuffer.s=Space(lBufferLength)
  HttpQueryInfo_(hHttpRequest, iInfoLevel, sBuffer, @lBufferLength, 0)
  ProcedureReturn Left(sBuffer, lBufferLength)
EndProcedure

Procedure UrlToFileWithProgress(myFile.s, URL.s)
  isLoop.b=1
  Bytes=0
  fBytes=0
  Buffer=4096
  res.s=""
  tmp.s=""
  
  OpenType.b=1
  INTERNET_FLAG_RELOAD = $80000000
  INTERNET_DEFAULT_HTTP_PORT = 80
  INTERNET_SERVICE_HTTP = 3
  HTTP_QUERY_STATUS_CODE = 19
  HTTP_QUERY_STATUS_TEXT = 20
  HTTP_QUERY_RAW_HEADERS = 21
  HTTP_QUERY_RAW_HEADERS_CRLF = 22
  
  m0 = AllocateMemory(Buffer)
  ;       UseMemory(0)
  
  Result = CreateFile(1, myFile)
  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)),"http://","")
  hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0)
  If hInetCon > 0
    hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"http://"+domain+"/",""), "http/1.1", #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)
          If FindString(tmp,"Content-Length:",1)>0
            ii=FindString(tmp, "Content-Length:",1) + Len("Content-Length:")
            tmp = Mid(tmp, ii, Len(tmp)-ii)
            myMax = Val(Trim(tmp))
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  
  SetGadgetText(#Label, "Filesize: " + Str(myMax))
  SetProgressbarRange(#progressbar,0,myMax)
  
  ;start downloading
  Repeat
    InternetReadFile_(hURL, m0, Buffer, @Bytes)
    If Bytes = 0
      isLoop=0
    Else
      fBytes=fBytes+Bytes
      SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes))
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf
      ;           UseFile(1)
      WriteData(1,m0, Bytes)
    EndIf
    DoEvents()
  Until isLoop=0
  InternetCloseHandle_(hURL)
  InternetCloseHandle_(hInet)
  SetGadgetState(#progressbar, 0)
  CloseFile(1)   
  FreeMemory(m0)
EndProcedure



If OpenWindow(#Window, 0, 0, 400, 175 , "Download with Progress", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
  
  
  StringGadget(#URL, 10, 10, 380, 20, "http://wwwargeformatphotography.info/qtluong/sequoias.big.jpeg")
  ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth)
  TextGadget(#Label, 10, 80,300,20,"Filesize:")
  TextGadget(#Label2, 10, 100,300,20,"Bytes received:")
  FrameGadget(#Frame, -10, 120, 420, 110, "")
  ButtonGadget(#cmdExit, 160, 140, 110, 25, "Exit")
  ButtonGadget(#cmdStart, 280, 140, 110, 25, "Start", #PB_Button_Default)
  
  
  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_Gadget   
      Select EventGadget()
        Case #cmdStart
          
          URL.s = GetGadgetText(#URL)
          
          ;get filename (checking /)
          myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1)
          ;request path
          myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:\")
          
          UrlToFileWithProgress(myFolder + myFile, URL)
        Case #cmdExit
          End
      EndSelect
    EndIf              
  Until EventID = #PB_Event_CloseWindow
EndIf
End

Posted: Thu Nov 13, 2003 6:42 pm
by Karbon
Good stuff.. The wininet stuff is handy as can be..

Posted: Fri Nov 14, 2003 6:40 am
by Max.
Very nice! Was looking for something like this 2 days ago, but was unlucky with other snippets from forums! :D

BTW, any chance to get the size of pages from redirected URLs?

Like http://www.google.de/ or (worse) http://forums.delphiforums.com/n/mb/mes ... msg=5121.1 for example?

Posted: Sun Jan 15, 2006 9:52 pm
by Progi1984
This code doesn't run with PB 3.94 !
Can someone help me ?

Posted: Sun Jan 15, 2006 10:14 pm
by Andre
Updated code:

Code: Select all

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8331&highlight= 
; Author: V2  (updated for PB3.94 by Andre)
; Date: 13. November 2003 

Enumeration  
  #Window  
  #cmdStart  
  #progressbar  
  #Frame  
  #cmdExit  
  #Label  
  #Label2  
  #URL  
EndEnumeration  


Procedure.s Reverse(s.s)  
  O.s=Mid(s,Len(s),1)  
  P=Len(s)-1  
  While P>0  
    O.s=O+Mid(s,P,1)  
    P=P-1  
  Wend  
  ProcedureReturn O  
EndProcedure  

Procedure SetProgressbarRange(Gadget.l, Minimum.l, Maximum.l)  
  ;? SetProgressbarRange(#progressbar, 0, 100)  
  PBM_SETRANGE32 = $400 + 6  
  SendMessage_(GadgetID(Gadget), PBM_SETRANGE32, Minimum, Maximum)  
EndProcedure  

Procedure DOEVENTS_()  
  msg.MSG  
  If PeekMessage_(msg,0,0,0,1)  
    TranslateMessage_(msg)  
    DispatchMessage_(msg)  
  Else  
    Sleep_(1)  
  EndIf  
EndProcedure  

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

Procedure UrlToFileWithProgress(myFile.s, URL.s)  
  isLoop.b=1  
  Bytes.l=0  
  fBytes.l=0  
  Buffer.l=4096  
  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  

  mem.l = AllocateMemory(Buffer)  
  

  Result = CreateFile(1, myFile)  
  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)),"http://","")  
  hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0)  
  If hInetCon > 0  
    hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"http://"+domain+"/",""), "http/1.1", #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)  
          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  
   
  SetGadgetText(#Label, "Filesize: " + Str(myMax))  
  SetProgressbarRange(#progressbar,0,myMax)  
   
  ;start downloading  
  Repeat  
    InternetReadFile_(hURL, mem.l, Buffer, @Bytes)  
    If Bytes = 0  
      isLoop=0  
    Else  
      fBytes=fBytes+Bytes  
        SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes))  
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf  
      UseFile(1)  
      WriteData(mem.l, Bytes)  
    EndIf  
      DOEVENTS_()  
  Until isLoop=0  
  InternetCloseHandle_(hURL)  
  InternetCloseHandle_(hInet)  
  SetGadgetState(#progressbar, 0)  
  CloseFile(1)     
  FreeMemory(0)  
EndProcedure  



If OpenWindow(#Window, 0, 0, 400, 175, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Download with Progress")  

  If CreateGadgetList(WindowID())  
      StringGadget(#URL, 10, 10, 380, 20, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg")  
      ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth)  
      TextGadget(#Label, 10, 80,300,20,"Filesize:")  
      TextGadget(#Label2, 10, 100,300,20,"Bytes received:")  
      Frame3DGadget(#Frame, -10, 120, 420, 110, "")  
      ButtonGadget(#cmdExit, 160, 140, 110, 25, "Exit")  
      ButtonGadget(#cmdStart, 280, 140, 110, 25, "Start", #PB_Button_Default)  
  EndIf  
         
  Repeat  
    EventID.l = WaitWindowEvent()  
    If EventID = #PB_EventGadget     
      Select EventGadgetID()  
        Case #cmdStart  
         
          URL.s = GetGadgetText(#URL)  
           
          ;get filename (checking /)  
          myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1)  
          ;request path  
          myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:\")  

          UrlToFileWithProgress(myFolder + myFile, URL)  
        Case #cmdExit  
          End  
      EndSelect  
    EndIf                
  Until EventID = #PB_EventCloseWindow  
EndIf  
End

Posted: Thu Jun 08, 2006 11:23 pm
by Straker
Help! I am using the above code, but there seems to be a MAJOR bottleneck at InternetOpenUrl_ . I added ElapsedMilliseconds before each of the WinInet functions ran debug to find the problem. Clearly InternetOpenURL is the issue:

Code: Select all

Debug output:
--------------
InternetOpen :0
InternetOpenURL :24125
InternetConnect :0
HttpOpenRequest :0
HttpSendRequest :3016
--------------
InternetOpen :0
InternetOpenURL :36719
InternetConnect :0
HttpOpenRequest :0
HttpSendRequest :1078
--------------
InternetOpen :0
InternetOpenURL :7922
InternetConnect :0
HttpOpenRequest :0
HttpSendRequest :1625
Does anyone know how to speed this up?

Posted: Thu Jun 08, 2006 11:56 pm
by NoahPhense
Hmm, how about pb4?

- np

Posted: Fri Jun 09, 2006 12:57 am
by Straker
NoahPhense wrote:Hmm, how about pb4?

- np
Nope. Doesn't matter - the bottleneck is during the external call of InternetOpenUrl_

BTW - the code above - updated for 4.0 - can be found in this thread.

Posted: Fri Jun 09, 2006 6:36 pm
by Straker
Update: Turns out to be my machine. I tried this on a different one last night and there was no delay whatsoever, so maybe my WinInet.dll is outdated (W2K vs WXP), or maybe a virus/spyware is intercepting the call.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited