Wiki Home

Read Url


Namespace: Wiki
How to really simply read a web page:

* readurl.prg 06-Mar-98

* 06-Mar-98 pulled from Q174524 on March 98 Technet CD
* 06-Mar-98 bug fixed about the length of the sReadBuffer

*Any Internet or intranet URL can be passed as a parameter. Microsoft.com
*was chosen for this example.

*Note that Microsoft Internet Explorer must be installed on the computer.

* passed: URLName, in the form "http://www.microsoft.com"
*
* returns: the content of the URL
*
* usage:
*
*    uWebContent = ReadURL( "http://www.microsoft.com" )
*    uWebContent = ReadURL( "http://www.SomeSite.com/SomeJPG.jpg" )
*  This next one provides feedback on the download every 4092 bytes:
*    uWebContent = ReadURL( "http://www.SomeSite.com/SomeBigFile.exe",
*                           "GiveFeedback(lcBytesRead,llOK)", 4092 )
*
* notes:
* 1 - IE does not need to be running to use this, but must be installed

LPARAMETERS pcUrlName, pcOptFeedback, pnOptBuffSize, pcOptOutputFile
* These parameters are No good, pcOptOutputBuffer, pcOptOutputWhole
* because once they're passed as parameters, the original names get hidden, so the
*   feedback function can't reference them that way, anyway.
*May 27, 03: Loader v1.01: Added parameter "pcOptOutputFile" to be able to download
*             files bigger than 16MB

DECLARE INTEGER InternetOpen IN wininet.DLL STRING sAgent, ;
   INTEGER lAccessType, STRING sProxyName, ;
   STRING sProxyBypass, INTEGER lFlags

DECLARE INTEGER InternetOpenUrl IN wininet.DLL ;
   INTEGER hInternetSession, STRING sUrl, STRING sHeaders, ;
   INTEGER lHeadersLength, INTEGER lFlags, INTEGER lContext

DECLARE INTEGER InternetReadFile IN wininet.DLL INTEGER hfile, ;
   STRING @sBuffer, INTEGER lNumberofBytesToRead, INTEGER @lBytesRead

DECLARE short InternetCloseHandle IN wininet.DLL INTEGER hInst

#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE SYNCHRONOUS 0
#DEFINE INTERNET_FLAG_RELOAD 2147483648

LOCAL lcAgent, lhInternetSession, lhUrlFile, llOk, lnOk, lcRetVal, lcReadBuffer, lnBytesRead, laDr[1], llCancel

if vartype(pcOptFeedback)='C'
  * if we're given a feedback function, make sure it has both parentheses (looks like a function)
  if not ( at('(',pcOptFeedback)>0 and (at('(',pcOptFeedback) < at(')',pcOptFeedback) ) )
    pcOptFeedback = .f.
  endif
endif

* what application is using Internet services?
lcAgent = "VFP"

lhInternetSession = InternetOpen( lcAgent, INTERNET_OPEN_TYPE_PRECONFIG, '', '', SYNCHRONOUS )

IF lhInternetSession = 0
   WAIT WINDOW "Internet session cannot be established" TIME 2
   RETURN .null.
ENDIF

lhUrlFile = InternetOpenUrl( lhInternetSession, pcUrlName, '', 0, INTERNET_FLAG_RELOAD, 0 )

IF lhUrlFile = 0
   * URL cannot be opened
   RETURN .null.
ENDIF

lcRetVal = ""
llOk = .t.
llCancel = .F.
lnTotalBytesRead = 0
lnBytesRead      = 0
lcReadBuffer     = ''
if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
  =&pcOptFeedback
endif

* Clear output file, if it exists.
if type('pcOptOutputFile')='C' and ADIR(laDr,pcOptOutputFile)>0
  DELETE FILE (pcOptOutputFile)
endif

DO WHILE llOK and NOT llCancel
   * set aside a big buffer
   lcReadBuffer = SPACE(iif(VarType(pnOptBuffSize)='N',pnOptBuffSize,32767))
   lnBytesRead = 0
   lnOK = InternetReadFile( lhUrlFile, @lcReadBuffer, LEN(lcReadBuffer), @lnBytesRead)

   lnTotalBytesRead = lnTotalBytesRead + lnBytesRead

   if ( lnBytesRead > 0 )
      if type('pcOptOutputFile')='C'
        StrToFile(left(lcReadBuffer,lnBytesRead),pcOptOutputFile,.T.) && Add to file.
      else
        lcRetVal = lcRetVal + left( lcReadBuffer, lnBytesRead )
      endif
   endif

