#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: ******************************************************* 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 **************************************************