Progress bar display

RPC · Post by **RPC** » Wed Feb 05, 2020 5:52 pm

Hi
I am trying to display progress bar where duration of program execution(downloading a file) is indeterminate.
I have used SET PROGRESSBAR...ENABLE MARQUEE in enclosed program, but I find progress bar starts AFTER the
downloading is complete. I want it to run when the file is downloading.
Can somebody help please.
Thanks

AUGE_OHR · Post by **AUGE_OHR** » Wed Feb 05, 2020 9:38 pm

hi,

have not work with MSXML2.ServerXMLHTTP yet so i had a look at MSDN
https://docs.microsoft.com/en-us/previo ... 9(v=vs.85)

as i understand it have no Callback Slot so you can´t add a Progressbar to it.

---

MSDN say that that API is out-dated so i like to ask what else can be used under harbour/HMG

RPC · Post by **RPC** » Thu Feb 06, 2020 4:45 am

Hi Jimmy
Thanks for the reply.

AUGE_OHR wrote: ↑Wed Feb 05, 2020 9:38 pm MSDN say that that API is out-dated so i like to ask what else can be used under harbour/HMG

Lets hope some one like edk or mol can help on this

dragancesu · Post by **dragancesu** » Thu Feb 06, 2020 7:25 am

It's a big problem and for real web applications written in php, I think it takes Java

Post by **SALINETAS24** » Thu Feb 06, 2020 8:05 am

Hola, he revistado tu ejemplo y he realizado una pequeña modificación para que puedas adaptarlo.
Dado que yo no puedo bajarme el archivo he realizado un bluque FOR dentro de BEGIN SEQUENCE para que veas su funcionamiento.
Algunas cuestiones

Code: Select all

	DEFINE PROGRESSBAR Progress_1 
     ROW 80
	 COL 30
     RANGEMIN 0
	 RANGEMAX 100                 
     VALUE 0 
     WIDTH 200 
	 HEIGHT 20 
    END PROGRESSBAR

La definición que haces de PROGRESSBAR esta en base 100, eso significa que trabaja de 0 a 100, por lo que en tu caso seria interesante saber la longitud del fichero y sustituir nCont por la longitud del fichero a bajar.

Code: Select all

    SetProperty( "TESTWAIT", "Progress_1", "Value",(nCont*100/10000)	)

El problema de PROGRESSBAR surge cuando no sabemos la duración del proceso y se necesita crear un bucle infinito, entonces quita el * a la línea * SET PROGRESSBAR Progress_1 OF testwait ENABLE MARQUEE UPDATED 10, con esto tendrás un bucle, termina y empieza,termina y empieza y así hasta que finalice el proceso.

Espero que te sirva.., salud y una cervecita...

Code: Select all

#include "hmg.ch"

FUNCTION Main()
PUBLIC lPIsNet := .f.

//LOAD WINDOW TestWait


DEFINE WINDOW TESTWAIT MAIN AT 213 , 451 WIDTH 750 HEIGHT 350 VIRTUAL WIDTH Nil VIRTUAL HEIGHT Nil TITLE "" ICON NIL  CURSOR NIL ON INIT isInternet() ON RELEASE Nil ON INTERACTIVECLOSE Nil ON MOUSECLICK Nil ON MOUSEDRAG Nil ON MOUSEMOVE Nil ON SIZE Nil ON MAXIMIZE Nil ON MINIMIZE Nil ON PAINT Nil BACKCOLOR Nil NOTIFYICON NIL NOTIFYTOOLTIP NIL ON NOTIFYCLICK Nil ON GOTFOCUS Nil ON LOSTFOCUS Nil ON SCROLLUP Nil ON SCROLLDOWN Nil ON SCROLLLEFT Nil ON SCROLLRIGHT Nil ON HSCROLLBOX Nil ON VSCROLLBOX Nil

    DEFINE BUTTON Button_1
        ROW    30
        COL    30
        WIDTH  100
        HEIGHT 28
        ACTION Dnld()
        CAPTION "Button_1"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

	DEFINE PROGRESSBAR Progress_1 
     ROW 80
	 COL 30
     RANGEMIN 0
	 RANGEMAX 100                 
     VALUE 0 
     WIDTH 200 
	 HEIGHT 20 
    END PROGRESSBAR
	
	
    DEFINE STATUSBAR FONT "Courier New" SIZE 9
        STATUSITEM "HMG Power !!!"
        KEYBOARD // will show status of Caps lock,Nums lock and insert mode. it is equal to 3 items on statusbar
        DATE
        CLOCK
        STATUSITEM "Internet OFF" ACTION isInternet()
    END STATUSBAR


END WINDOW

* SET PROGRESSBAR Progress_1 OF testwait ENABLE MARQUEE UPDATED 10
testwait.progress_1.hide