*!*	   if vartype(pcOptOutputBuffer)='C'
*!*	     pcOptOutputBuffer = left( lcReadBuffer, lnBytesRead )
*!*	   endif
*!*	   if vartype(pcOptOutputWhole)='C'
*!*	     pcOptOutputWhole = lcRetVal
*!*	   endif

   * error trap - either a read failure or read past eof()
   llOk = ( lnOK = 1 ) and ( lnBytesRead > 0 )

   if vartype(pcOptFeedback)='C'
     if not &pcOptFeedback
       llCancel = .T.
     endif
   endif
ENDDO

* close all the handles we opened
InternetCloseHandle( lhUrlFile )
InternetCloseHandle( lhInternetSession )

* IF saving to file, return Success status.
if type('pcOptOutputFile')='C'
  RETURN NOT llCancel
endif
* return the URL contents
RETURN lcRetVal

Here is even simpler procedure for reading Web pages and downloading files
#DEFINE ccUrl    'http://fox.wikis.com/wc.dll?Wiki~ReadUrl'
#DEFINE ccTarget 'c:	emp	est.htm'

IF DownloadUrl(ccUrl, ccTarget)
	MODI FILE ccTarget
ENDIF

FUNCTION DownloadUrl(cRemote, cLocal)
	LOCAL lResult

	DECLARE INTEGER URLDownloadToFile IN urlmon;
		INTEGER, STRING, STRING, INTEGER, INTEGER

	WAIT WINDOW NOWAIT "Downloading remote file..."
	lResult = URLDownloadToFile(0, cRemote, cLocal, 0,0) = 0
	WAIT CLEAR
RETURN lResult

And another one: URLDownload To Cache FileOffsite link to http://www.news2news.com/vfp/?function=655
creates a cache file and returns its name.
FUNCTION DownloadUrl(cRemote)
	LOCAL nResult, cTargetFile
	cTargetFile = Repli(Chr(0), 250)

	DECLARE INTEGER URLDownloadToCacheFile IN urlmon;
		INTEGER lpUnkcaller, STRING szURL, STRING @szFileName,;
		INTEGER dwBufLength, INTEGER dwReserved, INTEGER pBSC

	WAIT WINDOW NOWAIT "Downloading remote file..."
	nResult = URLDownloadToCacheFile(0, cRemote, @cTargetFile,;
		Len(cTargetFile), 0,0)
	WAIT CLEAR
RETURN STRTRAN(cTargetFile, Chr(0), "")


Anatoliy Mogylevets
And here's a version that supports passwords and POST data:
* readurl.prg 06-Mar-98

* 06-Mar-98 pulled from Q174524 on March 98 Technet CD
* 06-Mar-98 bug fixed about the length of the sReadBuffer
* 20-Apr-06 Added support for POST

*Any Internet or intranet URL can be passed as a parameter. Microsoft.com
*was chosen for this example.

*Note that Microsoft Internet Explorer must be installed on the computer.

* passed: URLName, in the form "http://www.microsoft.com"
*
* returns: the content of the URL
*
* usage:
*
* uWebContent = ReadURL( "http://www.microsoft.com" )
* uWebContent = ReadURL( "http://www.SomeSite.com/SomeJPG.jpg" )
* This next one provides feedback on the download every 4092 bytes:
* uWebContent = ReadURL( "http://www.SomeSite.com/SomeBigFile.exe",
* "GiveFeedback(lnBytesRead,llOK)", 4092 )
*
* Useful variables to pass to the Feedback Function:
* lnTotalBytesRead -- The total bytes that have been read
* lnBytesRead -- The number of bytes read this last iteration
* lcReadBuffer -- The data that was just read this last iteration
* llOK -- The "OK to continue" flag. Set this false in the function to stop the download.
* lnBytesAvail -- The amount of data that is ready to download
* lnApparentSize -- lnBytesAvail + lnTotalBytesRead
* (there is no way to tell how much more data the server will send!)
* lnSize -- Content Length returned by QueryInfo
* lcStatus -- A description string stating the current status of the connection.
* lhInternetSession
* lhUrlFile
* lhConnect
*
* notes:
* 1 - IE does not need to be running to use this, but must be installed

