PureBasic Forums - English

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

urldownloadtofile

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

Page 1 of 1

urldownloadtofile

Posted: Mon May 31, 2004 8:21 am
by okman
urldownloadtofile downloads a file from the net to the desination. i have used this command many times in cpp . but guys is there a way i can capture the progress of the file being dloaded? cause the window just becomes inactive, nothing can be done in the window while dloading is on. so is there a way to stop this?

Posted: Mon May 31, 2004 8:55 am
by Berikco
viewtopic.php?t=8331&

Changed the memory commands for PB 3.9x

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.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 

  *Buf = 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, *Buf, 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(*Buf, 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

convert to v4

Posted: Sun May 21, 2006 11:06 am
by z3phir2003
any chance on converting this code to work with v4 ?
thanks in advance

Posted: Sun May 21, 2006 11:27 am
by thefool

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.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

  *Buf = 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, *Buf, Buffer, @Bytes)
    If Bytes = 0
      isLoop=0
    Else
      fBytes=fBytes+Bytes
        SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes))
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf
      
      WriteData(1,*Buf, 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, "Download with Progress" ,#PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )

  If CreateGadgetList(WindowID(#window))
      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_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

thanks

Posted: Sun May 21, 2006 11:33 am
by z3phir2003
thanks a lot that was fast :) and is working great

Re: urldownloadtofile

Posted: Sat Jun 02, 2012 4:04 pm
by SeregaZ
any idea how to cancel download? i try to make second thread with URLDownloadToFile... and try to kill thread by pressing button... but i think download is continues. because after kill, and trying again to download - always fail, and target file is busy by my program and cant delete manualy by windows explorer.

maybe i can to shut down conection by some command? and turn on again for second try download. this shut down can be some kind cancel of download. how to turn off internet only for my program and turn on again after?

***

i think make 2 program. main program, when you need to download some file, starts second small program:
RunProgram("downloader.exe", "http://cite.com/file.exe d:\temp", "", 0)

window of second program is hidden and in the title window shows status. when download starts will show title - "downloading", if error - will show "error", when finished download - will show "finish".

main program in the thread will read the title of second program by 1 sec timer. if he is get "downloading" - will check file size and will change progress bar, if "error" or "finish" - will close the second program.

nice? :) but antiviruses will warning - they didnt like hidden window and downloading...

so... how to cancel download in progress?

***

some edit old code looks fine :)

Code: Select all

InitNetwork()

Enumeration
  #Window0
  #File1
EndEnumeration

