Alarm trigger with NICA_ORDERS table
solution tested and ready for deployment updated SRP_Git_Services to handle creating local copies of inherited entities updated HgCV OCAP order trigger to also look for active prove-in orders moved error services common into sysprog to avoid compilation issues
This commit is contained in:
Infineon\StieberD
875
LSL2/STPROC/HTTPCLIENT_SERVICES.txt
Normal file
875
LSL2/STPROC/HTTPCLIENT_SERVICES.txt
Normal file
@ -0,0 +1,875 @@
|
||||
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@<fPos> = Name
|
||||
RequestHeaderValues@<fPos> = 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@<FieldCnt> : @VM : RequestHeaderValues@<FieldCnt> : @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@<fPos>
|
||||
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@<fPos> = Name
|
||||
PreviousValue = ResponseHeaderValues@<fPos>
|
||||
If PreviousValue EQ '' then
|
||||
ResponseHeaderValues@<fPos> = 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@<fPos>
|
||||
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@<fPos, vPos> = Trim(Value)
|
||||
end else
|
||||
// This is a new cookie name. Append the Set-Cookie value to the list.
|
||||
ResponseHeaderValues@<fPos, -1> = Trim(Value)
|
||||
end
|
||||
end else
|
||||
// No cookies have been set yet.
|
||||
ResponseHeaderValues@<fPos> = Trim(Value)
|
||||
end
|
||||
end else
|
||||
ResponseHeaderValues@<fPos> = 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@<FieldCnt> : @VM : ResponseHeaderValues@<FieldCnt> : @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@<fPos>
|
||||
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
|
||||
Reference in New Issue
Block a user