Another 'download with progressbar' example

Share your advanced PureBasic knowledge/code with the community.
Post Reply
V2
User
User
Posts: 53
Joined: Wed Oct 15, 2003 4:53 pm

Another 'download with progressbar' example

Post 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
V2
Top
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:
Contact Karbon

Post by Karbon »

Good stuff.. The wininet stuff is handy as can be..
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Top
Max.
Enthusiast
Enthusiast
Posts: 225
Joined: Fri Apr 25, 2003 8:39 pm

Post 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?
Athlon64 3800+ · 1 GB RAM · Radeon X800 XL · Win XP Prof/SP1+IE6.0/Firefox · PB 3.94/4.0
Intel Centrino 1.4 MHz · 1.5 GB RAM · Radeon 9000 Mobility · Win XP Prof/SP2+IE6.0/Firefox · PB 3.94/4.0
Top
User avatar
Progi1984
Addict
Addict
Posts: 806
Joined: Fri Feb 25, 2005 1:01 am
Location: France > Rennes
Contact:
Contact Progi1984

Post by Progi1984 »

This code doesn't run with PB 3.94 !
Can someone help me ?
Top
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2139
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:
Contact Andre

Post 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
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Top
Straker
Enthusiast
Enthusiast
Posts: 701
Joined: Wed Apr 13, 2005 10:45 pm
Location: Idaho, USA

Post 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?
Image Image
Top
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Post by NoahPhense »

Hmm, how about pb4?

- np
Top
Straker
Enthusiast
Enthusiast
Posts: 701
Joined: Wed Apr 13, 2005 10:45 pm
Location: Idaho, USA

Post 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.
Image Image
Top
Straker
Enthusiast
Enthusiast
Posts: 701
Joined: Wed Apr 13, 2005 10:45 pm
Location: Idaho, USA

Post 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.
Image Image
Top
Post Reply

Return to “Tricks 'n' Tips”