/***************************** * Source : LoadFromUrl.prg * System : * Author : Phil Ide * Created: 19-Aug-2004 * * Purpose: * ---------------------------- * History: * ---------------------------- * 19-Aug-2004 12:15:50 idep - Created * * ---------------------------- * Last Revision: * $Rev$ * $Date$ * $Author$ * $URL$ * *****************************/ #include "common.ch" #include "dll.ch" #include "xbpcre.ch" #include "PILFURL.ch" #pragma Library("XbPCRE.LIB") #define CRLF Chr(13)+Chr(10) #define USER_AGENT 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.1.4322)' STATIC sDefHttpHeaders #ifdef _TEST_ Procedure Main( cUrl ) local a local i default cUrl to 'http://www.idep.org.uk/xbase/tencomm.html' ? LoadFromUrl(cUrl) return #endif Function SetHttpDefaultHeaders( cHeaders ) local xRet := sDefHttpHeaders sDefHttpHeaders := cHeaders return xRet // All the following variations are legal URL's, and are happily accepted // by this function. You could of course use "https" instead of "http" // if the server uses that protocol. // // http://www.idep.org.uk:80/xbase/tencomm.html <- no assumptions // http://www.idep.org.uk/xbase/tencomm.html <- assumes port 80 (443 for https) // www.idep.org.uk:80/xbase/tencomm.html <- assumes http (beware - even if port is 443) // www.idep.org.uk/xbase/tencomm.html <- assumes http on port 80 // // You can also use an IP address instead of the server name in all situations, // although this is not recommended (See W3C for why). // STATIC Function ChopUrlIntoLittleBits( cUrl ) local aUrl[URL_SIZE] local o := RegExp():new('(http://|https://|)(.[^/:]+)(:[0-9]*|)(/.+|)', PCRE_CASELESS ) local a if o:exec(cUrl) > 0 a := o:result(2) if a[2] > 0 aUrl[URL_PROTOCOL] := lower(SubStr( cUrl, a[1], a[2] )) endif a := o:result(3) if a[2] > 0 aUrl[URL_HOST] := SubStr( cUrl, a[1], a[2] ) endif a := o:result(4) if a[2] > 0 aUrl[URL_PORT] := Val(SubStr( cUrl, a[1]+1, a[2]-1 )) endif a := o:result(5) if a[2] > 0 aUrl[URL_URI] := SubStr( cUrl, a[1], a[2] ) endif if ValType(aUrl[URL_PROTOCOL]) == 'C' .and. Empty(aUrl[URL_PROTOCOL]) aUrl[URL_PROTOCOL] := NIL endif endif aUrl[URL_POSTSTRING] := "" // now work out proxy defaults... aUrl[URL_ACCESSTYPE] := INTERNET_OPEN_TYPE_PRECONFIG aUrl[URL_PROXY] := NULL aUrl[URL_BYPASS] := NULL return aUrl Function PILFURL( cURL , ; nPortNumber , ; nProtocol , ; cProxyUrl , ; acByPass , ; cMethod , ; cPostString , ; cHttpHeaders, ; bPreCall , ; crespheaders ) local i, ic local nHTTPFile local cBuff local nRead := 1 local nToRead := 0 local cRet := '' local aUrl := ChopUrlIntoLittleBits( cUrl ) local lOk := FALSE default cHttpHeaders to "",; cMethod to 'GET' // all we are doing here is configuring default values for the options. // the problem is that some settings can be specified in multiple places // and we have to negotiate which has priority. // // For example, the port can be set in these places: // 1. Default setting (http) // 2. Url protocol (if http:// or https:// is specified in the url) // 3. Port parameter in function call // 4. Port parameter in url (e.g. http://www.myhome.com:81/index.htm = port 81) // // We use the above order to set the value, so a port specified in // the url has highest priority. if !(nProtocol == NIL) .and. (aUrl[URL_PROTOCOL] == NIL) aUrl[URL_PROTOCOL] := nProtocol elseif (aUrl[URL_PROTOCOL] == NIL) aUrl[URL_PROTOCOL] := INTERNET_COMMUNICATION_PUBLIC endif if ValType(aUrl[URL_PROTOCOL]) == 'C' aUrl[URL_PROTOCOL] := iif( aUrl[URL_PROTOCOL] == 'https://', INTERNET_COMMUNICATION_SECURE, INTERNET_COMMUNICATION_PUBLIC ) endif if !(nPortNumber == NIL) .and. (aUrl[URL_PORT] == NIL) aUrl[URL_PORT] := nPortNumber elseif (aUrl[URL_PORT] == NIL) aUrl[URL_PORT] := iif( aUrl[URL_PROTOCOL] == INTERNET_COMMUNICATION_PUBLIC, INTERNET_DEFAULT_HTTP_PORT, INTERNET_DEFAULT_HTTPS_PORT ) endif // OPTIONS,HEAD,PUT,DELETE,TRACE,CONNECT not supported if !(cMethod == 'GET') .and. !(cMethod == 'POST') .and. !(cMethod == 'HEAD') cMethod := 'GET' endif aUrl[URL_METHOD] := cMethod if !(cPostString == NIL) aUrl[URL_POSTSTRING] := cPostString endif // proxy overrides... if !(cProxyUrl == NIL) aUrl[URL_PROXY] := cProxyUrl aUrl[URL_ACCESSTYPE] := INTERNET_OPEN_TYPE_PROXY endif if ValType(acByPass) == 'A' .and. Len(acByPass) > 0 aUrl[URL_BYPASS] := '' for i := 1 to Len(acByPass) aUrl[URL_BYPASS] += acByPass[i]+' ' next aUrl[URL_BYPASS] := Left(aUrl[URL_BYPASS], Len(aUrl[URL_BYPASS])-1 ) endif // finally, see if any default HTTP headers have been configured... if !Empty(sDefHttpHeaders) cHttpHeaders := sDefHttpHeaders+CRLF+cHttpHeaders cHttpHeaders := StrTran( cHttpHeaders, CRLF+CRLF, CRLF ) endif if (InternetAttemptConnect(0) == ERROR_SUCCESS) if (i := InternetOpenA( USER_AGENT, aUrl[URL_ACCESSTYPE], aUrl[URL_PROXY], aUrl[URL_BYPASS], NULL )) > 0 ic := InternetConnectA( i, aUrl[URL_HOST], aUrl[URL_PORT], NULL, NULL, INTERNET_SERVICE_HTTP, NULL, INTERNET_NO_CALLBACK ) if ic > 0 nHTTPFile := HttpOpenRequestA( ic, aUrl[URL_METHOD], aUrl[URL_URI], NULL, "", NULL, 0, 0 ) if nHTTPFile > 0 if ValType(bPreCall) == 'B' Eval( bPreCall, nHTTPFile ) endif if HttpSendRequestA( nHTTPFile, cHttpHeaders, Len(cHttpHeaders), aUrl[URL_POSTSTRING], Len(aUrl[URL_POSTSTRING]) ) > 0 nRead := 4096 cBuff := Space(nRead) if HttpQueryInfoA( nHTTPFile, HTTP_QUERY_RAW_HEADERS_CRLF, @cBuff, @nRead, NULL ) > 0 crespheaders:=left(cBuff,nRead) endif if HttpQueryInfoA( nHTTPFile, HTTP_QUERY_CONTENT_LENGTH, @cBuff, @nRead, NULL ) > 0 nToRead := Val(cBuff) endif lOk := TRUE IF cmethod $ "GET,POST" While nToRead > 0 cBuff := Space(nToRead) if !(InternetReadFile( nHTTPFile, @cBuff, nToRead, @nRead ) > 0) exit endif cRet += Left(cBuff,nRead) nToRead -= nRead Enddo END IF endif InternetCloseHandle(nHTTPFile) endif endif InternetCloseHandle(ic) endif endif cRet := iif(Empty(cRet) .and. !lOk, NIL, cRet ) return cRet Function WriteFile( cFile, cData ) local nH := FCreate(cFile) local i := 0 if nH > 0 i := FWrite(nH, cData) FClose(nH) endif return i == Len(cData) DLLFUNCTION InternetAttemptConnect(n) USING STDCALL FROM WinInet.dll DLLFUNCTION InternetOpenA( cAgent, dwAcessType, lpProxy, lpByPass, nFlags ) USING STDCALL FROM WinInet.dll DLLFUNCTION InternetConnectA( h, cSrv, nPort, cUser, cPwd, nService, nFlags, nContext ) USING STDCALL FROM WinInet.dll DLLFUNCTION InternetOpenUrlA( h, cUrl, cHead, nHead, nFlags, dwContext ) USING STDCALL FROM WinInet.dll DLLFUNCTION InternetReadFile( n, @c, nS, @nR ) USING STDCALL FROM WinInet.dll DLLFUNCTION GetLastError() USING STDCALL FROM Kernel32.dll DLLFUNCTION HttpOpenRequestA(n,lpVerb, lpTarget,lpVer,lpReferer,lpAccept,nFlags,nContext) USING STDCALL FROM WinInet.dll DLLFUNCTION HttpSendRequestA(n,cHead,nHead,lpOpt,nOptS) USING STDCALL FROM WinInet.dll DLLFUNCTION HttpQueryInfoA(n,nInfo,@lpBuffer,@lpBLen,nIndex) USING STDCALL FROM WinInet.dll DLLFUNCTION InternetCloseHandle(n) USING STDCALL FROM WinInet.dll DLLFUNCTION AddRequestHeadersA(h,cHeaders,nHeadLen,nModifier) USING STDCALL FROM WinInet.dll