Download file from WWW

HMG Samples and Enhancements

Moderator: Rathinagiri

User avatar
mol
Posts: 2801
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 112 times
Been thanked: 52 times
Contact:

mol

Post by mol » Tue Dec 27, 2016 7:27 pm

Try this code

Code: Select all


PROCEDURE DownloadFromWWW
	param cURL, cLocalFileName, lSilent
	LOCAL oCon, oUrl, i, cResponse
	local ret := .f.
	local OldErrorHandler
	
	OldErrorHandler := ErrorBlock({|e| break(e)})
	
	BEGIN SEQUENCE
	cLocalFileName := alltrim(cLocalFileName)
	if lSilent = NIL
		lSilent := .f.
	endif
	oUrl := tURL():New( cUrl )
	IF Empty( oUrl )
		if !lSilent
			MsgBox("Bad url " + cUrl)
		endif
		BREAK
	ENDIF

	IF oUrl:cProto != "http"
		if !lSilent
			MsgBox('Bad url')
		endif
		BREAK
	END
   
	oCon := TipClientHttp():New( oUrl )
	oCon:nConnTimeout := 20000
	if !lSilent
		MsgBox("Connecting with "+ oUrl:cServer)
	endif
	IF oCon:Open( cUrl )
		if !lSilent
			MsgBox("Connection established." +chr(10)+"Press OK to download " + oUrl:cPath +oUrl:cFile)
		endif
		oCon:WriteAll(cLocalFileName)
		if !lSilent
			MsgBox("Downloaded as: "+cLocalFileName)
		endif
		oCon:Close()
		ret := .t.
	ELSE
		IF oCon:SocketCon == NIL
			cResponse := "Connection not initialized"
		ELSEIF hb_InetErrorCode( oCon:SocketCon ) == 0
			cResponse := oCon:cReply
		ELSE
			if !lSilent
				cResponse := "Error in connection: " + hb_InetErrorDesc( oCon:SocketCon )
			endif
		ENDIF
		if !lSilent
			MsgBox("I can not connect to: "+ oUrl:cServer+chr(10)+"Server response: "+cResponse)
		endif
		ret := .f.
	END
	RECOVER
		if !lSilent
			MSGSTOP("Unknown error")
		endif
	END SEQUENCE
	ErrorBlock(OldErrorHandler)
RETURN ret

EduardoLuis
Posts: 516
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina
Been thanked: 28 times

Post by EduardoLuis » Wed Dec 28, 2016 12:51 pm

Hey Mol:

What an excellent job.-
Thanks for share with us.-

With regards.
Eduardo

User avatar
luisvasquezcl
Posts: 1021
Joined: Thu Jul 31, 2008 3:23 am
Location: Chile
Has thanked: 11 times
Been thanked: 14 times
Contact:

Post by luisvasquezcl » Wed Dec 28, 2016 1:51 pm

Thanks Marek,
download for testing.
best regards,
Luis Vasquez.

User avatar
serge_girard
Posts: 1803
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 260 times
Been thanked: 60 times
Contact:

Post by serge_girard » Wed Dec 28, 2016 4:15 pm

Thanks Marek !

Serge

User avatar
serge_girard
Posts: 1803
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 260 times
Been thanked: 60 times
Contact:

Post by serge_girard » Thu Dec 29, 2016 2:32 pm

Marek,

Where to put SOCKET?

I get : undefined reference to THTTP ...

Serge

User avatar
mol
Posts: 2801
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 112 times
Been thanked: 52 times
Contact:

Post by mol » Thu Dec 29, 2016 5:56 pm

Whole working sample you can find below.
I don't know, what SOCKET do you mean?

Code: Select all

/*
 2016.05.16 Marek Olszewski MOL 
Read WWW sample
*/


#include <hmg.ch>

Function Main

	Public cURL := "http://www.molsystemy.pl"
	// for old debugger
	SetMode(25,80)
	
	DEFINE WINDOW Main ;
        AT 0,0 ;
        WIDTH 800 HEIGHT 600 ;
        TITLE 'Read WWW sample' ;
		Main  
		
		DEFINE LABEL LABEL_1
			ROW 20
			COL 20
			WIDTH 80
			HEIGHT 18
			VALUE "Web Address"
		END LABEL

		DEFINE TEXTBOX TEXT_1
			ROW 20
			COL 110
			WIDTH 500 
			HEIGHT 24 
			VALUE cURL
			TOOLTIP 'Web Address'
		END TEXTBOX
		 
		DEFINE BUTTON B1
			ROW    45
			COL    20
			WIDTH  200
			HEIGHT 24
			Caption "Click to read www document"
			FONTNAME "Arial"
			FONTSIZE 9
			ACTION SaveURL()
		END BUTTON

		DEFINE GRID Grid_Links
			ROW 70
			COL 40
			WIDTH 700 
			HEIGHT 480
			HEADERS {'Files to download'} 
			WIDTHS {480} 
			ITEMS {}
		END GRID

	END WINDOW
	
	Center Window Main
	Activate Window Main

