PureBasic Forums - English

Code: Select all

;- Enumerations
;{
Enumeration ; Windows
  #winDownload
EndEnumeration

Enumeration ; Gadgets
  #percent
  #btnCancel
EndEnumeration

Enumeration ; Regular Expressions
  #rgxSize
  #rgxCurrent
EndEnumeration
;}

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		#wget = "wget.exe" ; Provided wget is in the path.
	CompilerCase #PB_OS_Linux
		#wget = "/usr/local/bin/wget"
	CompilerCase #PB_OS_MacOS
		#PB_OS_Linux
	CompilerDefault
		CompilerError "Unknown OS"
CompilerEndSelect

Procedure GetSize(cString.s, nRegEx)
  Protected Dim Found$(0)
  Protected cFound.s = "", nSize = 0
  
  If ExtractRegularExpression(nRegEx,cString,Found$())
    cFound = Found$(0)
    nSize = Val(cFound)
    Select Right(cFound,1)
      Case "M": nSize * 1024 * 1024
      Case "K": nSize * 1024
    EndSelect
  EndIf
  
  ProcedureReturn nSize
EndProcedure

Procedure DownloadFile( cURL.s, cFolder.s )
  Protected nPercent.f, hProg, stderr.s
  
  CreateRegularExpression(#rgxSize,      "\b[0-9]+\b")
  CreateRegularExpression(#rgxCurrent,   "[0-9]+[KM]")
  
  OpenWindow(#winDownload, 450, 200, 389, 69, "Downloading...", #PB_Window_TitleBar)
  ProgressBarGadget(#percent, 5, 10, 380, 25, 0, 100, #PB_ProgressBar_Smooth)
  ButtonGadget(#btnCancel, 130, 45, 135, 20, "Cancel")
  hProg = RunProgram(#wget,"--continue --progress=bar "+URLEncoder(cURL),cFolder,#PB_Program_Read|#PB_Program_Open|#PB_Program_Error|#PB_Program_Hide)
  
  While ProgramRunning(hProg)
    Select WaitWindowEvent(10)
    Case #PB_Event_Gadget
      Select EventGadget()
      Case #btnCancel
        ; NOTE: While dialog is presented, download continues, but display is not updated.
        If MessageRequester("Downloading...","Are you sure you want to cancel?",#PB_MessageRequester_YesNo|#MB_DEFBUTTON2|#MB_SYSTEMMODAL)=#PB_MessageRequester_Yes
          KillProgram(hProg)
          Break
        EndIf
      EndSelect
    EndSelect
    
    If AvailableProgramOutput(hProg)
      ReadProgramString(hProg) ; Consume any output (there seems to be a bug in this area)
    EndIf
    stderr = ReadProgramError(hProg)
    If stderr <> ""
      If FindString(stderr, "Length:")
        nSize = GetSize( stderr,#rgxSize )
      EndIf
      If FindString(stderr, "%")
        nCurrent = GetSize(stderr,#rgxCurrent)
        nPercent = (nCurrent/nSize)*100
        
        SetGadgetState(#percent, nPercent)
        SetWindowTitle(#winDownload,"Downloading... "+StrF(nPercent,2)+"%")
      EndIf
    EndIf
  Wend
  
  CloseProgram(hProg)
  CloseWindow(#winDownload)
  
  FreeRegularExpression(#rgxCurrent)
  FreeRegularExpression(#rgxSize)
  
EndProcedure

DownloadFile("http://www.purebasic.com/download/PureBasic_Demo.exe","c:\temp")

Code: Select all

EnableExplicit

;- ---[ Enumerations ]---

;{ Enumerations (windows/gadgets/status bar/regex)
Enumeration ; Windows
  #winDownload
EndEnumeration

Enumeration ; Gadgets
  #ProgressBar
  #btnCancel
EndEnumeration

Enumeration ; Status bar
  #StatusBar_winDownload
EndEnumeration

Enumeration ; Status bar Fields
  #SB_Filename
  #SB_TimeLeft
  #SB_Speed
  #SB_Percent
EndEnumeration

Enumeration ; RegEx
  #rgxWords ; We are simplifing by using 1 regex.
EndEnumeration

Enumeration ; Menu/Keyboard shortcuts
  #EscapeKeyPressed
EndEnumeration

;}

;- ---[ Constants ]---
;{ All Constants
#RegExpression = "(?i)[.0-9kms]+\b" ; Used to parse output from wget

;{ Array Element for RegEx results
#Current      = 0
#FileSize     = 0
#Speed           = 2
#TimeLeft = 3
;}

;{ variations do exist for each OS
CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		#wget = "wget.exe" ; Provided wget is in the path.
	CompilerCase #PB_OS_Linux
		#wget = "/usr/local/bin/wget"
	CompilerCase #PB_OS_MacOS
		#PB_OS_Linux
	CompilerDefault
		CompilerError "Unknown OS"
CompilerEndSelect
;}
;}


;- ---[ Support Procedures/Macros ]---
;{ Support Procedures
Procedure.s GetRegExField( cString.s, nField, hRegEx ) ; Get a field (array element) from matched regex results
  Protected Dim Results$(0), cFound.s = ""
  
  If ExtractRegularExpression(hRegEx, cString, Results$()) > nField
    cFound = Results$(nField)
  EndIf
  ProcedureReturn cFound
EndProcedure

Macro GetString( cString, nField ) ; For reading ease
  GetRegExField(cString, nField, #rgxWords)
EndMacro

Procedure GetNumber(cString.s, nField) ; This gets a number from a string
  Protected nSize, cFound.s = GetString(cString, nField)
  
  nSize = Val(cFound)
  
  Select Right(cFound, 1) ; this calculates out if it's a Kilobyte or Megabyte
    Case "M": nSize * 1024 * 1024
    Case "K": nSize * 1024
  EndSelect
  
  ProcedureReturn nSize
EndProcedure

Macro UserCancelRequest()
  If IsThread(hCancelThread) = #False
    hCancelThread = CreateThread(@AskCancelThread(), hProg)
    DisableGadget(#btnCancel, #True)
  EndIf
EndMacro

;}


;- ---[ Threaded Procedures ]---

Procedure AskCancelThread( hProg )
  If MessageRequester(GetWindowTitle(#winDownload), "Are you sure you want to cancel?", #PB_MessageRequester_YesNo|#MB_DEFBUTTON2|#MB_SYSTEMMODAL)=#PB_MessageRequester_Yes
    KillProgram(hProg) ; User wants to stop so kill the program...
  Else
    DisableGadget(#btnCancel, #False)
  EndIf
EndProcedure


;- ---[ Main Download Procedure ]---

Procedure DownloadFile( cURL.s, cFolder.s = "")
  Protected hProg, hCancelThread, bSuccess = #False
  Protected stderr.s, nSize, nCurrent, nPercent.f, cTimeLeft.s, cSpeed.s
  
  ; If no folder was passed, set to the app's current directory.
  If cFolder = "" : cFolder = GetCurrentDirectory() : EndIf
  
  ; NOTE: We really should check that the window was created, along with status bar, regex, etc.
  OpenWindow(#winDownload, 450, 200, 455, 78, "Downloading ...", #PB_Window_TitleBar|#PB_Window_WindowCentered|#PB_Window_Invisible)
  
  
  ; Create Status bar
  CreateStatusBar(#StatusBar_winDownload, WindowID(#winDownload))
  
  AddStatusBarField(312)
  StatusBarText(#StatusBar_winDownload, #SB_Filename, cURL, #PB_StatusBar_Center)
  
  AddStatusBarField(48)
  StatusBarText(#StatusBar_winDownload, #SB_TimeLeft, "[infinity]", #PB_StatusBar_Center)
  
  AddStatusBarField(45)
  StatusBarText(#StatusBar_winDownload, #SB_Speed, "[kb/s]", #PB_StatusBar_Center)
  
  AddStatusBarField(50)
  StatusBarText(#StatusBar_winDownload, #SB_Percent, "0.00%", #PB_StatusBar_Right)
  
  ; If user hit's escape, make it act like 'cancel' was pressed.
  AddKeyboardShortcut(#winDownload, #PB_Shortcut_Escape, #EscapeKeyPressed)
  
  ; Add Gadgets
  ProgressBarGadget(#ProgressBar, 5, 2, 445, 20, 0, 100, #PB_ProgressBar_Smooth)
  ButtonGadget(#btnCancel, 145, 27, 165, 25, "Cancel")
  
  CreateRegularExpression(#rgxWords, #RegExpression)
  
  ; Start the download
  ; If needed to embed wget, use --output-document to set a directory/name
  hProg = RunProgram(#wget, "--continue --progress=bar "+URLEncoder(cURL), cFolder, #PB_Program_Read|#PB_Program_Open|#PB_Program_Error|#PB_Program_Hide)
  
  HideWindow(#winDownload, #False )
  StickyWindow(#winDownload, #True)
  
  While IsProgram(hProg) And ProgramRunning(hProg)
    Select WaitWindowEvent(10) ; Report of crash here on MAC
    Case #PB_Event_Gadget
      Select EventGadget()
      Case #btnCancel
        ; There are lots of ways to do this.  The reason I do it this way is
        ; so that if the download completes while the dialog is up, I can easily close the cancel dialog.
        UserCancelRequest()
      EndSelect
    Case #PB_Event_Menu
      Select EventMenu()
      Case #EscapeKeyPressed
        UserCancelRequest()
      EndSelect
      
    EndSelect
    
    If AvailableProgramOutput(hProg)
      ; I don't think this is needed, at least on windows, all wget output is to stderr.
      ReadProgramString(hProg) ; there seems to be a bug that indicates we should consume all output
    EndIf
    
    stderr = ReadProgramError(hProg)
    If stderr
      If FindString(stderr, "%") ; this line contains all sorts of info we want.
        
        cTimeLeft = GetString( stderr, #TimeLeft )
        StatusBarText(#StatusBar_winDownload, #SB_TimeLeft, cTimeLeft, #PB_StatusBar_Right)
        
        cSpeed = GetString(stderr, #Speed)
        If cSpeed : cSpeed + "/s" : EndIf
        StatusBarText(#StatusBar_winDownload, #SB_Speed, cSpeed, #PB_StatusBar_Right)
        
        
        nCurrent = GetNumber(stderr, #Current)
        nPercent = (nCurrent/nSize)*100
        
        SetGadgetState(#ProgressBar, nPercent)
        StatusBarText(#StatusBar_winDownload, #SB_Percent, StrF(nPercent, 2)+"%", #PB_StatusBar_Right)
        
        
      ElseIf FindString(stderr, "Length:") ; This only happens once, and before the %
        ; We want this test "after" % becuase % will be found most often, speeding up the if/elseif
        nSize = GetNumber( stderr, #FileSize)
      EndIf
    EndIf
    
  Wend
  
  If nPercent = 100.00 Or ProgramExitCode(hProg)=0
    bSuccess = #True
  EndIf
  
  ; It's normally 'bad form' to kill a thread... but this thread isn't processing anything so we're ok
  If IsThread(hCancelThread) : KillThread(hCancelThread) : EndIf
  
  ; Clean up our stuff...
  CloseProgram(hProg) ; We're done reading the output from wget
  FreeRegularExpression(#rgxWords) ; Done with regular expressions
  RemoveKeyboardShortcut(#winDownload, #PB_Shortcut_Escape)
  CloseWindow(#winDownload) ; and the window..
  
  ProcedureReturn bSuccess
EndProcedure

;- ---[ Example Downlaod ]---
If DownloadFile("http://www.purebasic.com/download/PureBasic_Demo.exe", "c:\temp")
  Debug "Successfully downloaded"
  Else : Debug "Download did not complete"
EndIf

Code: Select all

If MessageRequester("Downloading...","Are you sure you want to cancel?",#PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes

Code: Select all

#wget = "wget.exe" ; Provided wget is in the path.

Code: Select all

[23:01:55] Waiting for executable to start...
[23:01:55] Executable type: Windows - x86  (32bit)
[23:01:55] Executable started.
[23:01:55] [ERROR] Resumable Download w progress bar using wget (NO APIs).pb (Line: 204)
[23:01:55] [ERROR] The specified 'Program' is null.
[23:01:59] The Program was killed.

Code: Select all

Problem signature:
  Problem Event Name:	APPCRASH
  Application Name:	a.exe
  Application Version:	0.0.0.0
  Application Timestamp:	50563040
  Fault Module Name:	a.exe
  Fault Module Version:	0.0.0.0
  Fault Module Timestamp:	50563040
  Exception Code:	c0000005
  Exception Offset:	00016286
  OS Version:	6.1.7601.2.1.0.256.1
  Locale ID:	1033
  Additional Information 1:	0a9e
  Additional Information 2:	0a9e372d3b4ad19135b953a78882e789
  Additional Information 3:	0a9e
  Additional Information 4:	0a9e372d3b4ad19135b953a78882e789

Code: Select all

Compiler = RunProgram("D:\PureBasic\Examples\wget.exe", "", "", #PB_Program_Open | #PB_Program_Read)
  Output$ = ""
  If Compiler
    While ProgramRunning(Compiler)
      If AvailableProgramOutput(Compiler)
        Output$ + ReadProgramString(Compiler) + Chr(13)
      EndIf
    Wend
    Output$ + Chr(13) + Chr(13)
    Output$ + "Exitcode: " + Str(ProgramExitCode(Compiler))
    
    CloseProgram(Compiler) ; Close the connection to the program
  EndIf
  
  MessageRequester("Output", Output$)