LPARAMETERS pcUrlName, pcOptFeedback, pnOptBuffSize, pcOptOutputFile, pcOptUser, pcOptPwd, pcOptPOSTdata
* These parameters are No good, pcOptOutputBuffer, pcOptOutputWhole
* because once they're passed as parameters, the original names get hidden, so the
* feedback function can't reference them that way, anyway.
*May 27, 03: Loader v1.01: Added parameter "pcOptOutputFile" to be able to download
* files bigger than 16MB
*Jan 29, 04: LASv11.01/LWMv10.44 wgcs: Added optional User & Pwd params to facilitate Good HTTP AUTH

DECLARE INTEGER InternetOpen IN wininet.DLL STRING sAgent, ;
   INTEGER lAccessType, STRING sProxyName, ;
   STRING sProxyBypass, INTEGER lFlags

DECLARE INTEGER InternetOpenUrl IN wininet.DLL ;
   INTEGER hInternetSession, STRING sUrl, STRING sHeaders, ;
   INTEGER lHeadersLength, INTEGER lFlags, INTEGER lContext

DECLARE INTEGER InternetReadFile IN wininet.DLL INTEGER hfile, ;
   STRING @sBuffer, INTEGER lNumberofBytesToRead, INTEGER @lBytesRead

DECLARE SHORT InternetSetOption IN wininet.DLL ;
    INTEGER HINTERNET_hInternetSession, ;
    LONG DWORD_dwOption, ;
    STRING @ LPVOID_lpBuffer, ;
    LONG DWORD_dwBufferLength

DECLARE INTEGER InternetConnect IN wininet;
    INTEGER hInternetSession,;
    STRING sServerName,;
    LONG nServerPort,;
    STRING sUsername,;
    STRING sPassword,;
    LONG lService,;
    LONG lFlags,;
    LONG lContext

DECLARE INTEGER HttpOpenRequest IN wininet;
    INTEGER hConnect,;
    STRING lpszVerb,;
    STRING lpszObjectName,;
    STRING lpszVersion,;
    STRING lpszReferer,;
    INTEGER lpszAcceptTypes,;
    INTEGER dwFlags,;
    INTEGER dwContext
DECLARE INTEGER HttpSendRequest IN wininet;
    INTEGER hRequest,;
    INTEGER lpszHeaders,;
    INTEGER dwHeadersLength,;
    STRING @ lpOptional,;
    INTEGER dwOptionalLength
DECLARE INTEGER HttpQueryInfo IN wininet;
    INTEGER hRequest,;
    LONG dwInfoLevel,;
    STRING @ lpvBuffer,;
    LONG @ lpdwBufferLength,;
    LONG @ lpdwIndex
DECLARE INTEGER InternetQueryDataAvailable IN wininet ;
    INTEGER HINTERNET_hFile, ;
    LONG @ LPDWORD_lpdwNumberOfBytesAvailable, ;
    LONG @ DWORD_dwFlags, ;
    LONG @ DWORD_dwContext

DECLARE short InternetCloseHandle IN wininet.DLL INTEGER hInst
DECLARE LONG GetLastError IN Win32Api
DECLARE SHORT InternetGetLastResponseInfo IN wininet.DLL ;
  LONG @ LPDWORD_lpdwError, ;
  STRING @ LPTSTR_lpszBuffer, ;
  LONG @ LPDWORD_lpdwBufferLength

#define INTERNET_SERVICE_URL 0
#define INTERNET_SERVICE_FTP 1
#define INTERNET_SERVICE_GOPHER 2
#define INTERNET_SERVICE_HTTP 3

#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE SYNCHRONOUS 0
#define INTERNET_FLAG_ASYNC 0x10000000

*!* #define INTERNET_FLAG_RELOAD 0x80000000 // retrieve the original item
*!* #define INTERNET_FLAG_SECURE 0x00800000 // use PCT/SSL if applicable (HTTP)
*!* #define INTERNET_FLAG_KEEP_CONNECTION 0x00400000 // use keep-alive semantics
*!* #define INTERNET_FLAG_NO_AUTO_REDIRECT 0x00200000 // don't handle redirections automatically
*!* #define INTERNET_FLAG_READ_PREFETCH 0x00100000 // do background read prefetch
*!* #define INTERNET_FLAG_NO_COOKIES 0x00080000 // no automatic cookie handling
*!* #define INTERNET_FLAG_NO_AUTH 0x00040000 // no automatic authentication handling
*!* #define INTERNET_FLAG_CACHE_IF_NET_FAIL 0x00010000 // return cache file if net request fails