#bufferlengte=10240 
Global buffer 
Global buffer = AllocateMemory(#bufferlengte) 
Global buf$ 
Global EOL$ 
Global EOL$ = Chr(13)+Chr(10) 
Global filenaam$ 
Global filenaam$="efnoclient.exe" 
Global server$="files.balans.kz" 
Global url$="http://files.balans.kz/download/taxkz/current/"

;http://files.balans.kz/download/taxkz/current/efnoclient.exe

Global Port = 80 
Global size 
Global oldsize 
;Global rate 
;Global ratetel 
Global buf$ 
Global header 
Global startReceive 
Global hwnd 
Global ConnectionID 
Global filesize 
Global timeout 
;Global AniWin 
;Global h 
Global einde
;h=LoadLibrary_("Shell32.dll")

Global threaddownload

Procedure incoming(result) 
  b.b=0 
  b$="" 
  rest=0 
  Select header 
  Case 0 
    ;SendMessage_(AniWin,#ACM_OPEN,h,160) 
    i=0 
    Repeat 
      If PeekB(buffer+i)=13 And PeekB(buffer+i+1)=10 And PeekB(buffer+i+2)=13 And PeekB(buffer+i+3)=10 
        b$=Space(i+4) 
        CopyMemory(buffer,@b$,i+4) 
        rest=i 
        i=result-1 
      EndIf 
      i+1 
    Until i=result 
    ; 
    Repeat 
    ; 
      If Left(b$,2)=EOL$ 
        If startreceive=1 
          b$=Mid(b$,3,Len(b$)-3) 
          If CreateFile(#File1, "c:\"+filenaam$) 
            WriteData(#File1, buffer+rest+4, result-rest-4) 
            header=1 
            size=result-rest-4 
            SetGadgetText(4,"Received "+Str(size)+" of "+Str(filesize)+" bytes") 
          Else 
            header=2 
          EndIf      
        EndIf 
      Else 
        search=FindString(b$, EOL$ , 1) 
        If search>0 
          l$=Left(b$,search-1) 
          b$=Mid(b$,search+2,Len(b$)) 
          pos=FindString(l$,"200 " , 1) 
          If pos 
            startreceive=1  ; ok 
          Else 
            pos=FindString(l$,"404 " , 1) 
            If pos 
              ;error 404 not founf 
            Else 
              pos=FindString(l$,"Content-Length:" , 1) 
              If pos 
                pos=FindString(l$," " , 1) 
                filesize=Val(Mid(l$,pos+1,Len(l$))) 
              EndIf 
            EndIf 
          EndIf 
        Debug l$ 
      Else 
        l$="" 
      EndIf 
    EndIf ; 
  Until search=0 
  Case 1 
    timeout=0 
    WriteData(#File1, buffer, result) 
    size+result 
    SetGadgetText(4,"Received "+Str(size)+" of "+Str(filesize)+" bytes") 
    stap=100*size/filesize 
    SetGadgetState(2, stap) 
    If filesize=size 
      Debug "File Received" 
      header=2 
      Debug Str(size)+" of "+Str(filesize)+" bytes" 
      ;KillTimer_(hWnd,1) ; 20 milisecond timer 
      ;KillTimer_(hWnd,2) ; 1 sec timer 
      ;KillTimer_(hWnd,3) ; 500 msec timer    
      CloseFile(#File1) 
      CloseNetworkConnection(ConnectionID) 
      Debug "Connection Closed" 
      ;DestroyWindow_(AniWin) 
      einde=1 
    EndIf 
  EndSelect 
EndProcedure

Procedure Download(*Value)

  ;AniWin=CreateWindowEx_(#Window0,"SysAnimate32","",#ACS_AUTOPLAY|#ACS_CENTER|#ACS_TRANSPARENT|#WS_CHILD|#WS_VISIBLE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS,25,10,280,50, hwnd,0,GetModuleHandle_(0),0) 
  ConnectionID = OpenNetworkConnection(server$, Port)

  If ConnectionID 

    SendNetworkString(ConnectionID, "GET "+URL$+filenaam$+" HTTP/1.0"+eol$) 
    SendNetworkString(ConnectionID, eol$)
    
    Repeat
      If NetworkClientEvent(ConnectionID) 
        result=ReceiveNetworkData(ConnectionID, buffer, #bufferlengte) 
        incoming(result) 
      EndIf   
      
      timeout+1 
      
      If timeout>1000 
        einde=2
        Debug "Timeout"      
      EndIf
      
      Delay(10)
    Until einde=1 Or einde=2

    If einde=2
      CloseNetworkConnection(ConnectionID) 
      ;DestroyWindow_(AniWin)
      CloseFile(#File1)
    EndIf
         
  Else
    Debug "немогу установить соединение"
  EndIf 
  
  DisableGadget(1,1)
  DisableGadget(5,0)
  
  UseGadgetList(WindowID(#Window0))

EndProcedure

hwnd=OpenWindow(#Window0,100,450,335,160,"Downloading "+filenaam$+" from "+server$,#PB_Window_SystemMenu)

If hwnd 
    ButtonGadget(5, 10, 128,  72, 20, "Start")
    ButtonGadget(1, 250, 128,  72, 20, "Cancel") 
    DisableGadget(1,1)
    ProgressBarGadget(2, 10, 100, 313, 20, 0, 100) 
    TextGadget(3, 20, 80,  280, 15, "") 
    TextGadget(4, 20, 65,  280, 15, "") 

    Repeat 
      Select WaitWindowEvent() 
        Case #PB_Event_CloseWindow 
          quite = 1 
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1 ; отмена
              DisableGadget(1,1)
              DisableGadget(5,0)
              einde=2
            Case 5 ; старт загрузки
              DisableGadget(5,1)
              DisableGadget(1,0)
              einde=0
              header=0
              timeout=0
              threaddownload = CreateThread(@Download(), 1)
          EndSelect 
      EndSelect 
    Until quite = 1
 
EndIf

End
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited