"Закон постоянства скорости падения человеческого организма: ""Скорость падения человека с любой высоты постоянна, 1 ****ь. 100 этажей - ***-а-а-а-а-а-а-а-а-а-а-а-а-а-а-а-а-дь!, с табуретки - ****ь!"""
* 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
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"
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
* 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
And another one: URLDownload To Cache File creates a cache file and returns its name.
FUNCTION DownloadUrl(cRemote)
LOCAL nResult, cTargetFile
cTargetFile = Repli(Chr(0), 250)
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 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
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
* 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) )
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
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
**
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 )
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