ON KEY ESCAPE OF testwait ACTION ThisWindow.Release
TestWait.center
TestWait.activate

Return nil

FUNCTION Dnld()
LOCAL cUrl, cFile, dDate, cExchange

testwait.progress_1.show

cUrl := 'https://www1.nseindia.com/archives/combine_report/combined_report23012020.zip'
cFile := 'q.zip'
dDate := ctod('23/01/2020')
cExchange := "NSE"
Downloadfile(cUrl, cFile, dDate, cExchange)

msginfo("Download Complete")
testwait.progress_1.hide
RETURN

FUNCTION DownloadFile( cUrl, cFile, dDate, cExchange )
    LOCAL oSoap, aRetorno, nHandle, nCont, lOk
    LOCAL nFileSize, nKb, nMb, nGb, cUnit
	
    if !lPIsNet
      Msgstop("No Internet - Downloadfile")
      RETURN	  
    endif

	lOk := .f.
    nFileSize := 0
    nKb := 1024
    nMb := nKb * 1024
    nGb := nMb * 1024
    cUnit := " Bytes"
*    BEGIN SEQUENCE WITH { |e| Break(e) }
*       oSoap := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
*       oSoap:Open( "GET", cUrl, .f. )
*       oSoap:Send()
*       aRetorno := oSoap:ResponseBody()
*      msgdebug(aretorno)
       
	FOR nCont=1 to 10000    
       SetProperty( "TESTWAIT", "Progress_1", "Value",(nCont*100/10000)	)
	NEXT
	
*       if '!DOCTYPE' $ aRetorno
*            msgstop("file not found on the server")
*            BREAK
*       endif
*	   
*       nHandle := fCreate( cFile )
*       IF ValType( aRetorno ) == "C"
*          fWrite( nHandle, aRetorno )
*       ELSE
*          FOR nCont = 1 TO Len( aRetorno )
*             fWrite( nHandle, Chr( aRetorno[ nCont ] ) )
*          NEXT
*       ENDIF
*       nFileSize := oSoap:getResponseHeader("Content-Length")
*       nFileSize := val(nFileSize)
*       if nFileSize < nKb
*           cUnit := " Bytes"
*       elseif nFileSize > nKb .and. nFileSize < nMb
*           nFileSize := int(nFileSize/nKb)
*           cUnit := " Kb"
*       elseif nFilSize > nMb .and. nFileSize < nGb
*           nFileSize := int(nFileSize/nMb)
*           cUnit := " Mb"
*       elseif nFilSize > nGb .and. nFileSize < nGb * 1024
*           nFileSize := int(nFileSize/nGb)
*           cUnit := " Gb"
*       else
*           nFileSize := int(nFileSize/(nGb*1024))
*           cUnit := " Tb"
*       endif
*       fClose( nHandle )
*       oSoap:Close()
*       lOk := .t.
*    END SEQUENCE

*    if file(cFile)
*	   lOk := .t.
*    endif

RETURN lOk


FUNCTION isInternet( nTimeOut )
	Local aAddr:=hb_socketResolveINetAddr( "www.google.com" , 80 )
	Local socket:=hb_socketOpen()

	MEMVAR lPIsNet
	Default nTimeOut:=2000
	//MsgDebug(socket, aAddr, nTimeOut)
	lPIsNet:=!EMPTY( aAddr ) .AND. hb_socketConnect( socket , aAddr, nTimeOut )
	hb_socketClose( socket )
    
	if lPIsNet
	   TESTWAIT.STATUSBAR.Item(7) := "Internet ON "
	else
	   TESTWAIT.STATUSBAR.Item(7) := "Internet OFF"  
    endif	
    	
RETURN lPIsNet

Post by **edk** » Thu Feb 06, 2020 2:39 pm

RPC wrote: ↑Wed Feb 05, 2020 5:52 pm Hi
I am trying to display progress bar where duration of program execution(downloading a file) is indeterminate.
I have used SET PROGRESSBAR...ENABLE MARQUEE in enclosed program, but I find progress bar starts AFTER the
downloading is complete. I want it to run when the file is downloading.
Can somebody help please.
Thanks

Quick tip (not tested):

Code: Select all

#include "hmg.ch"

FUNCTION Main()
PUBLIC lPIsNet := .f.

//LOAD WINDOW TestWait


DEFINE WINDOW TESTWAIT MAIN AT 213 , 451 WIDTH 750 HEIGHT 350 VIRTUAL WIDTH Nil VIRTUAL HEIGHT Nil TITLE "" ICON NIL  CURSOR NIL ON INIT isInternet() ON RELEASE Nil ON INTERACTIVECLOSE Nil ON MOUSECLICK Nil ON MOUSEDRAG Nil ON MOUSEMOVE Nil ON SIZE Nil ON MAXIMIZE Nil ON MINIMIZE Nil ON PAINT Nil BACKCOLOR Nil NOTIFYICON NIL NOTIFYTOOLTIP NIL ON NOTIFYCLICK Nil ON GOTFOCUS Nil ON LOSTFOCUS Nil ON SCROLLUP Nil ON SCROLLDOWN Nil ON SCROLLLEFT Nil ON SCROLLRIGHT Nil ON HSCROLLBOX Nil ON VSCROLLBOX Nil

    DEFINE BUTTON Button_1
        ROW    30
        COL    30
        WIDTH  100
        HEIGHT 28
        ACTION Dnld()
        CAPTION "Button_1"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

	DEFINE PROGRESSBAR Progress_1 
     ROW 80
	 COL 30
     RANGEMIN 0
	 RANGEMAX 100                 
     VALUE 0 
     WIDTH 200 
	 HEIGHT 20 
    END PROGRESSBAR

     @ 100, 70 LABEL FileSize VALUE ''
	
	
    DEFINE STATUSBAR FONT "Courier New" SIZE 9
        STATUSITEM "HMG Power !!!"
        KEYBOARD // will show status of Caps lock,Nums lock and insert mode. it is equal to 3 items on statusbar
        DATE
        CLOCK
        STATUSITEM "Internet OFF" ACTION isInternet()
    END STATUSBAR


END WINDOW

SET PROGRESSBAR Progress_1 OF testwait ENABLE MARQUEE UPDATED 10
testwait.progress_1.hide

ON KEY ESCAPE OF testwait ACTION ThisWindow.Release
TestWait.center
TestWait.activate

Return nil

FUNCTION Dnld()
LOCAL cUrl, cFile, dDate, cExchange

testwait.progress_1.show
TESTWAIT.FileSize.VALUE := ""

cUrl := 'https://www1.nseindia.com/archives/combine_report/combined_report23012020.zip'
cFile := 'q.zip'
dDate := ctod('23/01/2020')
cExchange := "NSE"
Downloadfile(cUrl, cFile, dDate, cExchange)

msginfo("Download Complete")
testwait.progress_1.hide
TESTWAIT.FileSize.VALUE := ""
TESTWAIT.STATUSBAR.ITEM(1) := ""
RETURN

FUNCTION DownloadFile( cUrl, cFile, dDate, cExchange )
    LOCAL oSoap, aRetorno, nHandle, nCont, lOk
    LOCAL nFileSize, nKb, nMb, nGb, cUnit

    if !lPIsNet
      Msgstop("No Internet - Downloadfile")
      RETURN	  
    endif
	
    lOk := .f.
    nFileSize := 0
    nKb := 1024
    nMb := nKb * 1024
    nGb := nMb * 1024
    cUnit := " Bytes"
    BEGIN SEQUENCE WITH { |e| Break(e) }
       oSoap := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
       oSoap:Open( "GET", cUrl, .T. /* asynchronous */ )
       oSoap:Send()

       //check the transmission to see if it has finished       
       DO WHILE oSoap:readystate < 4			
	     IF TESTWAIT.STATUSBAR.ITEM(1) <> cReadyState(oSoap:readystate)  //avoid flickering
	         TESTWAIT.STATUSBAR.ITEM(1) := cReadyState(oSoap:readystate)
             ENDIF
             DO Events
             IF oSoap:readystate >= 2 .AND. nFileSize = 0 
		nFileSize := Val(oSoap:getResponseHeader("Content-Length"))
		TESTWAIT.FileSize.VALUE := 'File size: ' + hb_NTOS(nFileSize)
	     ENDIF
       ENDDO

       TESTWAIT.STATUSBAR.ITEM(1):= cReadyState(oSoap:readystate)

       IF oSoap:status <> 200
            BREAK "HTTP Server status is " + hb_NToS(oSoap:status) + " "  +oSoap:statusText 
       ENDIF
       aRetorno := oSoap:responseBody

    RECOVER USING oError
        MsgStop ( IF (ValType(oError) = 'O', oError:Description, oError ) )

    END SEQUENCE

    oSoap:=Nil

    if aRetorno = Nil 
            msgstop("file not found on the server")
            RETURN lOk   
    endif

    IF Len(aRetorno) <> nFileSize
            msgstop("file size mismatch")
            RETURN lOk   
    ENDIF

    nHandle := fCreate( cFile )
    IF ValType( aRetorno ) == "C"
       fWrite( nHandle, aRetorno )
    ELSE
       FOR nCont = 1 TO Len( aRetorno )
          fWrite( nHandle, Chr( aRetorno[ nCont ] ) )
       NEXT
    ENDIF

    if nFileSize < nKb
        cUnit := " Bytes"
    elseif nFileSize >= nKb .and. nFileSize < nMb
        nFileSize := int(nFileSize/nKb)
        cUnit := " Kb"
    elseif nFileSize >= nMb .and. nFileSize < nGb
        nFileSize := int(nFileSize/nMb)
        cUnit := " Mb"
    elseif nFileSize >= nGb .and. nFileSize < nGb * 1024
        nFileSize := int(nFileSize/nGb)
        cUnit := " Gb"
    else
        nFileSize := int(nFileSize/(nGb*1024))
        cUnit := " Tb"
    endif

    fClose( nHandle )

    lOk := file(cFile)

