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