Return
*------------------------
function GetLinkFiles
	param cWWWFile
	
	aFilesToDownload := {}
	
	//cWWWFile := Getfile ( { {'HTML','*.html'},{'HTM','*.htm'} },'Select html file' , '.', .f. , .t. )
	
	if hb_FileExists( cWWWFile)
		cWWW := memoread(cWWWFile )
	else
		return .f.
	endif
	
	if cWWW  == NIL
		msgstop("Something wrong with "+cWWWFile + " file")
		return .f.
	endif
	
	TokenInit(@cWWW,"<>")

	do while .not. TokenEnd()
		cLink := ''
		cTag := alltrim(TokenNext(cWWW))

		if hmg_lower(cTag) = "link"
			cLink := StripTag(cTag,"href")
		
		elseif hmg_lower(cTag) = "script"
			cLink := StripTag(cTag,"src")
		
		elseif hmg_lower(cTag) = "img"
			cLink := StripTag(cTag,"src")
		
		endif
		
		if !empty(cLink)
			aAdd(aFilesToDownload, cLink)
			Main.Grid_Links.AddItem({cLink})
		endif
	enddo
	
	//msgdebug(aFilesToDownload)
return .t.
	
*-------------------
function StripTag
	param cTag, cKeyword
	local i
	local cLink
	
	i := hb_at(cKeyword, hmg_lower(cTag))
	if i > 0
		// cut path and filename
		cTag := substr(cTag,i)
		i := hb_at('"', cTag)
		cTag := substr(cTag,i+1)
		i := hb_at('"', cTag)
		cLink := left(cTag,i-1)
	endif
return cLink
*----------------------