RETURN lOk


FUNCTION isInternet( nTimeOut )
	Local aAddr:=hb_socketResolveINetAddr( "www.google.com" , 80 )
	Local socket:=hb_socketOpen()

	MEMVAR lPIsNet
	Default nTimeOut:=2000
	//MsgDebug(socket, aAddr, nTimeOut)
	lPIsNet:=!EMPTY( aAddr ) .AND. hb_socketConnect( socket , aAddr, nTimeOut )
	hb_socketClose( socket )
    
	if lPIsNet
	   TESTWAIT.STATUSBAR.Item(7) := "Internet ON "
	else
	   TESTWAIT.STATUSBAR.Item(7) := "Internet OFF"  
    endif	
    	
RETURN lPIsNet

FUNCTION cReadyState (nState)
DO CASE
	CASE nState = 0
		RETURN "UNINITIALIZED"
	CASE nState =  1
		RETURN "LOADING"
	CASE nState = 2
		RETURN "LOADED"
	CASE nState = 3
		RETURN "INTERACTIVE"
	CASE nState = 4
		RETURN "COMPLETED"
ENDCASE
RETURN ""

mustafa · Post by **mustafa** » Thu Feb 06, 2020 2:52 pm

Hola RPC
Haber si te puede servir ?

Code: Select all


#include "hmg.ch"

FUNCTION Main()

   DEFINE WINDOW Form_1  AT 213 , 451 WIDTH 450 HEIGHT 350  TITLE "Test ProgressBar"  MAIN  NOSIZE NOMAXIMIZE

         DEFINE LABEL Title   
               ROW    125
	       COL    185 
	       WIDTH  350  
	       HEIGHT 020
	       VALUE ""
	       FONTNAME "Arial"
	       FONTSIZE 10
	       TOOLTIP ""
	       FONTBOLD .T.
	       TRANSPARENT .T.
	       CENTERALIGN .F.
	 END LABEL	

         DEFINE PROGRESSBAR ProgressBar_1
                ROW 150
	        COL 130
                RANGEMIN 0
	        RANGEMAX 100                 
                VALUE 0 
                WIDTH 200 
	        HEIGHT 20 
         END PROGRESSBAR

         DEFINE BUTTON Button_1
                ROW    030
                COL    030
                WIDTH  100
                HEIGHT 28
                ACTION Dnld()
                CAPTION "Execute"
                FONTNAME "Arial"
                FONTSIZE 9
                TOOLTIP ""
                FONTBOLD .F.
                FONTITALIC .F.
                PICTURE Nil
                PICTALIGNMENT TOP
          END BUTTON

  END WINDOW

   Form_1.Title.Value         := ""
   Form_1.ProgressBar_1.Value := 0 

   ON KEY ESCAPE OF Form_1 ACTION ThisWindow.Release

   Form_1.center
   Form_1.activate

Return nil

*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

*--------------------------------------*
FUNCTION Dnld()
*--------------------------------------*

  nStart:= SECONDS()
  cTest := 'Without Progress Indicator'
   
 For nX := 0 to 100 step 1

    DO EVENTS 

    Form_1.Title.Value := "Progress: " + Str(nX,3)+" %"
    Form_1.ProgressBar_1.Value := nX    
    Form_1.ProgressBar_1.Refresh()   
 
    MILLISEC(80)      
 
 Next 
  
   MsgInfo( cTest +' -> '+LTRIM(STR(SECONDS() - nStart))+ " Seconds",'Test Duration')  // Optional
  
  Form_1.Title.Value    := ""
  Form_1.ProgressBar_1.Value := 0 

Return Nil


*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Regards / Saludos

Mustafa

RPC · Post by **RPC** » Thu Feb 06, 2020 6:57 pm

Hi Salinetas24
Many thanks for your reply
Your program works. I will try it with other files of different sizes.
Enjoy your beer

RPC · Post by **RPC** » Thu Feb 06, 2020 7:18 pm

Hi Edwards(edk)
You program works perfectly
Many thanks for your help.

RPC · Post by **RPC** » Thu Feb 06, 2020 7:26 pm

Hi Mustafa
Your program looks quite impressive.
I will try to integrate it in my program and see how it works.
Many thanks for your efforts.

HMGforum.com

Progress bar display

Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display

Re: Progress bar display