*#DEFINE INTERNET_FLAG_RELOAD 2147483648
#DEFINE INTERNET_FLAG_RELOAD 0x80000000
#define INTERNET_FLAG_KEEP_CONNECTION 0x00400000

#define INTERNET_OPTION_USERNAME 28
#define INTERNET_OPTION_PASSWORD 29
#define INTERNET_OPTION_PROXY 38
#define INTERNET_OPTION_PROXY_USERNAME 43
#define INTERNET_OPTION_PROXY_PASSWORD 44

#define INTERNET_OPTION_CONNECT_TIMEOUT 2
#define INTERNET_OPTION_CONNECT_RETRIES 3

#define HTTP_QUERY_CONTENT_LENGTH 5

LOCAL lhInternetSession, lhUrlFile, lhConnect, ;
      lcAgent, lnOk, lcRetVal, laDr[1], llCancel, lnRes1, lnRes2, ;
      llOK, lnTotalBytesRead, lnBytesRead, lcReadBuffer, lnBytesAvail, lnApparentSize, ;
      lnSize, lcBuf, lnBufLen, lnVoid, lnQryRet, lcStatus, lnErr

lcReadBuffer = '' && Clear before first feedback!!
lcStatus = 'Initializing...'
if vartype(pcOptFeedback)='C'
  * if we're given a feedback function, make sure it has both parentheses (looks like a function)
  if not ( at('(',pcOptFeedback)>0 and (at('(',pcOptFeedback) < at(')',pcOptFeedback) ) )
    pcOptFeedback = .f.
  endif
endif

* what application is using Internet services?
lcAgent = "VFP"
STORE 0 TO lhInternetSession, lhUrlFile, lhConnect, ;
           lnApparentSize, lnSize, lnTotalBytesRead, lnBytesAvail

lcStatus = 'Opening Internet API...'
if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
  =&pcOptFeedback
ENDIF

lhInternetSession = InternetOpen( lcAgent, INTERNET_OPEN_TYPE_PRECONFIG, '', '', SYNCHRONOUS )

* Cannot do asynchronous operations without a Callback function:
*lhInternetSession = InternetOpen( lcAgent, INTERNET_OPEN_TYPE_PRECONFIG, '', '', INTERNET_FLAG_ASYNC )

IF lhInternetSession = 0
  lnErr = GetLastError() && Sep 9, 2005
  lcStatus = 'Error: Internet session cannot be established. (Err#'+TRANSFORM(lnErr)+')'
  if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
    =&pcOptFeedback
  ELSE
    WAIT WINDOW lcStatus TIME 2
  ENDIF
  RETURN .null.
ENDIF
lcStatus = "Internet session opened"
if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
  =&pcOptFeedback
ENDIF