Function SaveURL()
	
	local oHttp, cHtml, oDoc, cUrl:=alltrim(Main.Text_1.Value)
	local i
	local cBaseAddress := ''
	local cLocalFolderName
	
	private aFilesToDownload := {}
	
	oHttp := TIpClientHttp():new( cUrl )

	if.not. oHttp:open()
		MsgInfo("Connection error:", oHttp:lastErrorMessage())
		Return Nil
	endif

	cHtml := oHttp:readAll()
	oHttp:close()

	oDoc := THtmlDocument():new( cHtml )

	// create folder for saving files
	
	cLocalFolderName := dtos(date())+strtran(time(),":","")
	CreateFolder(cLocalFolderName)
	
	oDoc:writeFile( cLocalFolderName +"\"+"main.html" )

	i := rat("/", cUrl)
	//cBaseAddress := left(cUrl,i)
	cBaseAddress := cUrl + "/"
	
	GetLinkFiles(cLocalFolderName +"\"+"main.html" )
	
	for i := 1 to len(aFilesToDownload)
		if aFilesToDownload[i] = "http"
			// external links
			cFileName := aFilesToDownload[i]
			cLocalFileName :=  strtran(aFilesToDownload[i], ":","_")
			cLocalFileName :=  strtran(cLocalFileName, "/","_")
			cLocalFileName := cLocalFolderName + "\" + cLocalFileName
			
		else
			cFileName := cBaseAddress +  aFilesToDownload[i]
			cLocalFileName := aFilesToDownload[i]
			cNewFolderName := ""
			// create local nested folders
			do while .t.
				n := at("/", cLocalFileName)
				if n > 0
					cNewFolderName += left(cLocalFileName,n-1)
					CreateFolder(cLocalFolderName + "\" + cNewFolderName )
					cNewFolderName += "\"
					cLocalFileName := substr(cLocalFileName,n+1)
				else
					exit
				endif
			enddo
			cLocalFileName := cLocalFolderName + "\" + strtran(aFilesToDownload[i],"/","\")
		endif
		
		DownloadFromWWW(cFileName, cLocalFileName, .T.)
		Main.Grid_Links.AddItem({cFileName + " ---> "+cLocalFileName})
		DO Events
	next i
	
	Main.Grid_Links.AddItem({"Finished!"})
	MsgInfo("Downloaded and saved in folder: "+ cLocalFolderName)
Return Nil
*-----------------------

PROCEDURE DownloadFromWWW
	param cURL, cLocalFileName, lSilent
	LOCAL oCon, oUrl, i, cResponse
	local ret := .f.
	local OldErrorHandler
	
	OldErrorHandler := ErrorBlock({|e| break(e)})
	
	BEGIN SEQUENCE
	cLocalFileName := alltrim(cLocalFileName)
	if lSilent = NIL
		lSilent := .f.
	endif
	oUrl := tURL():New( cUrl )
	IF Empty( oUrl )
		if !lSilent
			MsgBox("Bad url " + cUrl)
		endif
		BREAK
	ENDIF

	IF oUrl:cProto != "http"
		if !lSilent
			MsgBox('Bad url')
		endif
		BREAK
	END
   
	oCon := TipClientHttp():New( oUrl )
	oCon:nConnTimeout := 20000
	if !lSilent
		MsgBox("Connecting with "+ oUrl:cServer)
	endif
	IF oCon:Open( cUrl )
		if !lSilent
			MsgBox("Connection established." +chr(10)+"Press OK to download " + oUrl:cPath +oUrl:cFile)
		endif
		oCon:WriteAll(cLocalFileName)
		if !lSilent
			MsgBox("Downloaded as: "+cLocalFileName)
		endif
		oCon:Close()
		ret := .t.
	ELSE
		IF oCon:SocketCon == NIL
			cResponse := "Connection not initialized"
		ELSEIF hb_InetErrorCode( oCon:SocketCon ) == 0
			cResponse := oCon:cReply
		ELSE
			if !lSilent
				cResponse := "Error in connection: " + hb_InetErrorDesc( oCon:SocketCon )
			endif
		ENDIF
		if !lSilent
			MsgBox("I can not connect to: "+ oUrl:cServer+chr(10)+"Server response: "+cResponse)
		endif
		ret := .f.
	END
	RECOVER
		if !lSilent
			MSGSTOP("Unknown error")
		endif
	END SEQUENCE
	ErrorBlock(OldErrorHandler)
RETURN ret

User avatar
serge_girard
Posts: 1803
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 260 times
Been thanked: 60 times
Contact:

Post by serge_girard » Fri Dec 30, 2016 9:44 am

Now OK Marek!
Thanks,Serge

RPC
Posts: 95
Joined: Fri Feb 10, 2017 4:12 am
Has thanked: 22 times
Been thanked: 3 times

Post by RPC » Mon Mar 06, 2017 6:14 pm

Hi mol
Sorry to bother you with an old post. I am trying to download a zip file from website but getting an error.
Does your program download only jpg file ?
Thanks

trmpluym
Posts: 192
Joined: Tue Jul 15, 2014 6:52 pm
Location: The Netherlands
Has thanked: 4 times
Been thanked: 11 times

Post by trmpluym » Mon Mar 06, 2017 7:52 pm

Nope, i use Mareks code to download EXE (updates).

Theo

mlnr
Posts: 57
Joined: Fri Aug 28, 2015 1:52 pm
Location: Hungary
Has thanked: 20 times
Been thanked: 6 times

Post by mlnr » Wed Mar 08, 2017 10:31 am

Hi RPC,

I never seen before this topic and Marek's great code, but i use an alternative function for download file.
Try this.

Code: Select all

FUNCTION DownloadFile( cUrl, cFile ) 
    LOCAL oSoap, aRetorno, nHandle, nCont, lOk 

    lOk := .f. 
    BEGIN SEQUENCE WITH { |e| Break(e) } 
       oSoap := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" ) 
       oSoap:Open( "GET", cUrl, .f. ) 
       oSoap:Send() 
       aRetorno := oSoap:ResponseBody() 
       nHandle := fCreate( cFile ) 
       IF ValType( aRetorno ) == "C" 
          fWrite( nHandle, aRetorno ) 
       ELSE 
          FOR nCont = 1 TO Len( aRetorno ) 
             fWrite( nHandle, Chr( aRetorno[ nCont ] ) ) 
          NEXT 
       ENDIF 
       fClose( nHandle ) 
       oSoap:Close() 
       lOk := .t. 
    END SEQUENCE 
RETURN lOk
Best regards,
Gabor

Post Reply