Function HTTPClient_Services(@Service, @Params) /*********************************************************************************************************************** This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written permission from SRP Computer Solutions, Inc. Name : HTTPClient_Services Description : Handler program for all module related services. Notes : The generic parameters should contain all the necessary information to process the services. Often this will be information like the data Record and Key ID. Parameters : Service [in] -- Name of the service being requested Param1-10 [in/out] -- Additional request parameter holders Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure Metadata : History : (Date, Initials, Notes) 03/28/16 dmb [SRPFW-120] Original programmer. 07/01/17 dmb [SRPFW-184] Refactor using Enhanced BASIC+ syntax. 05/19/18 dmb [SRPFW-235] Check for content in the HeaderList variable before calling the For Each loop. 11/15/18 dmb [SRPFW-238] Add ClientCertPath argument to the SendHTTPRequest service to support client-side certificates. 02/28/19 dmb Change UseXMLHTTP argument to UseClientXMLHTTP in the SendHTTPRequest service to make it easier to interpret. 02/09/20 dmb [SRPFW-309] Fix a bug in the SendHTTPRequest service so that request headers are properly parsed. All colons were erroneously being converted to @VM instead of the first colon (which separated the header name from the header value). 02/09/20 dmb [SRPFW-309] Update the SetResponseHeaderField service to better support Set-Cookie headers. Allow multiple cookie names to be stored but only store the value of the last cookie name if it is duplicated. 02/09/20 dmb [SRPFW-309] Update the GetResponseHeaderField by adding a Delimiter argument so the caller can specify an alternative delimiter for the values being returned. 02/09/20 dmb [SRPFW-309] Add GetCookies service to make it easier to view all cookies returned in the response. 02/09/20 dmb [SRPFW-309] Add GetCookie service to make it easier to see the entire cookie string of a specified cookie. 02/10/20 dmb [SRPFW-309] Update the GetCookie service to include an IgnoreAttributes argument. If this is True$, then only the cookie name and value will be returned. 12/19/24 djs Created LSL version of service module. Added IgnoreCertErrors parameter to SendHttpRequest service. ***********************************************************************************************************************/ #pragma precomp SRP_PreCompiler $insert LOGICAL $insert SERVICE_SETUP Equ CRLF$ to \0D0A\ // The readyState property will have this value when the request has returned from the server. // http://msdn.microsoft.com/en-us/library/ms753800(v=vs.85).aspx Equ HTTP_COMPLETED$ to 4 Equ SXH_SERVER_CERT_IGNORE_UNKNOWN_CA$ to 256 ; // Unknown certificate authority Equ SXH_SERVER_CERT_IGNORE_WRONG_USAGE$ to 512 ; // Malformed certificate such as a certificate with no subject name. Equ SXH_SERVER_CERT_IGNORE_CERT_CN_INVALID$ to 4096 ; // Mismatch between the visited hostname and the certificate name being used on the server. Equ SXH_SERVER_CERT_IGNORE_CERT_DATE_INVALID$ to 8192 ; // The date in the certificate is invalid or has expired. Equ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS$ to 13056 ; // All certificate errors. Common /HTTPClientServices/ RequestHeaderFields@, RequestHeaderValues@, ResponseHeaderFields@, ResponseHeaderValues@, ResponseStatusCode@, ResponseStatusPhrase@, ResponseBody@, TimeoutDuration@ Declare function SRP_COM, HTTPClient_Services, GetTickCount, OLECreateInstance, OLEGetProperty, OLECallMethod, OLEStatus Declare subroutine SRP_COM, HTTPClient_Services, OLEPutProperty GoToService else Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.') end Return Response OR '' //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Service Parameter Options //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Options BOOLEAN = True$, False$ Options RESPONSEHEADERNAMES = 'Access-Control-Allow-Headers', 'Access-Control-Allow-Methods', 'Access-Control-Allow-Origin', 'Allow', 'Content-Encoding', 'Content-Language', 'Content-Length', 'Content-Location', 'Content-Disposition', 'Content-Type', 'Date', 'Expires', 'Last-Modified', 'Link', 'Location', 'Retry-After', 'Server', 'Set-Cookie', 'Transfer-Encoding', 'Vary', 'WWW-Authenticate', //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Services //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //---------------------------------------------------------------------------------------------------------------------- // SendHTTPRequest // // Method - The HTTP method to submit to the server. - [Required] // URL - The URL receiving the HTTP request. - [Required] // HeaderList - An @FM/@VM list of request header names and values. - [Optional] // Body - The request body to be sent to the server. - [Optional] // ProxyUser - Username needed to authenticate against a proxy server. - [Optional] // ProxyPassword - Password needed to authenticate against a proxy server. - [Optional] // UseAsynchronous - Flag to determine if the HTTP request should be processed asynchronously. Default is True. // - [Optional] // UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP. // - [Optional] // ClientCertPath - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format. // - [Optional] // // Calls the indicated HTTP web service routine. //---------------------------------------------------------------------------------------------------------------------- Service SendHTTPRequestOLE(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath) // Defaults. If UseAsynchronous NE False$ then UseAsynchronous = True$ If UseClientXMLHTTP NE True$ then UseClientXMLHTTP = False$ If (Method NE '') AND (URL NE '') then // Make sure all prior response settings are cleared before performing the next HTTP request. HTTPClient_Services('ClearResponseSettings') // Attempt to get a handle for the best XMLHTTP object. objXMLHTTP = '' If UseClientXMLHTTP then ServerPrefix = '' end else ServerPrefix = 'Server' end XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0' objXMLHTTP = OLECreateInstance(XMLHTTPProgID) Status = OLEStatus() If Status then XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0' objXMLHTTP = OLECreateInstance(XMLHTTPProgID) Status = OLEStatus() If Status then XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP' objXMLHTTP = OLECreateInstance(XMLHTTPProgID) Status = OLEStatus() If Status then Error = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.' Error := ' OLE Error: ' : Status Error_Services('Add', Error) end end end If Error_Services('NoError') then // Invoke the XMLHTTP object's open method to initialize a request. rv = OLECallMethod(objXMLHTTP, 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword) Status = OLEStatus() If Status then Error = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.' Error := ' OLE Error: ' : Status Error_Services('Add', Error) end end * If Error_Services('NoError') then * // Set the request header names and values. This will add or update any header fields passed in through this * // service with those have may have been previously set using the SetRequestHeaderFields or * // SetRequestHeaderField already. * If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList) * // Now get all of the request header fields. * HeaderList = HTTPClient_Services('GetRequestHeaderFields') * If Error_Services('NoError') then * If HeaderList NE '' then * For Each HeaderPair in HeaderList using @FM * HeaderName = HeaderPair<0, 1> * HeaderValue = HeaderPair<0, 2> * SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue) * If SRP_COM('', 'HASERROR') then * Error = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.' * Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') * Error_Services('Add', Error) * end * Next HeaderPair * end * end * end * If ClientCertPath NE '' then * If Error_Services('NoError') then * // Invoke the XMLHTTP object's setOption method to invoke a certificate. * rv = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath) * If SRP_COM('', 'HASERROR') then * Error = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.' * Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') * Error_Services('Add', Error) * end * end * end If Error_Services('NoError') then // Invoke the XMLHTTP object's send method to submit the request to the server. rv = OLECallMethod(objXMLHTTP, 'send', Body) Status = OLEStatus() If Status then Error = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.' Error := ' OLE Error: ' : Status Error_Services('Add', Error) end end If Error_Services('NoError') then If UseAsynchronous then StartTime = GetTickCount() TimeoutDuration = HTTPClient_Services('GetTimeoutDuration') TimedOut = False$ Loop ReadyState = OLEGetProperty(objXMLHTTP, 'readyState') CurrentTime = GetTickCount() ElapsedTime = Int((CurrentTime - StartTime) / 1000) TimedOut = ElapsedTime GE TimeoutDuration While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut) Repeat end // Check the XMLHTTP object's responseBody property to get the server's response. Response = OLEGetProperty(objXMLHTTP, 'responseBody') Response1 = OLEGetProperty(objXMLHTTP, 'responseText') Response2 = objXMLHTTP->responseBody Response3 = objXMLHTTP->responseText Status = OLEStatus() If Status then Error = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.' Error := ' OLE Error: ' : Status Error_Services('Add', Error) Response = '' end else HTTPClient_Services('SetResponseBody', Response) end end If Error_Services('NoError') then // If the request was successful, get the response status code, phrase, and response headers and set them // using HTTPClient_Services so the caller can retrieve is desired. Code = OLEGetProperty(objXMLHTTP, 'status') Phrase = Trim(OLEGetProperty(objXMLHTTP, 'statusText')) HTTPClient_Services('SetResponseStatusCode', Code) HTTPClient_Services('SetResponseStatusPhrase', Phrase) ResponseHeaders = OLECallMethod(objXMLHTTP, 'getAllResponseHeaders') Swap CRLF$ with @FM in ResponseHeaders For Each ResponseHeader in ResponseHeaders using @FM Name = ResponseHeader[1, 'F:'] Value = Trim(ResponseHeader[Col2() + 1, 9999]) If (Name NE '') AND (Value NE '') then HTTPClient_Services('SetResponseHeaderField', Name, Value) end Next ResponseHeader end // Make sure all prior request settings are cleared so future HTTP request won't be affected. Error = Error_Services('GetMessage') ; // Get any pre-existing errors so they can be preserved. HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack. Error_Services('Set', Error) ; // Restore any errors so the caller can check for them. end else Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // SendHTTPRequest // // Method - The HTTP method to submit to the server. - [Required] // URL - The URL receiving the HTTP request. - [Required] // HeaderList - An @FM/@VM list of request header names and values. - [Optional] // Body - The request body to be sent to the server. - [Optional] // ProxyUser - Username needed to authenticate against a proxy server. - [Optional] // ProxyPassword - Password needed to authenticate against a proxy server. - [Optional] // UseAsynchronous - Flag to determine if the HTTP request should be processed asynchronously. Default is True. // - [Optional] // UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP. // - [Optional] // ClientCertPath - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format. // - [Optional] // // Calls the indicated HTTP web service routine. //---------------------------------------------------------------------------------------------------------------------- Service SendHTTPRequest(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath, IgnoreCertErrors) // Defaults. If UseAsynchronous NE False$ then UseAsynchronous = True$ If UseClientXMLHTTP NE True$ then UseClientXMLHTTP = False$ If IgnoreCertErrors NE True$ then IngoreCertErrors = False$ If (Method NE '') AND (URL NE '') then // Make sure all prior response settings are cleared before performing the next HTTP request. HTTPClient_Services('ClearResponseSettings') // Attempt to get a handle for the best XMLHTTP object. objXMLHTTP = '' If UseClientXMLHTTP then ServerPrefix = '' end else ServerPrefix = 'Server' end XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0' If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0' If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP' If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else Error = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.' If SRP_COM('', 'HASERROR') then Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') end Error_Services('Add', Error) end end end If Error_Services('NoError') then // Invoke the XMLHTTP object's open method to initialize a request. SRP_COM(objXMLHTTP, 'CALL', 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword) If SRP_COM('', 'HASERROR') then Error = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) end end If Error_Services('NoError') then // Set the request header names and values. This will add or update any header fields passed in through this // service with those have may have been previously set using the SetRequestHeaderFields or // SetRequestHeaderField already. If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList) // Now get all of the request header fields. HeaderList = HTTPClient_Services('GetRequestHeaderFields') If Error_Services('NoError') then If HeaderList NE '' then For Each HeaderPair in HeaderList using @FM HeaderName = HeaderPair<0, 1> HeaderValue = HeaderPair<0, 2> SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue) If SRP_COM('', 'HASERROR') then Error = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) end Next HeaderPair end end end If IgnoreCertErrors then If Error_Services('NoError') then rv = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS$) If SRP_COM('', 'HASERROR') then Error = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) end end end If ClientCertPath NE '' then If Error_Services('NoError') then // Invoke the XMLHTTP object's setOption method to invoke a certificate. rv = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath) If SRP_COM('', 'HASERROR') then Error = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) end end end If Error_Services('NoError') then // Invoke the XMLHTTP object's send method to submit the request to the server. rv = SRP_COM(objXMLHTTP, 'CALL', 'send', Body) If SRP_COM('', 'HASERROR') then Error = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) end end If Error_Services('NoError') then If UseAsynchronous then StartTime = GetTickCount() TimeoutDuration = HTTPClient_Services('GetTimeoutDuration') TimedOut = False$ Loop ReadyState = SRP_COM(objXMLHTTP, 'GET', 'readyState') CurrentTime = GetTickCount() ElapsedTime = Int((CurrentTime - StartTime) / 1000) TimedOut = ElapsedTime GE TimeoutDuration While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut) Repeat end // Check the XMLHTTP object's responseBody property to get the server's response. * Response = SRP_COM(objXMLHTTP, 'GET', 'responseBody') Response = SRP_COM(objXMLHTTP, 'GET', 'responseText') If SRP_COM('', 'HASERROR') then Error = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.' Error := ' SRP_COM Error: ' : SRP_COM('', 'ERROR') Error_Services('Add', Error) Response = '' end else HTTPClient_Services('SetResponseBody', Response) end end If Error_Services('NoError') then // If the request was successful, get the response status code, phrase, and response headers and set them // using HTTPClient_Services so the caller can retrieve is desired. Code = SRP_COM(objXMLHTTP, 'GET', 'status') Phrase = Trim(SRP_COM(objXMLHTTP, 'GET', 'statusText')) HTTPClient_Services('SetResponseStatusCode', Code) HTTPClient_Services('SetResponseStatusPhrase', Phrase) ResponseHeaders = SRP_COM(objXMLHTTP, 'CALL', 'getAllResponseHeaders') Swap CRLF$ with @FM in ResponseHeaders For Each ResponseHeader in ResponseHeaders using @FM Name = ResponseHeader[1, 'F:'] Value = Trim(ResponseHeader[Col2() + 1, 9999]) If (Name NE '') AND (Value NE '') then HTTPClient_Services('SetResponseHeaderField', Name, Value) end Next ResponseHeader end // Release the handle to the XMLHTTP object in case it was created. SRP_COM(objXMLHTTP, 'RELEASE') // Make sure all prior request settings are cleared so future HTTP request won't be affected. Error = Error_Services('GetMessage') ; // Get any pre-existing errors so they can be preserved. HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack. Error_Services('Set', Error) ; // Restore any errors so the caller can check for them. end else Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // SetRequestHeaderFields // // HeaderList - An @FM/@VM list of request header fields and their values. - [Required] // // Sets the Request Header Fields as indicated by the HeaderList argument. The HeaderList should not be formatted as a // list rather than an associated multivalue array. This is easier for the developer to manage in the code that calls // this service. //---------------------------------------------------------------------------------------------------------------------- Service SetRequestHeaderFields(HeaderList) If HeaderList NE '' then For Each HeaderPair in HeaderList using @FM HeaderName = HeaderPair<0, 1> HeaderValue = HeaderPair<0, 2> HTTPClient_Services('SetRequestHeaderField', HeaderName, HeaderValue) Next HeaderPair end else Error_Services('Add', 'HeaderList argument was missing from the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // SetRequestHeaderField // // Name - Header Field Name to set. - [Required] // Value - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required] // // Sets the indicated Request Header Field with the indicated value. //---------------------------------------------------------------------------------------------------------------------- Service SetRequestHeaderField(Name, Value) If (Name NE '') AND (Value NE '') then SearchName = Name Convert @Lower_Case to @Upper_Case in SearchName SearchFields = RequestHeaderFields@ Convert @Lower_Case to @Upper_Case in SearchFields Locate SearchName in SearchFields using @FM setting fPos else fPos = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '') + 1 end RequestHeaderFields@ = Name RequestHeaderValues@ = Trim(Value) end else Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // GetRequestHeaderFields // // Returns all of the Request Header Field names and values. This returns an @FM/@VM list of names and values. //---------------------------------------------------------------------------------------------------------------------- Service GetRequestHeaderFields() HeaderFieldBlock = '' If RequestHeaderFields@ NE '' then NumFields = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '') For FieldCnt = 1 to NumFields HeaderFieldBlock := RequestHeaderFields@ : @VM : RequestHeaderValues@ : @FM Next FieldCnt HeaderFieldBlock[-1, 1] = '' end Response = HeaderFieldBlock end service //---------------------------------------------------------------------------------------------------------------------- // GetRequestHeaderField // // Name - Header Field Name to get. - [Required] // // Returns the value previously set for the indicated Request Header Field. //---------------------------------------------------------------------------------------------------------------------- Service GetRequestHeaderField(Name) Value = '' If Name NE '' then SearchName = Name Convert @Lower_Case to @Upper_Case in SearchName SearchFields = RequestHeaderFields@ Convert @Lower_Case to @Upper_Case in SearchFields Locate SearchName in SearchFields using @FM setting fPos then Value = RequestHeaderValues@ end else Error_Services('Add', Name : ' is not a header field in the request.') end end else Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.') end Response = Value end service //---------------------------------------------------------------------------------------------------------------------- // SetResponseHeaderField // // Name - Header Field Name to set. - [Required] // Value - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required] // // Sets the indicated Response Header Field with the indicated value. //---------------------------------------------------------------------------------------------------------------------- Service SetResponseHeaderField(Name, Value) If (Name NE '') AND (Value NE '') then SearchName = Name Convert @Lower_Case to @Upper_Case in SearchName SearchFields = ResponseHeaderFields@ Convert @Lower_Case to @Upper_Case in SearchFields Locate SearchName in SearchFields using @FM setting fPos else fPos = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '') + 1 end ResponseHeaderFields@ = Name PreviousValue = ResponseHeaderValues@ If PreviousValue EQ '' then ResponseHeaderValues@ = Trim(Value) end else If Name EQ 'Set-Cookie' then // Unlike other response headers, Set-Cookie can have multiple entries. However, if more than one // cookie of a particular name exists then only store the last entry. SetCookieFound = False$ CookieName = Value[1, 'F='][1, 'F '][1, 'F;'] For Each HeaderField in ResponseHeaderFields@ using @FM setting fPos If HeaderField EQ 'Set-Cookie' then SetCookieFound = True$ end Until SetCookieFound EQ True$ Next HeaderField If SetCookieFound EQ True$ then // Set-Cookie was found. Check to see if the cookie name has already been added. CookieNameFound = False$ CookieValues = ResponseHeaderValues@ For Each CookieValue in CookieValues using @VM setting vPos MatchCookieName = CookieValue[1, 'F='][1, 'F '][1, 'F;'] If CookieName EQ MatchCookieName then CookieNameFound = True$ end Until CookieNameFound EQ True$ Next CookieValue If CookieNameFound EQ True$ then // Cookie name already exists. Replace the old value with the new one. ResponseHeaderValues@ = Trim(Value) end else // This is a new cookie name. Append the Set-Cookie value to the list. ResponseHeaderValues@ = Trim(Value) end end else // No cookies have been set yet. ResponseHeaderValues@ = Trim(Value) end end else ResponseHeaderValues@ = PreviousValue : ' ;' : Trim(Value) end end end else Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // GetResponseHeaderFields // // Returns all of the Response Header Field names and values. This returns an @FM/@VM list of names and values. //---------------------------------------------------------------------------------------------------------------------- Service GetResponseHeaderFields() HeaderFieldBlock = '' If ResponseHeaderFields@ NE '' then NumFields = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '') For FieldCnt = 1 to NumFields HeaderFieldBlock := ResponseHeaderFields@ : @VM : ResponseHeaderValues@ : @FM Next FieldCnt HeaderFieldBlock[-1, 1] = '' end else Error_Services('Add', 'There are no response header fields get.') end Response = HeaderFieldBlock end service //---------------------------------------------------------------------------------------------------------------------- // GetResponseHeaderField // // Name - Header Field Name to get. - [Required] // Delimiter - Delimiter to use for multiple values. Default is '; ' for all header fields except for Set-Cookie. // Set-Cookie defaults to @VM. - [Optional] // // Returns the value previously set for the indicated Response Header Field. The Name argument is case-insensitive but // if the indicated Response Header Field has not been set then an error condition will be set. //---------------------------------------------------------------------------------------------------------------------- Service GetResponseHeaderField(Name=RESPONSEHEADERNAMES, Delimiter) Value = '' If Name NE '' then SearchName = Name Convert @Lower_Case to @Upper_Case in SearchName SearchFields = ResponseHeaderFields@ Convert @Lower_Case to @Upper_Case in SearchFields Locate SearchName in SearchFields using @FM setting fPos then Value = ResponseHeaderValues@ If Delimiter NE '' then If Name EQ 'Set-Cookie' then Convert @VM to Delimiter in Value end else Swap '; ' with Delimiter in Value end end end else Error_Services('Add', Name : ' is not a header field in the response.') end end else Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.') end Response = Value end service //---------------------------------------------------------------------------------------------------------------------- // GetCookies // // Delimiter - Delimiter to use for multiple cookies. Default is @FM - [Optional] // // Returns all cookie strings from the response headers. //---------------------------------------------------------------------------------------------------------------------- Service GetCookies(Delimiter) If Delimiter EQ '' then Delimiter = @FM Cookies = HTTPClient_Services('GetResponseHeaderField', 'Set-Cookie', Delimiter) Response = Cookies end service //---------------------------------------------------------------------------------------------------------------------- // GetCookie // // Name - Name of the cookie to get. - [Required] // IgnoreAttributes - Boolean flag to indicate if the cookie's attributes should be removed when returning the cookie. // Default value is False$. - [Optional] // // Returns the value for the indicated cookie name. //---------------------------------------------------------------------------------------------------------------------- Service GetCookie(Name, IgnoreAttributes=BOOLEAN) If IgnoreAttributes NE True$ then IgnoreAttributes = False$ Cookie = '' If Name NE '' then CookieNameFound = False$ Cookies = HTTPClient_Services('GetCookies') For Each CookieString in Cookies using @FM MatchCookieName = CookieString[1, 'F='][1, 'F '][1, 'F;'] If Name EQ MatchCookieName then CookieNameFound = True$ end Until CookieNameFound EQ True$ Next CookieValue If CookieNameFound EQ True$ then If IgnoreAttributes EQ True$ then CookieString = Trim(CookieString[1, ';']) end Transfer CookieString to Cookie end end else Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.') end Response = Cookie end service //---------------------------------------------------------------------------------------------------------------------- // SetResponseStatusCode // // Code - HTTP status code to set. - [Required] // // Sets the response status code generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service SetResponseStatusCode(Code) If Code NE '' then ResponseStatusCode@ = Code end else Error_Services('Add', 'The Code argument is missing in the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // GetResponseStatusCode // // Gets the response status code generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service GetResponseStatusCode() Response = ResponseStatusCode@ end service //---------------------------------------------------------------------------------------------------------------------- // SetResponseStatusPhrase // // Phrase - HTTP status phrase to set. - [Required] // // Sets the response status phrase generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service SetResponseStatusPhrase(Phrase) If Phrase NE '' then ResponseStatusPhrase@ = Phrase end else Error_Services('Add', 'The Phrase argument is missing in the ' : Service : ' service.') end end service //---------------------------------------------------------------------------------------------------------------------- // GetResponseStatusPhrase // // Gets the response status phrase generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service GetResponseStatusPhrase() Response = ResponseStatusPhrase@ end service //---------------------------------------------------------------------------------------------------------------------- // SetResponseBody // // Body - The response body which would have been generated by an XMLHTTP call. // // Sets the response body generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service SetResponseBody(Body) ResponseBody@ = Body end service //---------------------------------------------------------------------------------------------------------------------- // GetResponseBody // // Gets the response body generated by the most recent HTTP request. //---------------------------------------------------------------------------------------------------------------------- Service GetResponseBody() Response = ResponseBody@ end service //---------------------------------------------------------------------------------------------------------------------- // SetTimeoutDuration // // TimeoutDuration - The length of time (in seconds) before an HTTP request will abort. // // Sets the timeout duration that will be used before an HTTP request will abort. This is only applicable if the // request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800 seconds) will be // set. //---------------------------------------------------------------------------------------------------------------------- Service SetTimeoutDuration(TimeoutDuration) If TimeoutDuration EQ '' then TimeoutDuration = 1800 TimeoutDuration@ = TimeoutDuration end service //---------------------------------------------------------------------------------------------------------------------- // GetTimeoutDuration // // Returns the timeout duration that will be used before an HTTP request will abort. This is only applicable if the // request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800) seconds) will be // returned. //---------------------------------------------------------------------------------------------------------------------- Service GetTimeoutDuration() If TimeoutDuration@ EQ '' then TimeoutDuration@ = 1800 Response = TimeoutDuration@ end service //---------------------------------------------------------------------------------------------------------------------- // ClearResponseSettings // // Clears all of the global common variables used for responses. //---------------------------------------------------------------------------------------------------------------------- Service ClearResponseSettings() ResponseHeaderFields@ = '' ResponseHeaderValues@ = '' ResponseStatusCode@ = '' ResponseStatusPhrase@ = '' ResponseBody@ = '' end service //---------------------------------------------------------------------------------------------------------------------- // ClearRequestSettings // // Clears all of the global common variables used for requests. //---------------------------------------------------------------------------------------------------------------------- Service ClearRequestSettings() RequestHeaderFields@ = '' RequestHeaderValues@ = '' TimeoutDuration@ = 1800 end service