&& LASv11.01/LWMv10.44 wgcs
IF Vartype(pcOptUser)='C' and vartype(pcOptPwd)='C'
    LOCAL lcUser, lcPwd, lcHost, lcObj, lnRet
    lcUser = pcOptUser+CHR(0)
    lcPwd = pcOptPwd+CHR(0)
    * Set the Internet options:
    InternetSetOption( lhInternetSession, INTERNET_OPTION_USERNAME, @lcUser, len(lcUser) )
    InternetSetOption( lhInternetSession, INTERNET_OPTION_PASSWORD, @lcPwd, len(lcPwd) )

    * Connect to host. Parse the URL
    lcHost = SUBSTR( pcURLName, AT("://", pcURlName)+3 )
    if '/' $ lcHost
      lcObj = SUBSTR( lcHost, AT('/',lcHost) )
      lcHost = LEFT( lcHost, AT('/',lcHost)-1 )
    else
      lcObj = '/'
    endif

    lcStatus = "Creating Internet Connection..."
    if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
      =&pcOptFeedback
    ENDIF

    lhConnect = InternetConnect( lhInternetSession, lcHost, 0, lcUser, lcPwd, INTERNET_SERVICE_HTTP, 0, 0 )
    *!* hInternet, // wininet handle,
    *!* pszHost, // host
    *!* 0, // port
    *!* pszUser, // user
    *!* NULL, // pass
    *!* INTERNET_SERVICE_HTTP, // service
    *!* 0, // flags
    *!* 0 // context
    if lhConnect=0
      lnErr = GetLastError() && Feb 4, 2006, WebMan v14.03
      lcStatus = 'Error: Connection to host "'+lcHost+'" cannot be established. (Err#'+TRANSFORM(lnErr)+')'
      if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
        =&pcOptFeedback
      ELSE
        WAIT WINDOW lcStatus TIMEOUT 2
      ENDIF
      InternetCloseHandle( lhInternetSession ) && LASv11.01/LWMv10.44 wgcs
      RETURN .null.
    endif
    *!* This originally somehow always passed a blank password to InternetConnect, then set the password below... I don't know why
    *!* if empty( lcPwd )
    *!* * // Work around InternetConnect disallowing empty passwords.
    *!* InternetSetOption( hConnect, INTERNET_OPTION_PASSWORD, pszPass, lstrlen(pszPass)+1);
    *!* ENDIF

    lcStatus = 'Opening HTTP Request...'
    if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
      =&pcOptFeedback
    endif

    *// flags: keep-alive || bypass cache
    lhUrlFile = HttpOpenRequest( lhConnect, 'GET', lcObj, 0, 0, 0, ;
      bitor( INTERNET_FLAG_KEEP_CONNECTION, INTERNET_FLAG_RELOAD ), 0 )
    *!* hConnect, // connect handle
    *!* "GET", // request method
    *!* pszObject, // object name
    *!* NULL, // version
    *!* NULL, // referrer
    *!* NULL, // accept types
    *!* INTERNET_FLAG_KEEP_CONNECTION // flags: keep-alive
    *!* | INTERNET_FLAG_RELOAD, // flags: bypass cache
    *!* 0 // context
    if lhUrlFile=0
      lnErr = GetLastError() && Feb 4, 2006, WebMan v14.03
      lcStatus = 'Error: Request to host "'+lcHost+'" cannot be opened. (Err #'+TRANSFORM(lnErr)+')'
      if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
        =&pcOptFeedback
      else
        WAIT WINDOW lcStatus TIMEOUT 2
      endif
      InternetCloseHandle( lhConnect ) && Sept 9, 2005: Moved closing lhConnect above lhInternetSession
      InternetCloseHandle( lhInternetSession )
      RETURN .null.
    endif
    lcStatus = "HTTP Request Opened. Sending Request..."
    if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
      =&pcOptFeedback
    ENDIF

    *// Send request.
    IF VARTYPE(pcOptPOSTdata)='C' AND NOT EMPTY(pcOptPOSTdata)
      lnRet = HttpSendRequest( lhUrlFile, 0, 0, @pcOptPOSTdata, LEN(pcOptPOSTdata) )
    ELSE
      lnRet = HttpSendRequest( lhUrlFile, 0, 0, '', 0 )
    ENDIF
    *!* hRequest, // request handle
    *!* "", // header string
    *!* 0, // header length
    *!* NULL, // post data
    *!* 0 // post length
    *// Handle any authentication dialogs.
    * if (NeedAuth(hRequest) && fAllowCustomUI)
    * do custom UI
    * while (InternetReadFile (hRequest, bBuf, cbBuf, &cbRead) && cbRead)
    * fwrite (bBuf, 1, cbRead, stdout);

    IF lnRet = 0
      * URL cannot be opened
      lnErr = GetLastError() && Feb 4, 2006, WebMan v14.03
      lcStatus = 'Error: Cannot Send Request. (Err#'+TRANSFORM(lnErr)+')'
      if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
        =&pcOptFeedback
      else
        WAIT WINDOW lcStatus TIMEOUT 2
      endif
      InternetCloseHandle( lhUrlFile ) && Sept 9, 2005: Wasn't closing lhUrlFile
      InternetCloseHandle( lhConnect )
      InternetCloseHandle( lhInternetSession )
      RETURN .null.
    ENDIF

    lcStatus = "HTTP Request Sent"
    if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
      =&pcOptFeedback
    ENDIF
ELSE &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
  lcStatus = "Opening URL..."
  if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
    =&pcOptFeedback
  ENDIF

  lhUrlFile = InternetOpenUrl( lhInternetSession, pcUrlName, '', 0, INTERNET_FLAG_RELOAD, 0 )

  IF lhUrlFile = 0
    * URL cannot be opened
    lnErr = GetLastError() && Sep 9, 2005..display extended error information:
    *lcStatus = 'Error: Cannot open URL "'+pcUrlName+'"'+CHR(13);
    * +' (Error #'+TRANSFORM(lnErr)+')'
    lcStatus = 'Error: Cannot open URL. (Err #'+TRANSFORM(lnErr)+')'
