1506 lines
42 KiB
Plaintext
1506 lines
42 KiB
Plaintext
#INCLUDE "wconnect.h"
|
|
|
|
*** Load Library
|
|
SET PROCEDURE TO wwHTTP ADDIT
|
|
|
|
*** Load Dependencies
|
|
SET PROCEDURE TO wwUtils ADDIT
|
|
|
|
*************************************************************
|
|
DEFINE CLASS wwHTTP AS Custom
|
|
*************************************************************
|
|
*: Author: Rick Strahl
|
|
*: (c) West Wind Technologies, 2000
|
|
*:Contact: http://www.west-wind.com
|
|
*************************************************************
|
|
#IF .F.
|
|
*:Help Documentation
|
|
*:Topic:
|
|
Class wwHTTP
|
|
|
|
*:Description:
|
|
A standalone HTTP client library. Same HTTP interfaces
|
|
as wwIPStuff, but provided here for lighter environment.
|
|
|
|
*:Example:
|
|
|
|
*:Remarks:
|
|
Requires wwIPStuff.dll for URLEncoding and Decoding of
|
|
strings larger than 80 characters.
|
|
|
|
*:SeeAlso:
|
|
|
|
*:ENDHELP
|
|
#ENDIF
|
|
**************************************************************
|
|
PROTECTED cdllpath
|
|
cdllpath = ""
|
|
|
|
*-- Last Error Message Text for the last operation. Implemented only for SMTP and HTTP operations.
|
|
cerrormsg = ""
|
|
|
|
*-- Password to log on to server (applies to FTP and HTTP)
|
|
cpassword = ""
|
|
|
|
*-- Username for log in operations (FTP and HTTP).
|
|
cusername = ""
|
|
|
|
*-- Determines whether SSL is used
|
|
lsecurelink = .F.
|
|
|
|
*-- Connection timeout for Connection, Send and Read operations
|
|
*-- if any take longer than the number of seconds here operation will abort
|
|
nconnecttimeout = 5000
|
|
|
|
PROTECTED hIPSession, hhttpsession
|
|
hhttpsession = 0
|
|
hipsession = 0
|
|
|
|
*-- The last error code.
|
|
nerror = 0
|
|
|
|
*-- Allows to specify how the connection is opened: 1 - Direct*, 3 - Proxy (IE 4 and later) and 0 - PreConfig (using IE settings)
|
|
nhttpconnecttype = 1
|
|
|
|
*-- HTTP Server Address. Format: www.west-wind.com, or 111.111.111.111
|
|
cserver = ""
|
|
|
|
*-- HTTP Link to visit on a site. Site relative URL. Example: /default.asp, /, /wconnect.dll?wwDemo~TestPage
|
|
clink = ""
|
|
|
|
*-- The port to use for HTTP Connections. If the default value of 0 is used, the HTTP and HTTPS default ports (80 and 443) are used.
|
|
nhttpport = 0
|
|
|
|
*-- Size of the download HTTP buffer used while downloading dynamically sized requests with HTTPGetEx. This is the size of chunks that will be pulled at a time and also determines how often OnHTTPBufferUpdate is called.
|
|
nhttpworkbuffersize = 4096
|
|
|
|
*-- This property is set when calling HTTPGetEx and contains the entire HTTP header of a request
|
|
chttpheaders = ""
|
|
|
|
cUserAgent = "West Wind Internet Protocols 4.20"
|
|
|
|
*-- Flag that can be set in OnHTTPBufferUpdate to allow cancellation of the current HTTP download
|
|
lhttpcanceldownload = .F.
|
|
|
|
*-- HTTP Post mode determines how requests are posted to the server. 1 - Form URLEncoded (default) 2 - Multipart forms. This property must be set prior to calling AddPostKey and HTTPGetEx
|
|
nhttppostmode = 1
|
|
|
|
*** The POST buffer used internally
|
|
cPostBuffer = ""
|
|
|
|
*-- Version of the wwIPStuff library. This value should match the DLL Version number.
|
|
cversion = "4.10"
|
|
|
|
*-- String that specifies the name or IP address of the proxy server and its port.
|
|
chttpproxyname = ""
|
|
|
|
*-- Address of a string variable that contains an optional list of host names or IP addresses, or both, that should not be routed through the proxy
|
|
chttpproxybypass = ""
|
|
|
|
*-- Proxy Authentication info (make sure you use nHTTPConnectType=3)
|
|
chttpProxyUserName = ""
|
|
chttpProxyPassword = ""
|
|
|
|
*-- Optional flags used for InternetOpen calls.
|
|
nserviceflags = 0
|
|
nHttpServiceFlags = 0
|
|
|
|
************************************************************************
|
|
* wwHTTP :: Init
|
|
*********************************
|
|
*** Function: Loads the DLL
|
|
*** Pass: lcPath - Path where to find the DLL. If "" is used
|
|
*** SYSTEM path or local is assumed. Path must
|
|
*** be terminated with a trailing backslash
|
|
************************************************************************
|
|
FUNCTION INIT
|
|
LPARAMETER lcPath
|
|
|
|
#IF .F.
|
|
WAIT WINDOW NOWAIT ;
|
|
"Welcome to West Wind Internet Protocols..." + CHR(13) + ;
|
|
"This is a shareware copy of wwHTTP." + CHR(13)+ CHR(13) +;
|
|
"Please register your copy."
|
|
#ENDIF
|
|
|
|
lcPath=IIF(VARTYPE(lcPath)="C",lcPath,"")
|
|
|
|
THIS.cdllpath=lcPath+"wwIPStuff.dll"
|
|
|
|
DECLARE INTEGER GetLastError;
|
|
IN WIN32API
|
|
|
|
DO PATH WITH lcPath
|
|
RETURN
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: AddPostKey
|
|
*********************************
|
|
*** Function: Adds POST variables to the HTTP request
|
|
*** Assume: depends on nHTTPPostMode setting
|
|
*** Pass:
|
|
*** Return:
|
|
************************************************************************
|
|
FUNCTION AddPostKey
|
|
LPARAMETERS tcKey, tcValue, llFileName
|
|
|
|
LOCAL lcOldAlias
|
|
tcKey=IIF(VARTYPE(tcKey)="C",tcKey,"")
|
|
tcValue=IIF(VARTYPE(tcValue)="C",tcValue,"")
|
|
|
|
lcOldAlias=ALIAS()
|
|
|
|
IF tcKey="RESET" OR PCOUNT() = 0
|
|
THIS.cPostBuffer = ""
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF !EMPTY(tcKey)
|
|
*** Regular URLEncoded format
|
|
* THIS.cPostBuffer= && No good for buffers over 1meg
|
|
DO CASE
|
|
CASE THIS.nhttppostmode = 1
|
|
THIS.cPostBuffer = THIS.cPostBuffer + tcKey +;
|
|
"="+URLEncode(tcValue)+ "&"
|
|
OTHERWISE
|
|
*** Multi-part formvars and file
|
|
|
|
*** Check for File Flag - HTTP File Upload - Second parm is filename
|
|
IF llFileName
|
|
THIS.cPostBuffer = THIS.cPostBuffer + ;
|
|
"--" + MULTIPART_BOUNDARY + CR + ;
|
|
[Content-Disposition: form-data; name="]+tcKey+[" filename="] + tcValue + ["]+CR+CR+;
|
|
FILETOSTR(tcValue) + CR
|
|
ELSE
|
|
THIS.cPostBuffer = THIS.cPostBuffer + ;
|
|
"--" + MULTIPART_BOUNDARY + CR + ;
|
|
[Content-Disposition: form-data; name="]+tcKey+["]+CR+CR+;
|
|
tcValue+CR
|
|
ENDIF
|
|
ENDCASE
|
|
ELSE
|
|
*** Raw non-encoded post - Add "-" to buffer to
|
|
*** allow binary data to be posted without truncation
|
|
THIS.cPostBuffer = THIS.cPostBuffer + tcValue
|
|
ENDIF
|
|
|
|
ENDFUNC
|
|
|
|
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: HTTPConnect
|
|
*********************************
|
|
*** Function: Connect to an HTTP server.
|
|
*** Assume: Sets two handle values in this class Each
|
|
*** instance of this class can only manage
|
|
*** one HTTP session at a time. Use this low
|
|
*** level function for quick repeated access
|
|
*** to HTTP pages.
|
|
*** Pass: lcServer - Server name
|
|
*** lcUsername - Optional Username
|
|
*** lcPassword - Optional Password
|
|
*** llHTTPS - .T. for secure connections
|
|
*** Return: 0 on success or WinAPI Errorcode
|
|
********************************************************
|
|
FUNCTION HTTPConnect
|
|
LPARAMETER lcServer, lcUserName, lcPassword, llHTTPS
|
|
LOCAL lhIP, lhHTTP, lnError, lnHTTPPort
|
|
|
|
lcServer=TRIM(IIF(!EMPTY(lcServer),lcServer,THIS.cserver))
|
|
lcUserName=TRIM(IIF(!EMPTY(lcUserName),lcUserName,THIS.cusername))
|
|
lcPassword=TRIM(IIF(!EMPTY(lcPassword),lcPassword,THIS.cpassword))
|
|
|
|
*** Assign Default Ports
|
|
IF THIS.nhttpport = 0
|
|
lnHTTPPort = IIF(llHTTPS or THIS.lSecureLink,;
|
|
INTERNET_DEFAULT_HTTPS_PORT,;
|
|
INTERNET_DEFAULT_HTTP_PORT)
|
|
ELSE
|
|
lnHTTPPort = THIS.nhttpport
|
|
ENDIF
|
|
|
|
THIS.lsecurelink = llHTTPS OR THIS.lsecurelink
|
|
|
|
THIS.cserver = lcServer
|
|
|
|
THIS.nerror=0
|
|
THIS.cerrormsg=""
|
|
|
|
DECLARE INTEGER InternetCloseHandle ;
|
|
IN WinInet.DLL ;
|
|
INTEGER
|
|
|
|
DECLARE INTEGER GetLastError;
|
|
IN WIN32API
|
|
|
|
DECLARE INTEGER InternetOpen ;
|
|
IN WININET.DLL ;
|
|
STRING,;
|
|
INTEGER,;
|
|
STRING, STRING, INTEGER
|
|
|
|
*** Force to Proxy Operation
|
|
IF !EMPTY(THIS.cHttpProxyName)
|
|
THIS.nHTTPConnectType = 3 && Proxy
|
|
ENDIF
|
|
|
|
hInetConnection=;
|
|
InternetOpen(THIS.cUserAgent,;
|
|
THIS.nhttpconnecttype,;
|
|
THIS.chttpproxyname,THIS.chttpproxybypass,0)
|
|
|
|
IF hInetConnection = 0
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg(THIS.nerror)
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
THIS.hipsession=hInetConnection
|
|
|
|
DECLARE INTEGER InternetConnect ;
|
|
IN WININET.DLL ;
|
|
INTEGER hIPHandle,;
|
|
STRING lpzServer,;
|
|
INTEGER dwPort, ;
|
|
STRING lpzUserName,;
|
|
STRING lpzPassword,;
|
|
INTEGER dwServiceFlags,;
|
|
INTEGER dwFlags,;
|
|
INTEGER dwReserved
|
|
|
|
|
|
lhHTTPSession=;
|
|
InternetConnect(hInetConnection,;
|
|
lcServer,;
|
|
lnHTTPPort,;
|
|
lcUserName,;
|
|
lcPassword,;
|
|
INTERNET_SERVICE_HTTP,;
|
|
THIS.nserviceflags,0)
|
|
|
|
|
|
IF (lhHTTPSession = 0)
|
|
=InternetCloseHandle(hInetConnection)
|
|
THIS.nerror = GetLastError()
|
|
THIS.cerrormsg = THIS.getsystemerrormsg()
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
THIS.hhttpsession = lhHTTPSession
|
|
|
|
RETURN 0
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: HTTPClose
|
|
*********************************
|
|
*** Function: Closes an HTTP Session.
|
|
*** Return: nothing
|
|
********************************************************
|
|
FUNCTION httpclose
|
|
|
|
DECLARE INTEGER InternetCloseHandle ;
|
|
IN WININET.DLL ;
|
|
INTEGER hIPSession
|
|
|
|
*** Always clear the POST buffer
|
|
THIS.cPostBuffer = ""
|
|
|
|
IF THIS.hHTTPSession # 0
|
|
InternetCloseHandle(THIS.hhttpsession)
|
|
THIS.hhttpsession=0
|
|
ENDIF
|
|
IF THIS.hipSession # 0
|
|
InternetCloseHandle(THIS.hipsession)
|
|
THIS.hipsession=0
|
|
ENDIF
|
|
|
|
ENDFUNC
|
|
|
|
************************************************************************
|
|
* wwHTTP :: HTTPGet
|
|
****************************************
|
|
*** Function:
|
|
*** Assume:
|
|
*** Pass:
|
|
*** Return:
|
|
************************************************************************
|
|
FUNCTION HTTPGet()
|
|
LPARAMETERS lcUrl, lcUserName, lcPassword
|
|
LOCAL lnError, lnSize, lcBuffer, szHead, loUrl, llHTTPS, lnResult,;
|
|
hInetConnection, hHTTPResult
|
|
|
|
THIS.nerror = 0
|
|
THIS.cerrormsg = ""
|
|
|
|
IF VARTYPE(lcUserName) = "N"
|
|
tnBufferSize=lcUserName
|
|
lcUserName = ""
|
|
lcPassword = ""
|
|
ELSE
|
|
tnBufferSize = 0
|
|
lcUserName=IIF(EMPTY(lcUserName),"",lcUserName)
|
|
lcPassword=IIF(EMPTY(lcPassword),"",lcPassword)
|
|
ENDIF
|
|
|
|
|
|
loUrl = THIS.InternetCrackUrl(lcUrl)
|
|
IF ISNULL(loUrl)
|
|
THIS.nError = -1
|
|
THIS.cerrormsg = "Invalid URL passed."
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
llHTTPS = IIF(LOWER(loUrl.cProtocol)="https",.T.,.F.)
|
|
THIS.nHttpPort=VAL(loUrl.cPort)
|
|
|
|
lnResult = THIS.HTTPConnect(loUrl.cserver,lcUserName,lcPassword,llHTTPS)
|
|
IF lnResult # 0
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
IF tnBufferSize # 0
|
|
lcData=SPACE(tnBufferSize)
|
|
lnSize=tnBufferSize
|
|
ELSE
|
|
lcData = ""
|
|
lnSize = 0
|
|
ENDIF
|
|
|
|
|
|
lnResult = THIS.HTTPGetEx(loUrl.cPath + loUrl.cQueryString,@lcData,@lnSize)
|
|
|
|
THIS.HTTPClose()
|
|
|
|
IF lnResult # 0
|
|
THIS.cerrormsg = THIS.cerrormsg
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
RETURN lcData
|
|
ENDFUNC
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: HTTPGetEx
|
|
*********************************
|
|
*** Function: Retrieves an HTTP request from the
|
|
*** network and returns a string. Read an
|
|
*** HTML or data file across the net.
|
|
*** Assume: Blocking call - waits for completion
|
|
*** before returning. Use AddPostKey
|
|
*** to post data to server
|
|
*** Must call HTTPConnect/HTTPClose to
|
|
*** manage connection to Server.
|
|
*** Pass: tcURL - URL to retrieve
|
|
*** tcBuffer - HTTP result (by Reference)
|
|
*** tnBufferSize - Size of the buffer (ref)
|
|
*** tcHeaders - HTTP Headers sent from
|
|
*** client request. Separate
|
|
*** key:value pairs with CR
|
|
*** tcFileName - Optional filename to save
|
|
*** content to to avoid keeping
|
|
*** the entire content in memory
|
|
*** Return: WinAPI Error Code (check THIS.cErrorMsg)
|
|
*******************************************************
|
|
FUNCTION HTTPGetEx
|
|
LPARAMETERS tcPage, tcBuffer, tnBufferSize, tcHeaders, tcFileName
|
|
LOCAL hHTTPResult, lcOldAlias, lhFile
|
|
|
|
tcPage=IIF(EMPTY(tcPage),THIS.clink,tcPage)
|
|
tnBufferSize=IIF(VARTYPE(tnBufferSize)="N",;
|
|
tnBufferSize,LEN(tcPage))
|
|
|
|
lcOldAlias=ALIAS()
|
|
|
|
THIS.lhttpcanceldownload = .F.
|
|
|
|
THIS.clink = tcPage
|
|
|
|
IF !EMPTY(THIS.cPostBuffer)
|
|
IF THIS.nHTTPPostMode=1 AND RIGHT(THIS.cPostBuffer,1) = "&"
|
|
THIS.cPostbuffer = LEFT(THIS.cPostbuffer,LEN(THIS.cPostBuffer)-1)
|
|
ENDIF
|
|
tnPostSize=LEN(THIS.cPostBuffer)
|
|
lcPostBuffer= IIF(tnPostSize > 0,THIS.cPostBuffer,NULL)
|
|
ELSE
|
|
tnPostSize=0
|
|
lcPostBuffer=NULL
|
|
ENDIF
|
|
|
|
|
|
THIS.nerror=0
|
|
THIS.cerrormsg=""
|
|
|
|
DECLARE INTEGER HttpOpenRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzReqMethod,;
|
|
STRING lpzPage,;
|
|
STRING lpzVersion,;
|
|
STRING lpzReferer,;
|
|
STRING lpzAcceptTypes,;
|
|
INTEGER dwFlags,;
|
|
INTEGER dwContextw
|
|
|
|
*** Keep alive must be used for Proxies
|
|
IF !EMPTY(THIS.cHTTPProxyName) OR this.nHTTPConnectType = 3
|
|
THIS.nHTTPServiceFlags = THIS.nHTTPServiceFlags + INTERNET_FLAG_KEEP_CONNECTION
|
|
ENDIF
|
|
|
|
hHTTPResult=HttpOpenRequest(THIS.hhttpsession,;
|
|
IIF( tnPostSize > 0, "POST","GET"),;
|
|
tcPage,;
|
|
NULL,NULL,NULL,;
|
|
INTERNET_FLAG_RELOAD + ;
|
|
IIF(THIS.lsecurelink,INTERNET_FLAG_SECURE,0) + ;
|
|
this.nHTTPServiceFlags,0)
|
|
|
|
|
|
IF (hHTTPResult = 0)
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
THIS.wininetsettimeout(THIS.nConnectTimeOut,hHTTPResult)
|
|
|
|
THIS.hhttpsession=hHTTPResult
|
|
|
|
THIS.OnHttpPostConnect(hHTTPResult)
|
|
|
|
|
|
DECLARE INTEGER HttpSendRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzHeaders,;
|
|
INTEGER cbHeaders,;
|
|
STRING lpzPost,;
|
|
INTEGER cbPost
|
|
|
|
IF tnPostSize > 0
|
|
DO CASE
|
|
CASE THIS.nhttppostmode = 1
|
|
tcHeaders = "Content-Type: application/x-www-form-urlencoded" + CRLF +;
|
|
IIF(!EMPTY(tcHeaders),CRLF+tcHeaders,"")
|
|
CASE THIS.nhttppostmode = 2
|
|
tcHeaders = "Content-Type: multipart/form-data; boundary=" + MULTIPART_BOUNDARY + CRLF + CRLF +;
|
|
IIF(EMPTY(tcHeaders),"",tcHeaders)
|
|
|
|
*** NOTE: extra dashes required to simulate browser operation!
|
|
lcPostBuffer = lcPostBuffer + "--" + MULTIPART_BOUNDARY + CR
|
|
tnPostSize=LEN(lcPostBuffer)
|
|
CASE THIS.nhttppostmode = 4 && XML
|
|
tcHeaders="Content-Type: text/xml" + CRLF +;
|
|
IIF(EMPTY(tcHeaders),"",tcHeaders)
|
|
ENDCASE
|
|
* tcHeaders = tcHeaders + "Content-Length: " + TRANSFORM(tnPostSize) + CRLF
|
|
ELSE
|
|
tcHeaders = IIF(!EMPTY(tcHeaders),tcHeaders,"")
|
|
ENDIF
|
|
|
|
IF !EMPTY(THIS.cHTTPProxyUserName)
|
|
IF !THIS.SetProxyLogin()
|
|
RETURN THIS.nError
|
|
ENDIF
|
|
ENDIF
|
|
polog.Log('HttpSendRequest',Program())
|
|
lnRetval=0
|
|
lnRetval=HttpSendRequest(hHTTPResult,;
|
|
tcHeaders,LEN(tcHeaders),;
|
|
lcPostBuffer,tnPostSize)
|
|
|
|
IF lnRetval = 0
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
=InternetCloseHandle(hHTTPResult)
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
DECLARE INTEGER HttpQueryInfo ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
INTEGER nType,;
|
|
STRING @cHeaders,;
|
|
INTEGER @cbHeaderSize,;
|
|
STRING cNULL
|
|
|
|
*** Retrieve the HTTP Headers
|
|
polog.Log('HttpQueryInfo 1',Program())
|
|
lcHeaders = SPACE(1024)
|
|
lnHeaderSize = 1024
|
|
lnRetval = HttpQueryInfo(hHTTPResult,;
|
|
HTTP_QUERY_RAW_HEADERS_CRLF,;
|
|
@lcHeaders,@lnHeaderSize,NULL)
|
|
THIS.chttpheaders = TRIM(STRTRAN(lcHeaders,CHR(0),""))
|
|
|
|
*** Check the HTTP Result Code
|
|
lcHeaders = SPACE(7)
|
|
lnHeaderSize = 6
|
|
polog.Log('HttpQueryInfo 2',Program())
|
|
lnRetval = HttpQueryInfo(hHTTPResult,;
|
|
HTTP_QUERY_STATUS_CODE,;
|
|
@lcHeaders,@lnHeaderSize,NULL)
|
|
lcResultCode = TRIM(STRTRAN(lcHeaders,CHR(0),""))
|
|
|
|
IF lcResultCode # "200"
|
|
lcHeaders = SPACE(256)
|
|
lnHeaderSize = 255
|
|
lnRetval = HttpQueryInfo(hHTTPResult,;
|
|
HTTP_QUERY_STATUS_TEXT,;
|
|
@lcHeaders,@lnHeaderSize,NULL)
|
|
THIS.nerror=VAL(lcResultCode)
|
|
THIS.cErrorMsg = TRIM(STRTRAN(lcHeaders,CHR(0),""))
|
|
=InternetCloseHandle(hHTTPResult)
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
|
|
*** Call HTTP Event method
|
|
polog.Log('OnHTTPBufferUpdate',Program())
|
|
THIS.OnHTTPBufferUpdate(0,0,THIS.chttpheaders)
|
|
|
|
DECLARE INTEGER InternetReadFile ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING @lcBuffer,;
|
|
INTEGER cbBuffer,;
|
|
INTEGER @cbBuffer
|
|
|
|
polog.Log('InternetReadFile',Program())
|
|
IF tnBufferSize > 0
|
|
*** Use Fixed Buffer Size
|
|
tcBuffer=SPACE(tnBufferSize)
|
|
lnBufferSize=tnBufferSize
|
|
lnRetval=InternetReadFile(hHTTPResult,;
|
|
@tcBuffer,;
|
|
tnBufferSize,;
|
|
@tnBufferSize)
|
|
ELSE
|
|
*** If a filename was specified output to the file instead of string
|
|
IF !EMPTY(tcFileName)
|
|
lhFile = FCREATE(tcFileName)
|
|
IF lhFile = -1
|
|
THIS.nerror=1
|
|
THIS.cerrormsg="Couldn't create output file"
|
|
=InternetCloseHandle(hHTTPResult)
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
ENDIF
|
|
|
|
*** Build the buffer dynamically
|
|
tcBuffer = ""
|
|
tnSize = 0
|
|
lnRetval = 0
|
|
lnBytesRead = 1
|
|
lnBufferReads = 0
|
|
DO WHILE .T.
|
|
lcReadBuffer = SPACE(THIS.nhttpworkbuffersize)
|
|
lnBytesRead = 0
|
|
lnSize = LEN(lcReadBuffer)
|
|
|
|
lnRetval=InternetReadFile(hHTTPResult,;
|
|
@lcReadBuffer,;
|
|
lnSize,;
|
|
@lnBytesRead)
|
|
|
|
IF lnRetval = 1 AND lnBytesRead > 0
|
|
*** Update the input parameters - result buffer and size of buffer
|
|
IF EMPTY(tcFileName)
|
|
*** Build string
|
|
tcBuffer = tcBuffer + LEFT(lcReadBuffer,lnBytesRead)
|
|
ELSE
|
|
*** Write to file
|
|
FWRITE(lhFile,lcReadBuffer,lnBytesRead)
|
|
ENDIF
|
|
tnBufferSize = tnBufferSize + lnBytesRead
|
|
lnBufferReads = lnBufferReads + 1
|
|
THIS.OnHTTPBufferUpdate(tnBufferSize,lnBufferReads,@lcReadBuffer)
|
|
ENDIF
|
|
IF THIS.lhttpcanceldownload
|
|
tcBuffer = "Error: Download canceled"
|
|
tnBufferSize = LEN(tcBuffer)
|
|
THIS.nError = -2
|
|
THIS.cErrorMsg = "Download Cancelled"
|
|
EXIT
|
|
ENDIF
|
|
IF (lnRetval = 1 AND lnBytesRead = 0) OR (lnRetval = 0)
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
lnBufferSize = tnBufferSize
|
|
|
|
IF !EMPTY(tcFileName)
|
|
FCLOSE(lhFile)
|
|
ENDIF
|
|
|
|
THIS.OnHTTPBufferUpdate(0,-1,"")
|
|
ENDIF
|
|
|
|
IF lnRetval = 0
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
ENDIF
|
|
|
|
=InternetCloseHandle(hHTTPResult);
|
|
|
|
tcBuffer = (IIF(tnBufferSize > 1 AND tnBufferSize <= lnBufferSize,SUBSTR(tcBuffer,1,tnBufferSize),""))
|
|
|
|
RETURN THIS.nerror
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: HTTPGetAsync
|
|
*********************************
|
|
*** Function: Sends an HTTP request but doesn't wait for completion.
|
|
*** You can use this one for stress testing. Each request
|
|
*** fires off a new thread so make sure you let the
|
|
*** thread count catch up before overrunning your machine.
|
|
*** Why - use for stress testing.
|
|
*** Pass: lcUrl - Location to open
|
|
*** Return: nothing
|
|
************************************************************************
|
|
FUNCTION httpgetasync
|
|
LPARAMETERS lcUrl
|
|
lcUrl=IIF(TYPE("lcUrl")="C",lcUrl,"")
|
|
|
|
DECLARE INTEGER HTTPGetAsync ;
|
|
IN (THIS.cDLLPath) ;
|
|
STRING cURL
|
|
|
|
HTTPGetAsync(lcUrl)
|
|
RETURN
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: HTTPGetHeader
|
|
*********************************
|
|
*** Function: Retrieves just the HTTP header of a page request.
|
|
*** Assume: Must call HTTPConnect/HTTPClose to manage connection
|
|
*** to Server
|
|
*** Pass: tcPage - The Server relative page to view
|
|
*** tcHeader - Buffer to receive headers (by reference)
|
|
*** tnSize - Size of the Buffer (by Reference)
|
|
*** Return: Win32API Error Code
|
|
************************************************************************
|
|
LPARAMETERS tcPage, tcHeaders, tnHeaderSize
|
|
LOCAL lnError, lnSize, lcBuffer
|
|
|
|
tcHeaders=IIF(TYPE("tcHeaders")="C",tcHeaders,"")
|
|
tnHeaderSize=IIF(TYPE("tnHeaderSize")="N",tnHeaderSize,2048)
|
|
|
|
IF !EMPTY(THIS.cPostBuffer)
|
|
tnPostSize=LEN(THIS.cPostBuffer)
|
|
lcPostBuffer= IIF(tnPostSize > 0,THIS.cPostBuffer,NULL)
|
|
ELSE
|
|
tnPostSize=0
|
|
lcPostBuffer=NULL
|
|
ENDIF
|
|
|
|
DECLARE INTEGER HttpOpenRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzReqMethod,;
|
|
STRING lpzPage,;
|
|
STRING lpzVersion,;
|
|
STRING lpzReferer,;
|
|
STRING lpzAcceptTypes,;
|
|
INTEGER dwFlags,;
|
|
INTEGER dwContextw
|
|
|
|
hHTTPResult=HttpOpenRequest(THIS.hhttpsession,;
|
|
IIF( tnPostSize > 0, "POST","GET"),;
|
|
tcPage,;
|
|
NULL,NULL,NULL,;
|
|
INTERNET_FLAG_RELOAD + IIF(THIS.lsecurelink,INTERNET_FLAG_SECURE,0),0)
|
|
|
|
|
|
IF (hHTTPResult = 0)
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
|
|
DECLARE INTEGER HttpSendRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzHeaders,;
|
|
INTEGER cbHeaders,;
|
|
STRING lpzPost,;
|
|
INTEGER cbPost
|
|
|
|
lcHeaders=TRIM(tcHeaders)
|
|
|
|
lnRetval=HttpSendRequest(hHTTPResult,;
|
|
lcHeaders,LEN(lcHeaders),;
|
|
lcPostBuffer,tnPostSize)
|
|
|
|
IF lnRetval = 0
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
DECLARE INTEGER HttpQueryInfo ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
INTEGER nType,;
|
|
STRING @cHeaders,;
|
|
INTEGER @cbHeaderSize,;
|
|
STRING cNULL
|
|
|
|
lnRetval = HttpQueryInfo(hHTTPResult,;
|
|
HTTP_QUERY_RAW_HEADERS_CRLF,;
|
|
@tcHeaders,@tnHeaderSize,NULL)
|
|
IF (lnRetval = 0)
|
|
THIS.nerror=GetLastError()
|
|
THIS.cerrormsg=THIS.getsystemerrormsg()
|
|
RETURN THIS.nerror
|
|
ENDIF
|
|
|
|
InternetCloseHandle(hHTTPResult);
|
|
|
|
tcHeaders = (IIF(tnHeaderSize > 1,SUBSTR(tcHeaders,1,tnHeaderSize-1),""))
|
|
|
|
RETURN lnError
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: HTTPGetExAsync
|
|
*********************************
|
|
*** Function: Retrieves an HTTP request from the
|
|
*** network asynchronously. This means the
|
|
*** request fires and returns immediately
|
|
*** without an error code. Operation runs on
|
|
*** new thread in the background after returing
|
|
*** control to VFP.
|
|
***
|
|
*** This method is fully self contained.
|
|
*** You don't need to call HTTPOpen or HTTPClose.
|
|
***
|
|
*** This method allows full configuration
|
|
*** of the request with: POST data, SSL,
|
|
*** Passwords and creation of an output
|
|
*** file.
|
|
***
|
|
*** Use AddPostKey to add POST vars. Use lSecureLink
|
|
*** to enable SSL operation. Use cUserName and cPassword
|
|
*** for passwords.
|
|
***
|
|
*** Output file option allows for async
|
|
*** downloads and later checking for a result.
|
|
*** Using a timer it's possible to fire 'events'
|
|
*** when the download is complete.
|
|
***
|
|
*** Pass: tcURL - Server relative link (/default.asp)
|
|
*** tcResultFile - File where result get stored to
|
|
*** Make sure this is file unique...
|
|
*** tnResultSize - If you're saving the result you
|
|
*** can use this to specify the size
|
|
*** Default is a small 256 (used for
|
|
*** not checking results).
|
|
*** Used: lSecureLink, cUserName, cPassword, AddPostKey()
|
|
*** Return: nothing
|
|
*** If tcResultFile is passed you can check
|
|
*** for this file. On success you'll get the
|
|
*** document. On failure you get:
|
|
*** Error: <nAPIErrorCode>
|
|
*******************************************************
|
|
FUNCTION httpgetexasync
|
|
LPARAMETERS tcPage, tcResultFile, tnResultSize, tcHeaders
|
|
LOCAL hHTTPResult
|
|
|
|
*** Post Buffer and lSecureLink also apply via properties
|
|
tcServer=THIS.cserver
|
|
tcPage=IIF(EMPTY(tcPage),"/",tcPage)
|
|
tcUserName=THIS.cusername
|
|
tcPassword=THIS.cpassword
|
|
tcResultFile=IIF(EMPTY(tcResultFile),"",tcResultFile)
|
|
tnResultSize=IIF(EMPTY(tnResultSize),256,tnResultSize)
|
|
|
|
IF !EMPTY(THIS.cPostBuffer)
|
|
tnPostSize=LEN(THIS.cPostBuffer)
|
|
lcPostBuffer= IIF(tnPostSize > 0,THIS.cPostBuffer,NULL)
|
|
ELSE
|
|
tnPostSize=0
|
|
lcPostBuffer=NULL
|
|
ENDIF
|
|
|
|
|
|
IF tnPostSize > 0
|
|
IF EMPTY(tcHeaders)
|
|
IF THIS.nhttppostmode = 1
|
|
tcHeaders = "Content-Type: application/x-www-form-urlencoded" + CR+;
|
|
IIF(!EMPTY(tcHeaders),CR+tcHeaders,"")
|
|
ELSE
|
|
tcHeaders = "Content-Type: multipart/form-data; boundary=" + MULTIPART_BOUNDARY + CR + CR +;
|
|
IIF(EMPTY(tcHeaders),"",tcHeaders)
|
|
|
|
IF tnPostSize > 0
|
|
lcPostBuffer = lcPostBuffer + MULTIPART_BOUNDARY + CR
|
|
tnPostSize=LEN(lcPostBuffer)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
tcHeaders = IIF(!EMPTY(tcHeaders),tcHeaders,"")
|
|
ENDIF
|
|
|
|
lcOldAlias=ALIAS()
|
|
|
|
|
|
DECLARE HTTPGetExAsync ;
|
|
IN WWIPSTUFF.DLL ;
|
|
INTEGER hInternet,;
|
|
INTEGER hHTTP,;
|
|
STRING SERVER,;
|
|
STRING PAGE,;
|
|
STRING BUFFER,;
|
|
INTEGER BufferSize,;
|
|
STRING HEADER,;
|
|
STRING POST,;
|
|
INTEGER POSTSIZE,;
|
|
INTEGER SECURE,;
|
|
INTEGER CONNECTTYPE,;
|
|
STRING Username, STRING PASSWORD,;
|
|
STRING ResultFile,;
|
|
INTEGER ResultSize
|
|
|
|
tcBuffer = SPACE(256)
|
|
tnBufSize = LEN(tcBuffer)
|
|
lnRet = httpgetexasync(THIS.hipsession, THIS.hhttpsession,;
|
|
tcServer,;
|
|
tcPage,;
|
|
tcBuffer,tnBufSize,;
|
|
tcHeaders,;
|
|
lcPostBuffer, tnPostSize,;
|
|
IIF(THIS.lsecurelink,1,0),;
|
|
THIS.nhttpconnecttype,;
|
|
tcUserName, tcPassword,;
|
|
tcResultFile,tnResultSize)
|
|
|
|
*** Cause HTTPClose() to have no effect on these
|
|
*** handles - the C thread code will clean these up
|
|
THIS.hIPSession = 0
|
|
THIS.hHTTPSession = 0
|
|
|
|
RETURN
|
|
|
|
|
|
************************************************************************
|
|
* wwIPStuff :: HTTPGetHeader
|
|
*********************************
|
|
*** Function: Retrieves just the HTTP header of a page request.
|
|
*** Assume: Must call HTTPConnect/HTTPClose to manage connection
|
|
*** to Server
|
|
*** Pass: tcPage - The Server relative page to view
|
|
*** tcHeader - Buffer to receive headers (by reference)
|
|
*** tnSize - Size of the Buffer (by Reference)
|
|
*** Return: Win32API Error Code
|
|
************************************************************************
|
|
FUNCTION HTTPGetHeader
|
|
LPARAMETERS tcPage, tcHeaders, tnHeaderSize
|
|
LOCAL lnError, lnSize, lcBuffer
|
|
|
|
tcHeaders=IIF(TYPE("tcHeaders")="C",tcHeaders,"")
|
|
tnHeaderSize=IIF(TYPE("tnHeaderSize")="N",tnHeaderSize,2048)
|
|
|
|
IF USED("wwPostBuffer")
|
|
SELE wwPostBuffer
|
|
tnPostSize=LEN(wwPostBuffer.cPostBuffer)
|
|
lcPostBuffer= IIF(tnPostSize > 0,wwPostBuffer.cPostBuffer,NULL)
|
|
ELSE
|
|
tnPostSize=0
|
|
lcPostBuffer=NULL
|
|
ENDIF
|
|
|
|
DECLARE INTEGER HttpOpenRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzReqMethod,;
|
|
STRING lpzPage,;
|
|
STRING lpzVersion,;
|
|
STRING lpzReferer,;
|
|
STRING lpzAcceptTypes,;
|
|
INTEGER dwFlags,;
|
|
INTEGER dwContextw
|
|
|
|
hHTTPResult=HttpOpenRequest(THIS.hHTTPSession,;
|
|
IIF( tnPostSize > 0, "POST","GET"),;
|
|
tcPage,;
|
|
NULL,NULL,NULL,;
|
|
INTERNET_FLAG_RELOAD + IIF(THIS.lSecureLink,INTERNET_FLAG_SECURE,0),0)
|
|
|
|
|
|
IF (hHTTPResult = 0)
|
|
THIS.nError=GetLastError()
|
|
THIS.cErrorMsg=THIS.GetSystemErrorMsg()
|
|
RETURN THIS.nError
|
|
ENDIF
|
|
|
|
|
|
DECLARE INTEGER HttpSendRequest ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
STRING lpzHeaders,;
|
|
INTEGER cbHeaders,;
|
|
STRING lpzPost,;
|
|
INTEGER cbPost
|
|
|
|
lcHeaders=TRIM(tcHeaders)
|
|
|
|
lnRetval=HttpSendRequest(hHTTPResult,;
|
|
lcHeaders,LEN(lcHeaders),;
|
|
lcPostBuffer,tnPostSize)
|
|
|
|
IF lnRetval = 0
|
|
THIS.nError=GetLastError()
|
|
THIS.cErrorMsg=THIS.GetSystemErrorMsg()
|
|
RETURN THIS.nError
|
|
ENDIF
|
|
|
|
DECLARE INTEGER HttpQueryInfo ;
|
|
IN WININET.DLL ;
|
|
INTEGER hHTTPHandle,;
|
|
INTEGER nType,;
|
|
STRING @cHeaders,;
|
|
INTEGER @cbHeaderSize,;
|
|
STRING cNULL
|
|
|
|
lnRetval = HttpQueryInfo(hHTTPResult,;
|
|
HTTP_QUERY_RAW_HEADERS_CRLF,;
|
|
@tcHeaders,@tnHeaderSize,NULL)
|
|
|
|
IF (lnRetval = 0)
|
|
THIS.nError=GetLastError()
|
|
THIS.cErrorMsg=THIS.GetSystemErrorMsg()
|
|
RETURN THIS.nError
|
|
ENDIF
|
|
|
|
InternetCloseHandle(hHTTPResult);
|
|
|
|
tcHeaders = (IIF(tnHeaderSize > 1,SUBSTR(tcHeaders,1,tnHeaderSize-1),""))
|
|
|
|
RETURN lnRetVal
|
|
|
|
|
|
|
|
*-- Gets called whenever the buffer is updated on an HTTPGetEx update. Only applies if the buffer size is set to 0 (Automatic sizing)
|
|
FUNCTION OnHTTPBufferUpdate
|
|
LPARAMETER lnBytesDownloaded,lnBufferReads,lcCurrentChunk
|
|
ENDFUNC
|
|
|
|
*-- Event that fires in HttpGetEx calls after the Connection is established
|
|
*-- Can be used to set WinInet options or otherwise insert code to fire
|
|
*-- before the request is sent to the server
|
|
FUNCTION OnHttpPostConnect
|
|
LPARAMETERS lnHttpHandle
|
|
ENDFUNC
|
|
|
|
*-- Cancels an HTTPGetEx download if the buffer is sized dynamically
|
|
FUNCTION httpcanceldownload
|
|
THIS.lhttpcanceldownload = .T.
|
|
ENDFUNC
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: UnZipFiles
|
|
*********************************
|
|
*** Function: Unzips files to a specified directory
|
|
*** Assume: Requires DynaZip DLLs (dunzip32.dll)
|
|
*** Pass: lcZipFile
|
|
*** lcDestination - Dir to unzip to
|
|
*** lcFileSpec - Files to unzip (*.*)
|
|
*** Return: DynaZip Error Code or 0 on success
|
|
************************************************************************
|
|
FUNCTION UnZipFiles
|
|
LPARAMETERS lcZipFile, lcDestination, lcFileSpec
|
|
|
|
lcFileSpec=IIF(type("lcFileSpec")="C",lcFileSpec,"*.*")
|
|
lcDestination=IIF(type("lcDestination")="C",lcDestination,SYS(5) + CURDIR())
|
|
|
|
DECLARE INTEGER UnZip ;
|
|
IN (THIS.cDLLPath) ;
|
|
STRING ZipFile,;
|
|
STRING Destination,;
|
|
STRING FileSpec
|
|
|
|
RETURN UnZip(lcZipFile,lcDestination,lcFileSpec)
|
|
|
|
************************************************************************
|
|
* wwHTTP :: ZipFiles
|
|
*********************************
|
|
*** Function: Zips files
|
|
*** Assume: Function requires DynaZip DLLs (dzip32.dll)
|
|
*** Pass: lcZipFile - Fully qualified ZIP file name
|
|
*** lcFileList - Comma Delimited file list (Wildcards OK)
|
|
*** Return: DynaZip error code or 0
|
|
************************************************************************
|
|
FUNCTION ZipFiles
|
|
LPARAMETERS lcZipFile, lcFileList, lnCompression, llRecurse
|
|
|
|
lnCompression=IIF(type("lnCompression")="N",lnCompression,9)
|
|
|
|
DECLARE INTEGER Zip ;
|
|
IN (THIS.cDLLPath) ;
|
|
STRING ZipFile,;
|
|
STRING FileList,;
|
|
INTEGER lnCompression,;
|
|
INTEGER lnRecurse
|
|
|
|
RETURN Zip(lcZipFile,lcFileList,lnCompression,IIF(llRecurse,1,0))
|
|
|
|
************************************************************************
|
|
* wwHTTP :: DecodeDBF
|
|
*********************************
|
|
*** Function: Decodes a DBF file encoded EncodeDBF back into its
|
|
*** DBF/FPT format
|
|
*** Pass:
|
|
*** Return:
|
|
************************************************************************
|
|
FUNCTION DecodeDBF
|
|
LPARAMETERS lcBuffer,lcDBF
|
|
LOCAL lnSeparator, lcHeader, lcFname, lnSize1, lnSize2, lcDBF, lcFile1, lcFile2
|
|
|
|
IF LEN(lcBuffer)<105
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcHeader=SUBSTR(lcBuffer,1,105)
|
|
lcFname=TRIM(SUBSTR(lcBuffer,6,40))
|
|
lnSize1=VAL(SUBSTR(lcBuffer,46,10))
|
|
lnSize2=VAL(SUBSTR(lcBuffer,96,10))
|
|
|
|
*** Use parm or the filename specified in the header
|
|
lcDBF=IIF(EMPTY(lcDBF),lcFname,UPPER(lcDBF))
|
|
|
|
IF lcHeader # "wwDBF"
|
|
WAIT WINDOW NOWAIT "Invalid Decode File Header"
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
lcFile1=""
|
|
lcFile2=""
|
|
|
|
IF lnSize1 > 0
|
|
lcFile1=SUBSTR(lcBuffer,106,lnSize1)
|
|
IF LEN(lcFile1) < lnSize1
|
|
WAIT WINDOW NOWAIT "Invalid File Size: "+;
|
|
STR(LEN(lcFile1)) +" of "+ STR(lnSize1)
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
IF lnSize2 > 0
|
|
lcFile2=SUBSTR(lcBuffer,106 + lnSize1, lnSize2)
|
|
lnSizex=LEN(lcFile2)
|
|
IF LEN(lcFile2) < lnSize2 - 1
|
|
WAIT WINDOW NOWAIT "Invalid Memo File Size: " +;
|
|
STR(LEN(lcFile2)) +" of "+ STR(lnSize2)
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
=File2Var(lcDBF,lcFile1)
|
|
|
|
IF !EMPTY(lcFile2)
|
|
=File2Var(STRTRAN(lcDBF,".DBF",".FPT"),lcFile2)
|
|
ENDIF
|
|
|
|
RETURN .T.
|
|
|
|
ENDFUNC
|
|
* wwHTTP :: DecodeDBF
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: EncodeDBF
|
|
*********************************
|
|
*** Function: This function encodes a DBF file ready to
|
|
*** be sent up to a server using HTTPGetEx in
|
|
*** the POST buffer. The file will be URL
|
|
*** encoded.
|
|
*** Assume: Note you can send a ZIP file here, too!
|
|
*** 105 byte header on top of file contains
|
|
*** 5 byte ID (wwDBF) filename (40 bytes) and
|
|
*** size(10 bytes) for each file
|
|
*** Pass: lcDBF - Full DBF filename w/ ext
|
|
*** llHasMemo - .t. or (.f.)
|
|
*** Return: Encoded Buffer or "" on failure
|
|
********************************************************
|
|
FUNCTION EncodeDBF
|
|
LPARAMETERS lcDBF, llHasMemo, lcEncodedName
|
|
LOCAL lcBuffer1, lcBuffer2, lcDBF, lcHeader, lcFPT
|
|
|
|
lcDBF=IIF(VARTYPE(lcDBF)="C",UPPER(lcDBF),"")
|
|
IF EMPTY(lcEncodedName)
|
|
lcEncodedName = JUSTFNAME(lcDBF)
|
|
ENDIF
|
|
|
|
IF !FILE(lcDBF)
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
lcBuffer1=File2Var(lcDBF)
|
|
lcHeader = "wwDBF" + PADR(lcEncodedName,40) + ;
|
|
STR(LEN(lcBuffer1),10)
|
|
IF !llHasMemo
|
|
lcHeader=lcHeader+ SPACE(50) && Pad out header
|
|
RETURN lcHeader + lcBuffer1
|
|
ENDIF
|
|
|
|
lcFPT=STRTRAN(LOWER(lcDBF),".dbf",".fpt")
|
|
|
|
lcBuffer2=File2Var(lcFPT)
|
|
lcHeader=lcHeader + PADR(FORCEEXT(lcEncodedName,"fpt"),40) + ;
|
|
STR(LEN(lcBuffer2),10)
|
|
|
|
RETURN lcHeader + lcBuffer1 + lcBuffer2
|
|
ENDFUNC
|
|
|
|
************************************************************************
|
|
* wwHTTP :: SetProxyLogin
|
|
****************************************
|
|
*** Function: Sets the HTTP Proxy username and password
|
|
*** Assume: thanks to Erik Moore for providing this method
|
|
*** Pass: tcUserName
|
|
*** tcPassword
|
|
*** hIPHandle - HTTP Request handle (optional)
|
|
*** Return: .T. or .F.
|
|
************************************************************************
|
|
PROTECTED FUNCTION SetProxyLogin(tcUserName, tcPassword, hIPHandle)
|
|
|
|
LOCAL lcUsername, lcPassword, lpBuffer, lpdwBufferLength, nSuccess
|
|
|
|
lcUserName = IIF(!EMPTY(tcUserName),tcUserName,THIS.cHTTPProxyUserName)
|
|
lcPassword = IIF(!EMPTY(tcPassword),tcPassword,THIS.cHTTPProxyPassword)
|
|
hIPHandle = IIF(EMPTY(hIPHandle),THIS.hHTTPSession,hIPHandle)
|
|
|
|
IF EMPTY(lcUsername)
|
|
RETURN
|
|
ENDIF
|
|
|
|
DECLARE INTEGER InternetSetOption IN WinInet.dll ;
|
|
INTEGER hInternet, ;
|
|
INTEGER dwOption, ;
|
|
STRING @lpBuffer, ;
|
|
LONG lpdwBufferLength
|
|
|
|
INTERNET_OPTION_PROXY_USERNAME = 43
|
|
INTERNET_OPTION_PROXY_PASSWORD = 44
|
|
|
|
IF !EMPTY(lcUserName)
|
|
lpBuffer = lcUserName
|
|
dwBufferLength = LEN(lpBuffer)
|
|
dwOption = INTERNET_OPTION_PROXY_USERNAME
|
|
nSuccess = InternetSetOption(hIPHandle, dwOption, @lpBuffer, dwBufferLength)
|
|
IF nSuccess <> 1
|
|
THIS.nError = GetLastError()
|
|
THIS.cErrorMsg = THIS.GetSystemErrorMsg(THIS.nError)
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF !EMPTY(lcPassword)
|
|
lpBuffer = lcpassword
|
|
dwBufferLength = LEN(lpBuffer)
|
|
dwOption = INTERNET_OPTION_PROXY_PASSWORD
|
|
nSuccess = InternetSetOption(hIPHandle, dwOption, @lpBuffer, dwBufferLength)
|
|
IF nSuccess <> 1
|
|
THIS.nError = GetLastError()
|
|
THIS.cErrorMsg = THIS.GetSystemErrorMsg(THIS.nError)
|
|
RETURN .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN .T.
|
|
ENDFUNC
|
|
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: HTTPPing
|
|
****************************************
|
|
*** Function: Checks whether a site is up by a timeout value
|
|
*** Assume: IE 5.5 or later is installed
|
|
*** Pass: lnTimeout - in seconds
|
|
*** lcServer - (ie. www.west-wind.com)
|
|
*** lcLink - optional link to hit (/default.htm)
|
|
*** Return:
|
|
************************************************************************
|
|
FUNCTION httpping
|
|
LPARAMETER lnTimeout, lcServer, lcLink
|
|
LOCAL lcFile, llSuccess, lnHandle
|
|
|
|
IF EMPTY(lcLink)
|
|
lcLink = "/"
|
|
ENDIF
|
|
|
|
lnSaveTimeout = THIS.nConnectTimeout
|
|
THIS.nConnectTimeout = lnTimeout
|
|
|
|
lcResult = THIS.HTTPGet("http://" + lcServer + lcLink)
|
|
|
|
THIS.nConnectTimeout = lnSaveTimeout
|
|
|
|
IF THIS.nError = 0
|
|
RETURN .T.
|
|
ENDIF
|
|
|
|
RETURN .F.
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: InternetCrackUrl
|
|
*********************************
|
|
*** Function: Breaks out a URL into its component pieces
|
|
*** Pass: lcURL - URL to crack
|
|
*** Return: loUrl or NULL
|
|
************************************************************************
|
|
FUNCTION InternetCrackUrl
|
|
LPARAMETERS lcUrl
|
|
LOCAL lnAT, lcProtocol, lcQuerystring, lcPort, lcServer
|
|
|
|
*lcUrl = LOWER(lcUrl)
|
|
|
|
*** Find the querystring first
|
|
lnAT = AT("?",lcUrl)
|
|
IF lnAT > 0
|
|
lcQuerystring = SUBSTR(lcUrl,lnAT)
|
|
lcUrl = LEFT(lcUrl,lnAT-1)
|
|
ELSE
|
|
lcQuerystring = ""
|
|
ENDIF
|
|
|
|
lnAT = AT("://",lcUrl)
|
|
IF lnAT < 1
|
|
RETURN .NULL.
|
|
ENDIF
|
|
|
|
lcProtocol = lower(LEFT(lcUrl,lnAT-1))
|
|
DO CASE
|
|
CASE lcProtocol == "http"
|
|
lcPort = "80"
|
|
CASE lcProtocol == "https"
|
|
lcPort = "443"
|
|
CASE lcProtocol == "ftp"
|
|
lcPort = "21"
|
|
OTHERWISE
|
|
*** Assume HTTP
|
|
lcPort = "80"
|
|
ENDCASE
|
|
|
|
lcUrl = SUBSTR(lcUrl,lnAT + 3)
|
|
lnAT = AT(":",lcUrl)
|
|
|
|
IF lnAT > 0
|
|
lcPort = Extract(lcUrl,":","/",,.T.)
|
|
lcServer = LEFT(lcUrl,lnAT-1)
|
|
lcUrl = SUBSTR(lcUrl,lnAT + LEN(lcPort) + 1)
|
|
ELSE
|
|
lnAT = AT("/",lcUrl)
|
|
IF lnAT = 0
|
|
lcServer = lcUrl
|
|
lcUrl = ""
|
|
ELSE
|
|
lcServer = SUBSTR(lcUrl,1,lnAT-1)
|
|
lcURL = SUBSTR(lcUrl,lnAt)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
loUrl = CREATE("RELATION")
|
|
loUrl.ADDPROPERTY("cProtocol",lcProtocol)
|
|
loUrl.ADDPROPERTY("cServer",lcServer)
|
|
loUrl.ADDPROPERTY("cPath",lcUrl) && What's left of the url
|
|
loUrl.ADDPROPERTY("cquerystring",lcQuerystring)
|
|
loUrl.ADDPROPERTY("cPort",lcPort)
|
|
|
|
*** Not implementented
|
|
loURL.AddProperty("cUserName","")
|
|
loUrl.AddProperty("cPassword","")
|
|
|
|
RETURN loUrl
|
|
ENDFUNC
|
|
* wwHTTP :: InternetCrackUrl FUNCTION InternetCrackUrl
|
|
|
|
********************************************************
|
|
* wwHTTP :: WinInetSetTimeout
|
|
*********************************
|
|
*** Function: Sets various timeout for use with a
|
|
*** WinInet Connection
|
|
*** Pass: dwTimeoutSecs - Secs to wait for timeout
|
|
********************************************************
|
|
FUNCTION wininetsettimeout
|
|
LPARAMETERS dwTimeoutSecs, lnHandle
|
|
|
|
dwTimeoutSecs=IIF(VARTYPE(dwTimeoutSecs)="N",;
|
|
dwTimeoutSecs,THIS.nconnecttimeout)
|
|
|
|
IF dwTimeoutSecs = 0
|
|
*** Just use the default
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF EMPTY(lnHandle)
|
|
lnHandle = THIS.hIPSession
|
|
ENDIF
|
|
|
|
DECLARE INTEGER InternetSetOption ;
|
|
IN WININET.DLL ;
|
|
INTEGER HINTERNET,;
|
|
INTEGER dwFlags,;
|
|
INTEGER @dwValue,;
|
|
INTEGER
|
|
|
|
|
|
dwTimeoutSecs=dwTimeoutSecs * 1000 && to milliseconds
|
|
llRetVal=InternetSetOption(lnHandle,;
|
|
INTERNET_OPTION_CONNECT_TIMEOUT,;
|
|
@dwTimeoutSecs,4)
|
|
|
|
llRetVal=InternetSetOption(lnHandle,;
|
|
INTERNET_OPTION_RECEIVE_TIMEOUT,;
|
|
@dwTimeoutSecs,4)
|
|
|
|
llRetVal=InternetSetOption(lnHandle,;
|
|
INTERNET_OPTION_SEND_TIMEOUT,;
|
|
@dwTimeoutSecs,4)
|
|
|
|
* dwTimeoutSecs=1 &&// Retry only 1 time
|
|
* llRetVal=InternetSetOption(lnHandle,;
|
|
* INTERNET_OPTION_CONNECT_RETRIES,;
|
|
* @dwTimeoutSecs,4)
|
|
RETURN
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: GetLastInternetError
|
|
*********************************
|
|
*** Function: Retrieves the last WinInet error using WinInet's error
|
|
*** responses.
|
|
*** Assume: Currently not used by class internally
|
|
*** Under Construction
|
|
*** Pass: lnError - Error Code to resolve(Optional)
|
|
*** Return: Error Message or ""
|
|
************************************************************************
|
|
FUNCTION getlastinterneterror
|
|
LPARAMETERS lnError
|
|
|
|
lnError=IIF(TYPE("lnError")="N",lnError,THIS.nerror)
|
|
|
|
DECLARE INTEGER InternetGetLastResponseInfo ;
|
|
IN WININET.DLL ;
|
|
INTEGER @lpdwError,;
|
|
STRING @lpszBuffer,;
|
|
INTEGER @lpcbSize
|
|
|
|
lcErrorMsg=SPACE(1024)
|
|
lnSize=LEN(lcErrorMsg)
|
|
|
|
=InternetGetLastResponseInfo(@lnError,@lcErrorMsg,@lnSize)
|
|
|
|
IF lnSize < 2
|
|
RETURN ""
|
|
ENDIF
|
|
|
|
RETURN SUBSTR(lcErrorMsg,1,lnSize)
|
|
ENDFUNC
|
|
|
|
************************************************************************
|
|
* wwHTTP :: GetPostBuffer
|
|
*********************************
|
|
*** Function: Returns the entire Post Buffer as a string
|
|
************************************************************************
|
|
FUNCTION getpostbuffer
|
|
RETURN THIS.cPostBuffer
|
|
ENDFUNC
|
|
|
|
|
|
********************************************************
|
|
* wwHTTP :: GetSystemErrorMsg
|
|
*********************************
|
|
*** Function: Returns an Error Message for the last
|
|
*** error value set in nError property.
|
|
*** Assume: nError was set by last operation
|
|
*** Return: Error String or ""
|
|
********************************************************
|
|
FUNCTION getsystemerrormsg
|
|
LPARAMETERS lnErrorNo, llAPI
|
|
LOCAL szMsgBuffer,lnSize
|
|
|
|
lnErrorNo=IIF(TYPE("lnErrorNo")="N",lnErrorNo,THIS.nerror)
|
|
|
|
IF lnErrorNo = ERROR_INTERNET_EXTENDED_ERROR
|
|
RETURN THIS.getlastinterneterror()
|
|
ENDIF
|
|
|
|
szMsgBuffer=SPACE(500)
|
|
DECLARE INTEGER FormatMessage ;
|
|
IN WIN32API ;
|
|
INTEGER dwFlags ,;
|
|
INTEGER lpvSource,;
|
|
INTEGER dwMsgId,;
|
|
INTEGER dwLangId,;
|
|
STRING @lpBuffer,;
|
|
INTEGER nSize,;
|
|
INTEGER Arguments
|
|
|
|
DECLARE INTEGER GetModuleHandle ;
|
|
IN WIN32API ;
|
|
STRING
|
|
|
|
lnModule=GetModuleHandle("wininet.dll")
|
|
IF lnModule # 0 AND !llAPI
|
|
lnSize=FormatMessage(FORMAT_MESSAGE_FROM_HMODULE,lnModule,lnErrorNo,;
|
|
0,@szMsgBuffer,LEN(szMsgBuffer),0)
|
|
ELSE
|
|
lnSize=0
|
|
ENDIF
|
|
|
|
IF lnSize > 2
|
|
szMsgBuffer=SUBSTR(szMsgBuffer,1, lnSize -2 )
|
|
ELSE
|
|
*** REtry with 12000 less - WinInet return Windows API file error codes
|
|
lnSize=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,0,lnErrorNo,;
|
|
0,@szMsgBuffer,LEN(szMsgBuffer),0)
|
|
|
|
IF lnSize > 2
|
|
szMsgBuffer="Win32 API: " + SUBSTR(szMsgBuffer,1, lnSize-2 )
|
|
ELSE
|
|
szMsgBuffer=""
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN szMsgBuffer
|
|
ENDFUNC
|
|
|
|
|
|
|
|
************************************************************************
|
|
* wwHTTP :: Destroy
|
|
*********************************
|
|
*** Function: Clears HTTP Session Handles if open
|
|
************************************************************************
|
|
FUNCTION DESTROY
|
|
|
|
IF THIS.hipsession # 0 OR THIS.hhttpsession # 0
|
|
THIS.httpclose()
|
|
ENDIF
|
|
|
|
ENDFUNC
|
|
|
|
|
|
|
|
ENDDEFINE
|
|
*
|
|
*-- EndDefine: wwHTTP
|
|
**************************************************
|