Download with progressbar

[effis]

i've seen old codes to that but it doesn't feet PB 4.xx
Someone maybe has such a code?
thanks

[Rescator]

Calculation: http://www.purebasic.fr/english/viewtop ... 12&t=28763
Vista/7 taskbar progress support: http://www.purebasic.fr/english/viewtop ... 12&t=40806

[effis]

Thanks but i dont know how to combine this

[Vitor_Boss®]

Try this:

Code: Select all

Removed and posted above

[effis]

doesn't work or i didnt understand?
can u give me an exemple?

thanks anyway

[TerryHough]

What type of download?

• HTTP
  FTP
  PB Network

There are examples of each type on the forum. Each type is handled differently. Specify a type and maybe someone can help you.

[Vitor_Boss®]

doesn't work or i didnt understand?
can u give me an exemple?

thanks anyway

The first returned number is the Memory position and the second is the Length separated by a comment like "MemoryPosition;Length".

Code: Select all

  URL = "http://centrumse.googlecode.com/svn/trunk/Library/k850_r1fa035.lib.vkp"
  Local = "C:\k850_r1fa035.lib.vkp"
  File = ReceiveHTTPMemory(URL)
  If Left(File, 5) <> "Error"
    File = PeekS(Val(Left(File,FindString(File,";",1)-1)) , Val(Mid(File,FindString(File,";",1)+1)), #PB_Ascii)
    CreateFile(0, Local)
    WriteData(0, @File, Len(File))
    CloseFile(0)
  EndIf  

[effis]

you mean this?

Code: Select all

InitNetwork()

Procedure.s ReceiveHTTPMemory(URL.s, BufferSize = 4096, Timeout = 5000)
	;====================== ReceiveHTTPMemory ============================
	;  Author:                Thomas Schulz (ts-soft)
	;  Date:                  January 13, 2011
	;  Moded by:          Vitor_Boss
	;  Date:                  February 07, 2011  
	;  Target OS:             All
	;  Target Compiler:       Requires PureBasic 4.xx
	;=====================================================================
	
	Protected Connection, Time, Time2, Event, Size, Size2, SizeAll, pos, FileSize = 1
	Protected.s Server, s, z
	Protected *Mem, *Buffer, *Mem2
	Size = 1

	If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
	Server = GetURLPart(URL, #PB_URL_Site)
	If Not Server : ProcedureReturn "Error Invalid server name": EndIf
	Connection = OpenNetworkConnection(Server, 80, #PB_Network_TCP)
	If Not Connection : ProcedureReturn "Error Not Connected": EndIf
	If BufferSize <= 0 : BufferSize = 4096 : EndIf
	*Buffer = AllocateMemory(BufferSize)
	If Not *Buffer : ProcedureReturn "Error can't allocate memory": EndIf

	SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #CRLF$ + #CRLF$)
	Time = ElapsedMilliseconds()
	Repeat
		Event = NetworkClientEvent(Connection)
		If Event = #PB_NetworkEvent_Data
			Repeat
				Size = ReceiveNetworkData(Connection, *Buffer, BufferSize)
				If Size > 0
					;{ By Vitor_Boss
					If FileSize = 1 ; Header not Readed yet
						s = PeekS(*Buffer, Size, #PB_Ascii)
						If FindString(s, "HTTP/1.0 ", 1)
								z = Trim(Mid(s, 10 , 3))
								If z <> "200"
									If z = "404" : CloseNetworkConnection(Connection) : EndIf
									ProcedureReturn "Error " + z
								EndIf
								z = Trim(Mid(s, FindString(s, "Content-Length:", 1) + 15, (FindString(s, "Content-Type:", 1) - 2) - (FindString(s, "Content-Length:", 1) + 15)))
								FileSize = Val(z)
								; FileSize is the estimated download size
								*Mem = ReAllocateMemory(*Mem, FileSize)
							Else
								Goto binfile
						EndIf
					Else
					binfile:
					Time = ElapsedMilliseconds()
					SizeAll + Size
					If *Mem
						CopyMemory(*Buffer, *Mem + (SizeAll - Size), Size)
					Else
						CloseNetworkConnection(Connection)
						FreeMemory(*Buffer)
						ProcedureReturn "Error header not loaded"
					EndIf
					; SizeAll is the current download status
				EndIf  
				;}
			EndIf
			Time2 = ElapsedMilliseconds() - Time
			Until Time2 > Timeout Or SizeAll >= FileSize
		EndIf
		Time2 = ElapsedMilliseconds() - Time
	Until Time2 > Timeout Or SizeAll >= FileSize
	CloseNetworkConnection(Connection)
	FreeMemory(*Buffer)
	If Time2 > Timeout
		If *Mem : FreeMemory(*Mem) : EndIf
		ProcedureReturn "Error Connection time out"
	EndIf
	If FileSize > 2
		ProcedureReturn Str(*Mem)+";"+Str(FileSize)
	EndIf
	FreeMemory(*Mem)
	ProcedureReturn "Error unknown"
EndProcedure

URL.s = "http://centrumse.googlecode.com/svn/trunk/Library/k850_r1fa035.lib.vkp"
	Local.s = "C:\k850_r1fa035.lib.vkp"
	File.s = ReceiveHTTPMemory(URL)
	If Left(File, 5) <> "Error"
		File = PeekS(Val(Left(File,FindString(File,";",1)-1)) , Val(Mid(File,FindString(File,";",1)+1)), #PB_Ascii)
		CreateFile(0, Local)
		WriteData(0, @File, Len(File))
		CloseFile(0)
	EndIf  

its not working...

and im trying to get an http file

thanks

[Vitor_Boss®]

Here it is working fine.
complete code:

Code: Select all

Enumeration 1
#Window_Main
EndEnumeration

Enumeration 1
#Gadget_Main_Text
#Gadget_Main_Progress
EndEnumeration

InitNetwork()

Procedure.s ReceiveHTTPMemory(URL.s, BufferSize = 4096, Timeout = 5000)
   ;====================== ReceiveHTTPMemory ============================
   ;  Author:                Thomas Schulz (ts-soft)
   ;  Date:                  January 13, 2011
   ;  Moded by:          Vitor_Boss
   ;  Date:                  February 07, 2011  
   ;  Target OS:             All
   ;  Target Compiler:       Requires PureBasic 4.xx
   ;=====================================================================
   
   Protected Connection, Time, Time2, Event, Size, Size2, SizeAll, pos, FileSize = 1
   Protected.s Server, s, z
   Protected *Mem, *Buffer, *Mem2
   Size = 1
   
   If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
   Server = GetURLPart(URL, #PB_URL_Site)
   If Not Server : ProcedureReturn "Error Invalid server name": EndIf
   Connection = OpenNetworkConnection(Server, 80, #PB_Network_TCP)
   If Not Connection : ProcedureReturn "Error Not Connected": EndIf
   If BufferSize <= 0 : BufferSize = 4096 : EndIf
   *Buffer = AllocateMemory(BufferSize)
   If Not *Buffer : ProcedureReturn "Error can't allocate memory": EndIf
   ;{ By Vitor_Boss
   SetGadgetText(#Gadget_Main_Text, "Requesting Header")
   s = GetHTTPHeader(URL) ; Thanks dobro
   If FindString(s, "HTTP/1.1 ", 1)
    z = Trim(Mid(s, 10 , 3))
    If z <> "200"
     If z = "404" : CloseNetworkConnection(Connection) : EndIf
     ProcedureReturn "Error " + z
    EndIf
    z = Trim(Mid(s, FindString(s, "Content-Length:", 1) + 15, (FindString(s, "Content-Type:", 1) - 2) - (FindString(s, "Content-Length:", 1) + 15)))
    FileSize = Val(z)
    SetGadgetAttribute(#Gadget_Main_Progress, #PB_ProgressBar_Maximum, FileSize)
    SetGadgetText(#Gadget_Main_Text, "Start Download")
    ; FileSize is the estimated download size
    *Mem = ReAllocateMemory(*Mem, FileSize)
  EndIf
  ;}
   SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #CRLF$ + #CRLF$)
   Time = ElapsedMilliseconds()
   Repeat
      Event = NetworkClientEvent(Connection)
      If Event = #PB_NetworkEvent_Data
         Repeat
            Size = ReceiveNetworkData(Connection, *Buffer, BufferSize)
            If Size > 0
               Time = ElapsedMilliseconds()
               SizeAll + Size
               If *Mem
                  CopyMemory(*Buffer, *Mem + (SizeAll - Size), Size)
                  SetGadgetState(#Gadget_Main_Progress, SizeAll)
                  SetGadgetText(#Gadget_Main_Text, "Progress "+StrF((SizeAll/FileSize)*100,1)+"%")
               Else
                  CloseNetworkConnection(Connection)
                  FreeMemory(*Buffer)
                  ProcedureReturn "Error header not loaded"
               EndIf
               ; SizeAll is the current download status
         EndIf         
         Time2 = ElapsedMilliseconds() - Time
         Until Time2 > Timeout Or SizeAll >= FileSize
      EndIf
      Time2 = ElapsedMilliseconds() - Time
   Until Time2 > Timeout Or SizeAll >= FileSize
   CloseNetworkConnection(Connection)
   FreeMemory(*Buffer)
   If Time2 > Timeout
      If *Mem : FreeMemory(*Mem) : EndIf
      ProcedureReturn "Error Connection time out"
   EndIf
   If FileSize > 2
      ProcedureReturn Str(*Mem)+";"+Str(FileSize)
   EndIf
   FreeMemory(*Mem)
   ProcedureReturn "Error unknown"
EndProcedure
Procedure Download (Null)
   URL.s = "http://dlce.antivir.com/package/wks_avira/win32/en/pecl/avira_antivir_personal_en.exe"
   Local.s = "C:\avira_antivir_personal_en.exe"
   File.s = ReceiveHTTPMemory(URL)
   If Left(File, 5) <> "Error"
      File = PeekS(Val(Left(File,FindString(File,";",1)-1)) , Val(Mid(File,FindString(File,";",1)+1)), #PB_Ascii)
      CreateFile(0, Local)
      WriteData(0, @File, Len(File))
      CloseFile(0)
    Else
      SetGadgetText(#Gadget_Main_Text, File)
    EndIf 
EndProcedure
If OpenWindow(#Window_Main,0,0, 270, 70, "ProgressBar", #PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
TextGadget(#Gadget_Main_Text, 10,10,250,20, "Progress 0%",#PB_Text_Center)
ProgressBarGadget(#Gadget_Main_Progress,10,30,250,30,0,100)
    CreateThread(@Download(),0)
    Repeat ; Start of the event loop
      Define Event = WaitWindowEvent(10) ; This line waits until an event is received from Windows
      ;Define EventType = EventType() ; The event type
      ;If Event = #PB_Event_Timer
        
      Until (Event = #PB_Event_CloseWindow)
EndIf

[effis]

its not working
connection timeout

[TerryHough]

Look in this thread

http://www.purebasic.fr/english/viewtopic.php?p=217199

[dobro]

hum !

         ; By Dobro
         ; Purebasic 4.51
         ; affiche une petite fenetre avec un trackbar
         ; qui donne la progression du telechargement
         ; utile pour gerer une mise a jour automatique dans vos programme
        
        
         Declare download(*bidon)
         Declare size(url.s)
         Declare test_size (file.s)
        
         initnetwork ()
        
        
         Global url.s= "http://michel.dobro.free.fr//Upload/purenoide2.zip" ; fichier se trouvant sur le serveur (il est gros c'est un jeu)
        nom_file$= getfilepart (url.s)
         Global file.s= "c:\" +nom_file$ ; le chemin et le nom qu'on va donner a ce fichier, sur l'ordi qui reçoit le fichier
        
        
         ;- Window Constants
         ;
         Enumeration
                 #Window_0
         EndEnumeration
        
         ;- Gadget Constants
         ;
         Enumeration
                 #Titre
                 #ProgressBar
                 #nom_file
         EndEnumeration
        
        
         ;- Fonts
         Global FontID1
        FontID1 = loadfont (1, "Comic Sans MS" , 14, #PB_Font_Bold )
        
         Procedure Open_Window_0()
                 If openwindow ( #Window_0 , 284, 123, 356, 103, "Download" , #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
                        
                         textgadget ( #Titre , 110, 0, 90, 30, "Download" )
                         setgadgetfont ( #Titre , FontID1)
                        
                         progressbargadget ( #ProgressBar , 30, 60, 300, 20, 0, size(url.s), #PB_ProgressBar_Smooth )
                        nom_file$= getfilepart (file.s)
                         textgadget ( #nom_file , 80, 30, 180, 20, nom_file$)
                        
                         createthread (@download() , *bidon)
                 EndIf
         EndProcedure
        
        Open_Window_0()
        
         Repeat ;
                Event = waitwindowevent (200) ;
                 windowid = eventwindow () ;
                 gadgetid = eventgadget () ;
                 eventtype = eventtype () ;
                 ;
                 Select Event
                         Case #PB_Event_Gadget
                                 Select gadgetid
                                         Case #ProgressBar
                                 EndSelect
                 EndSelect
                 setgadgetstate ( #ProgressBar , test_size (file.s))
                
                
         Until test_size (file.s)>= size(url.s) ;Event = #PB_Event_CloseWindow ; End of the event loop
        
         End
         ;
        
        
        
        
        
         Procedure download(*bidon)
                 ; by Dobro
                 ; telecharge le fihier
                 Debug receivehttpfile (url.s, file.s)
         EndProcedure
        
         Procedure size(url.s)
                 ; by Dobro
                 ; demande la taille du fichier sur le serveur
                Header$ = gethttpheader (url.s)
                 Repeat
                        Index+1
                        Line$ = stringfield (Header$, Index, #LF$ )
                         If findstring (Line$, "Content-Length:" ,1)
                                longueur_file= val ( stringfield (Line$,2, ":" ))
                                 ProcedureReturn longueur_file
                         EndIf
                 Until Line$ = ""
         EndProcedure
        
         Procedure test_size (file.s)
                 ; By Dobro
                 ; test la taille du fichier reçut
                 If filesize (file.s) <>-1
                         ProcedureReturn filesize (file.s)
                 EndIf
         EndProcedure
        
        
        
        

[Vitor_Boss®]

its not working
connection timeout

Verify your Firewall.

Here it Work. Look:

[effis]

thanks its working
is it possible to do it for sending a file to FTP?