*v1.14 lnErr2 = 0
*v1.14 lcMsg = SPACE(1000)
*v1.14 lnLen = 1000
*v1.14 lnRes = InternetGetLastResponseInfo( @lnErr2, @lcMsg, @lnLen )
*v1.14 IF lnRes=0
*v1.14 lnErr = GetLastError() && Sep 9, 2005
*v1.14 lcStatus = lcStatus + CHR(13) + '(Error getting last response: '+TRANSFORM(lnErr)+')'
*v1.14 ELSE
*v1.14 lcStatus = lcStatus + CHR(13) + 'Last response: '+TRANSFORM(lnErr2)+' '+LEFT(lcMsg,lnLen)
*v1.14 ENDIF

    if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
      =&pcOptFeedback
    else
      WAIT WINDOW lcStatus TIMEOUT 2
    endif
    InternetCloseHandle( lhInternetSession ) && LASv11.01/LWMv10.44 wgcs
    RETURN .null.
  ENDIF

  lcStatus = "URL Opened"
  if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
    =&pcOptFeedback
  ENDIF
ENDIF

* 01/26/2005: wgcs: try to get the size of the resource:
lcBuf = REPLICATE(' ',40)
lnBufLen = 40
lnVoid = 0
lnQryRet = HttpQueryInfo( lhUrlFile, HTTP_QUERY_CONTENT_LENGTH, ;
               @lcBuf, @lnBufLen, @lnVoid )
IF lnQryRet=1
  lnSize = VAL(lcBuf)
* lnSize = buf2dword(lcBuf)
ENDIF
**

lcRetVal = ""
llOk = .t.
llCancel = .F.
lnTotalBytesRead = 0
lnBytesRead = 0
lcReadBuffer = ''

lcStatus = "Starting to Read File..."
if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
  =&pcOptFeedback
endif

* Clear output file, if it exists.
if type('pcOptOutputFile')='C' and ADIR(laDr,pcOptOutputFile)>0
  DELETE FILE (pcOptOutputFile)
endif

DO WHILE llOK and NOT llCancel
   * set aside a big buffer
   lcReadBuffer = SPACE(iif(VarType(pnOptBuffSize)='N',pnOptBuffSize,32767))
   lnBytesRead = 0
   lnOK = InternetReadFile( lhUrlFile, @lcReadBuffer, LEN(lcReadBuffer), @lnBytesRead)

   lnTotalBytesRead = lnTotalBytesRead + lnBytesRead

   if ( lnBytesRead > 0 )
      if type('pcOptOutputFile')='C'
        StrToFile(left(lcReadBuffer,lnBytesRead),pcOptOutputFile,.T.) && Add to file.
      else
        lcRetVal = lcRetVal + left( lcReadBuffer, lnBytesRead )
      endif
   endif

   * error trap - either a read failure or read past eof()
   llOk = ( lnOK = 1 ) and ( lnBytesRead > 0 )

   lnBytesAvail = 0
   lnRes1 = 0
   lnRes2 = 0
   lnOk = InternetQueryDataAvailable( lhUrlFile, @lnBytesAvail, @lnRes1, @lnRes2 )
*!* INTEGER HINTERNET_hFile, ;
*!* LONG @ LPDWORD_lpdwNumberOfBytesAvailable, ;
*!* LONG @ DWORD_dwFlags, ;
*!* LONG @ DWORD_dwContext
   if lnOK=1
     lnApparentSize = lnTotalBytesRead+lnBytesAvail
   endif

   if vartype(pcOptFeedback)='C'
     lcStatus = "Reading File..."
     if not &pcOptFeedback
       llCancel = .T.
     endif
   endif
ENDDO

* close all the handles we opened
InternetCloseHandle( lhUrlFile )
if lhConnect>0
  InternetCloseHandle( lhConnect )
endif
InternetCloseHandle( lhInternetSession )

lcStatus = "Finished Reading"
if VarType(pcOptFeedback)='C' && Call the feedback at the zero mark
  =&pcOptFeedback
endif

* IF saving to file, return Success status.
if type('pcOptOutputFile')='C'
  RETURN NOT llCancel
endif
* return the URL contents
RETURN lcRetVal


FUNCTION buf2dword(lcBuffer)
  RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
      BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
      BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
      BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
ENDFUNC

It may also be worth looking at cURL which has very good support of protocols

http://fox.wikis.com/wc.dll?Wiki~Curl~VFP
Contributors: wgcs Anatoliy Mogylevets
Category Code Samples Category Windows API
( Topic last updated: 2006.04.21 04:59:00 AM )