File: n_oauth.sru
Size: 33905
Date: Mon, 31 Dec 2018 21:14:39 +0100
$PBExportHeader$n_oauth.sru
$PBExportComments$OAuth Base Object
forward
global type n_oauth from nonvisualobject
end type
end forward

global type n_oauth from nonvisualobject autoinstantiate
end type

type prototypes
Function string HmacSha1 ( &
   string msg, &
   string pass &
   ) Library "hmac.dll" Alias For "HmacSha1"

Function ulong GetLastError ( &
   ) Library "kernel32.dll"

Function ulong FormatMessage( &
   ulong dwFlags, &
   ulong lpSource, &
   ulong dwMessageId, &
   ulong dwLanguageId, &
   Ref string lpBuffer, &
   ulong nSize, &
   ulong Arguments &
   ) Library "kernel32.dll" Alias For "FormatMessageA"

Function boolean CryptBinaryToString ( &
   string pbBinary, &
   ulong cbBinary, &
   ulong dwFlags, &
   Ref string pszString, &
   Ref ulong pcchString &
   ) Library "crypt32.dll" Alias For "CryptBinaryToStringA"

Function boolean CryptBinaryToString ( &
   string pbBinary, &
   ulong cbBinary, &
   ulong dwFlags, &
   ulong pszString, &
   Ref ulong pcchString &
   ) Library "crypt32.dll" Alias For "CryptBinaryToStringA"

end prototypes

type variables
Protected:

String is_ConsumerKey
String is_ConsumerSecret
String is_AccessToken
String is_AccessTokenSecret
String is_UserAgent = "PowerBuilder"

Public:

String responseText
Integer httpstatus

end variables

forward prototypes
public subroutine of_setconsumerkeys (string as_consumerkey, string as_consumersecret)
public subroutine of_setaccesstokens (string as_accesstoken, string as_accesstokensecret)
public function boolean of_base64encode (string as_message, ref string as_encoded)
public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace)
public function string of_urlencode (string as_string)
public function string of_nbr2hex (unsignedlong aul_number, integer ai_digit)
public function long of_hex2nbr (string as_hex)
private function string of_b64_hmac_sha1 (string as_compositekey, string as_basestring)
private function string of_headerencodeparam (string as_string)
private function string of_headerencodevalue (string as_string)
private function string of_oauthencode (string as_string)
private function long of_timestamp ()
private function string of_urlencodeforheader (string as_string)
private function string of_nonce (integer ai_count)
public subroutine of_setuseragent (string as_useragent)
protected function string of_getoauthheader (string as_method, string as_url, string as_params[], string as_values[])
public function string of_getxmlresponsestring (string as_name)
public function string of_getjsonresponsestring (string as_name)
public function long of_getjsonresponsenumber (string as_name)
protected function boolean of_httpsend (string as_method, string as_url, string as_contenttype, string as_authorization, string as_sendstring)
public function unsignedlong of_getlasterror (ref string as_msgtext)
protected function string of_combineparms (string as_params[], string as_values[])
public function boolean of_sortarray (ref string as_array[], string as_order)
public function long of_parsearray (string as_string, string as_separator, ref string as_outarray[])
private function string of_sorturlparms (string as_urlparms)
protected function string of_getbearertoken (string as_bearerurl)
end prototypes

public subroutine of_setconsumerkeys (string as_consumerkey, string as_consumersecret);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_SetConsumerKeys
//
// PURPOSE:    This function sets the consumer key/secret.
//
// ARGUMENTS:  as_ConsumerKey    - The Consumer Key
//             as_ConsumerSecret - The Consumer Secret
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

is_ConsumerKey    = as_ConsumerKey
is_ConsumerSecret = as_ConsumerSecret

end subroutine

public subroutine of_setaccesstokens (string as_accesstoken, string as_accesstokensecret);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_SetAccessTokens
//
// PURPOSE:    This function sets the access token/token secret.
//
// ARGUMENTS:  as_AccessToken       - The Access Token
//             as_AccessTokenSecret - The Access Token Secret
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

is_AccessToken       = as_AccessToken
is_AccessTokenSecret = as_AccessTokenSecret

end subroutine

public function boolean of_base64encode (string as_message, ref string as_encoded);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Base64Encode
//
// PURPOSE:    This function converts a string to Base64 encoding.
//
// ARGUMENTS:  as_message  -  The string the be encoded
//             as_encoded  -  The encoded string
//
// RETURN:     True=Success, False=Failed
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Constant ULong CRYPT_STRING_BASE64 = 1

ULong lul_len, lul_buflen

// determine size of the encoded buffer
lul_len = Len(as_message)
If Not CryptBinaryToString(as_message, lul_len, &
               CRYPT_STRING_BASE64, 0, lul_buflen) Then
   Return False
End If

// allocate encoded buffer
as_encoded = Space(lul_buflen)

// encode the binary data as Base64 string
If CryptBinaryToString(as_message, lul_len, &
            CRYPT_STRING_BASE64, as_encoded, lul_buflen) Then
   // remove embedded/trailing CRLF
   as_encoded = of_ReplaceAll(as_encoded, "~r~n", "")
Else
   Return False
End If

Return True

end function

public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_ReplaceAll
//
// PURPOSE:    This function replaces all occurrences of a string.
//
// ARGUMENTS:  as_oldstring   - The string to be modified
//             as_findstr     - The substring to be replaced
//             as_replace     - The new string to replace with
//
// RETURN:     Updated string
//
// DATE        CHANGED BY  DESCRIPTION OF CHANGE / REASON
// ----------  ----------  ----------------------------------------------------------------
// 11/24/2016  RolandS     Initial creation
// ----------------------------------------------------------------------------------------

String ls_newstring
Long ll_findstr, ll_replace, ll_pos

// get length of strings
ll_findstr = Len(as_findstr)
ll_replace = Len(as_replace)

// find first occurrence
ls_newstring = as_oldstring
ll_pos = Pos(ls_newstring, as_findstr)

Do While ll_pos > 0
   // replace old with new
   ls_newstring = Replace(ls_newstring, ll_pos, ll_findstr, as_replace)
   // find next occurrence
   ll_pos = Pos(ls_newstring, as_findstr, (ll_pos + ll_replace))
Loop

Return ls_newstring

end function

public function string of_urlencode (string as_string);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_URLEncode
//
// PURPOSE:    This function converts special characters to percent hex.
//
// ARGUMENTS:  as_string   -  String to encode
//
// RETURN:     Encoded String
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_Result, ls_Character
Integer li_Ascii, li_CurChr

li_CurChr = 1
do until li_CurChr - 1 = Len(as_string)
   ls_Character = Mid(as_string, li_CurChr, 1)
   li_Ascii = Asc(ls_Character)
   choose case li_Ascii
      case 48 To 57, 65 To 90, 97 To 122
         // Numbers 0-9, Uppercase A-Z, Lowercase a-z
         ls_Result += ls_Character
      case else
         ls_Result = ls_Result + "%" + &
               of_Nbr2Hex(Asc(ls_Character), 2)
   end choose
   li_CurChr ++
loop

Return ls_Result

end function

public function string of_nbr2hex (unsignedlong aul_number, integer ai_digit);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Nbr2Hex
//
// PURPOSE:    This function converts a number into a hex string.
//
// ARGUMENTS:  aul_number  -  Number to convert
//             ai_digit    -  How many digits in the result
//
// RETURN:     Hex String
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

ULong lul_temp0, lul_temp1
Char lc_ret

If ai_digit > 0 Then
   lul_temp0 = Abs(aul_number / (16 ^ (ai_digit - 1)))
   lul_temp1 = lul_temp0 * (16 ^ (ai_digit - 1))
   If lul_temp0 > 9 Then
      lc_ret = Char(lul_temp0 + 55)
   Else
      lc_ret = Char(lul_temp0 + 48)
   End If
   Return lc_ret + of_Nbr2Hex(aul_number - lul_temp1, ai_digit - 1)
End If

Return ""

end function

public function long of_hex2nbr (string as_hex);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Hex2Nbr
//
// PURPOSE:    This function converts a hex string to a number.
//
// ARGUMENTS:  as_hex   - Hex value
//
// RETURN:     Numeric value
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_work
String ls_code, ls_hex = '123456789ABCDEF'
Long ll_rc, ll_lp

ls_code = Reverse(Upper(as_hex))
ll_rc = len(ls_code)

for ll_lp = 1 to ll_rc
   li_work = li_work + Pos(ls_hex, &
         Mid(ls_code, ll_lp, 1), 1) * (16^(ll_lp - 1))
next

Return li_work

end function

private function string of_b64_hmac_sha1 (string as_compositekey, string as_basestring);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_b64_HMAC_SHA1
//
// PURPOSE:    This function creates a base64 encoded HMAC-SHA1 OAuth signature.
//
// ARGUMENTS:  as_compositekey   -  Encoded composite of consumer secret and token secret
//             as_basestring     -  The encoded string
//
// RETURN:     The signature
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_idx, li_max, li_asc
String ls_hmac, ls_string, ls_signature

// generate HMAC-SHA1 of the base string
ls_hmac = HmacSha1(as_basestring, as_compositekey)

// convert HMAC to an Ascii string
li_max = Len(ls_hmac)
For li_idx = 1 To li_max Step 2
   li_asc = of_Hex2Nbr(Mid(ls_hmac, li_idx, 2))
   ls_string += String(Char(li_asc))
Next

// convert the Ascii string to Base64
of_Base64Encode(ls_string, ls_signature)

Return ls_signature

end function

private function string of_headerencodeparam (string as_string);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_HeaderEncodeParam
//
// PURPOSE:    This function is like URLEncode but for header parameters.
//
// ARGUMENTS:  as_string   -  String to encode
//
// RETURN:     Encoded String
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_string

ls_string = of_ReplaceAll(as_string, "=", "%3D")
ls_string = of_ReplaceAll(ls_string, "&", "%26")

Return ls_string

end function

private function string of_headerencodevalue (string as_string);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_HeaderEncodeValue
//
// PURPOSE:    This function is like URLEncode but for header values.
//
// ARGUMENTS:  as_string   -  String to encode
//
// RETURN:     Encoded String
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_string

ls_string = of_OAuthEncode(as_string)
ls_string = of_ReplaceAll(ls_string, "%", "%25")

Return ls_string

end function

private function string of_oauthencode (string as_string);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_OAuthEncode
//
// PURPOSE:    This function is a special OAuth specific encoder.
//
// ARGUMENTS:  as_string   -  The string being encoded
//
// RETURN:     Encoded string
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_string

ls_string = of_ReplaceAll(as_string, "%", "%25")
ls_string = of_ReplaceAll(ls_string, "!", "%21")
ls_string = of_ReplaceAll(ls_string, "*", "%2A")
ls_string = of_ReplaceAll(ls_string, "'", "%27")
ls_string = of_ReplaceAll(ls_string, "(", "%28")
ls_string = of_ReplaceAll(ls_string, ")", "%29")
ls_string = of_ReplaceAll(ls_string, ";", "%3B")
ls_string = of_ReplaceAll(ls_string, ":", "%3A")
ls_string = of_ReplaceAll(ls_string, "@", "%40")
ls_string = of_ReplaceAll(ls_string, "&", "%26")
ls_string = of_ReplaceAll(ls_string, "=", "%3D")
ls_string = of_ReplaceAll(ls_string, "+", "%2B")
ls_string = of_ReplaceAll(ls_string, "$", "%24")
ls_string = of_ReplaceAll(ls_string, ",", "%2C")
ls_string = of_ReplaceAll(ls_string, "/", "%2F")
ls_string = of_ReplaceAll(ls_string, "?", "%3F")
ls_string = of_ReplaceAll(ls_string, "#", "%23")
ls_string = of_ReplaceAll(ls_string, "[", "%5B")
ls_string = of_ReplaceAll(ls_string, "]", "%5D")
ls_string = of_ReplaceAll(ls_string, " ", "%20")

Return ls_string

end function

private function long of_timestamp ();// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Timestamp
//
// PURPOSE:    This function returns the number of seconds since 1/1/1970.
//
// RETURN:     Timestamp
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Long ll_Seconds

ll_Seconds = DaysAfter(Date(1970,1,1), Today()) * 86400
ll_Seconds = ll_Seconds + SecondsAfter(Time(0,0,0), Now())

Return ll_Seconds

end function

private function string of_urlencodeforheader (string as_string);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_URLEncodeForHeader
//
// PURPOSE:    This function URLEncodes a URL for API headers.
//
// ARGUMENTS:  as_string   -  String to encode
//
// RETURN:     Encoded String
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_string

ls_string = of_URLEncode(as_string)

// API does not expect URL encoding to encode dots, underscores, or dashes.
ls_string = of_ReplaceAll(ls_string, "%2E", ".")
ls_string = of_ReplaceAll(ls_string, "%5F", "_")
ls_string = of_ReplaceAll(ls_string, "%2D", "-")

Return ls_string

end function

private function string of_nonce (integer ai_count);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Nonce
//
// PURPOSE:    This function returns a nonce which is a random string of characters.
//
// ARGUMENTS:  ai_count - The length of the nonce to be returned
//
// RETURN:     Random string
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_idx, li_length, li_rand
String ls_chars, ls_nonce

ls_chars  = "Aa1Bb2Cc3Dd4Ee5Ff6Gg7Hh8Ii9Jj0"
ls_chars += "Kk1Ll2Mm3Nn4Oo5Pp6Qq7Rr8Ss9Tt0"
ls_chars += "Uu1Vv2Ww3Xx4Yy5Zz6"

Randomize(0)

li_length = Len(ls_chars)
For li_idx = 1 To ai_count
   li_rand = Rand(li_length)
   ls_nonce += Mid(ls_chars, li_rand, 1)
Next

Return ls_nonce

end function

public subroutine of_setuseragent (string as_useragent);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_SetUserAgent
//
// PURPOSE:    This function sets the User-Agent header.
//
// ARGUMENTS:  as_UserAgent   - The User-Agent http header
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

is_UserAgent = as_UserAgent

end subroutine

protected function string of_getoauthheader (string as_method, string as_url, string as_params[], string as_values[]);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetOAuthHeader
//
// PURPOSE:    This function assembles the Authorization header.
//
// ARGUMENTS:  as_method   -  The HTTP Method: GET, POST
//             as_url      -  The URL of the server
//             as_params   -  Array of parameters
//             as_values   -  Array of parameter values
//
// RETURN:     The Authorization header
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_idx, li_max
String ls_timestamp, ls_nonce, ls_baseFormat
String ls_StatusMsg, ls_baseString, ls_Value
String ls_compositeKey, ls_oauth_signature
String ls_headerFormat, ls_header

ls_timestamp = String(of_Timestamp())
ls_nonce     = of_Nonce(6)

ls_baseFormat = 'oauth_consumer_key={1}&oauth_nonce={2}&' + &
                  'oauth_signature_method=HMAC-SHA1&oauth_timestamp={3}&' + &
                  'oauth_token={4}&oauth_version=1.0'

li_max = UpperBound(as_Params)
For li_idx = 1 To li_max
   ls_baseFormat += "&" + as_Params[li_idx] + &
                     "={" + String(li_idx + 4) + "}"
Next

ls_baseString = of_HeaderEncodeParam(ls_baseFormat)
ls_baseString = of_ReplaceAll(ls_baseString, "{1}", is_ConsumerKey)
ls_baseString = of_ReplaceAll(ls_baseString, "{2}", ls_nonce)
ls_baseString = of_ReplaceAll(ls_baseString, "{3}", ls_timestamp)
ls_baseString = of_ReplaceAll(ls_baseString, "{4}", is_AccessToken)

// add passed parms
For li_idx = 1 To li_max
   ls_Value = of_HeaderEncodeValue(as_Values[li_idx])
   ls_baseString = of_ReplaceAll(ls_baseString, &
         "{" + String(li_idx + 4) + "}", ls_Value)
Next

// sort the parms
ls_baseString = of_SortURLParms(ls_baseString)

ls_baseString = Upper(as_method) + "&" + &
                  of_URLEncodeForHeader(as_url) + "&" + ls_baseString

ls_compositeKey = of_URLEncode(is_ConsumerSecret) + &
                  "&" + of_URLEncode(is_AccessTokenSecret)

ls_oauth_signature = of_b64_HMAC_SHA1(ls_compositeKey, ls_baseString)
ls_oauth_signature = of_URLEncode(ls_oauth_signature)

ls_header = 'oauth_consumer_key="' + is_ConsumerKey + '",' + &
            'oauth_token="' + is_AccessToken + '",' + &
            'oauth_signature_method="HMAC-SHA1",' + &
            'oauth_timestamp="' + ls_timestamp + '",' + &
            'oauth_nonce="' + ls_nonce + '",' + &
            'oauth_version="1.0",' + &
            'oauth_signature="' + ls_oauth_signature + '"'

Return ls_header

end function

public function string of_getxmlresponsestring (string as_name);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetXMLResponseString
//
// PURPOSE:    This function gets a string value from responseText in XML format.
//
// ARGUMENTS:  as_name  - The name of the value
//
// RETURN:     String value
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_element1, ls_element2, ls_value
Long ll_pos1, ll_pos2, ll_len

ls_element1 = "<" + as_name + ">"
ls_element2 = "</" + as_name + ">"

ll_pos1 = Pos(Lower(responseText), Lower(ls_element1))
If ll_pos1 = 0 Then
   Return ""
End If
ll_pos1 = ll_pos1 + Len(ls_element1)

ll_pos2 = Pos(Lower(responseText), Lower(ls_element2))
If ll_pos2 = 0 Then
   Return ""
End If

ll_len = ll_pos2 - ll_pos1

ls_value = Mid(responseText, ll_pos1, ll_len)

Return ls_value

end function

public function string of_getjsonresponsestring (string as_name);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetJSONResponseString
//
// PURPOSE:    This function gets a string value from responseText in JSON format.
//
// ARGUMENTS:  as_name  - The name of the value
//
// RETURN:     String value
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_name, ls_value
Long ll_pos

ls_name = '"' + as_name + '":'

ll_pos = Pos(responseText, ls_name)
If ll_pos = 0 Then
   Return ""
End If

ll_pos = ll_pos + Len(ls_name) + 1
ls_value = Mid(responseText, ll_pos)
ll_pos = Pos(ls_value, '"') - 1
ls_value = Left(ls_value, ll_pos)

Return ls_value

end function

public function long of_getjsonresponsenumber (string as_name);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetJSONResponseNumber
//
// PURPOSE:    This function gets a string value from responseText in JSON format.
//
// ARGUMENTS:  as_name  - The name of the value
//
// RETURN:     String value
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_name, ls_value
Long ll_pos, ll_value

ls_name = '"' + as_name + '":'

ll_pos = Pos(responseText, ls_name)
If ll_pos = 0 Then
   Return 0
End If

ll_pos = ll_pos + Len(ls_name)
ls_value = Mid(responseText, ll_pos)

ll_pos = Pos(ls_value, ',')
If ll_pos > 0 Then
   ls_value = Left(ls_value, ll_pos - 1)
   Return Long(ls_value)
End If

ll_pos = Pos(ls_value, '"')
If ll_pos > 0 Then
   ls_value = Left(ls_value, ll_pos - 1)
   Return Long(ls_value)
End If

Return 0

end function

protected function boolean of_httpsend (string as_method, string as_url, string as_contenttype, string as_authorization, string as_sendstring);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_HTTPSend
//
// PURPOSE:    This function sends the transaction to the server.
//
// ARGUMENTS:  as_method         -  The HTTP Method: GET, POST
//             as_url            -  The URL of the server
//             as_ContentType    -  The Content-Type header
//             as_Authorization  -  The Authorization header
//             as_SendString     -  String to be passed to the Send method
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

OLEObject oleHTTP

oleHTTP = Create OLEObject
oleHTTP.ConnectToNewObject("Msxml2.XMLHTTP.6.0")

If Upper(as_method) = "GET" And Len(as_sendstring) > 0 Then
   as_url = as_url + "?" + as_sendstring
   as_sendstring = ""
End If

oleHTTP.open(as_method, as_url, False)

oleHTTP.setRequestHeader("Content-Type", as_ContentType)
oleHTTP.setRequestHeader("Authorization", as_Authorization)
oleHTTP.setRequestHeader("User-Agent", is_UserAgent)

If as_sendstring = "" Then
   oleHTTP.Send()
Else
   oleHTTP.Send(as_sendstring)
End If

responseText = oleHTTP.responseText
httpstatus   = oleHTTP.status

oleHTTP.DisconnectObject()
Destroy oleHTTP

If httpstatus = 200 Then
   Return True
End If

Return False

end function

public function unsignedlong of_getlasterror (ref string as_msgtext);// -----------------------------------------------------------------------------
// SCRIPT:     of_GetLastError
//
// PURPOSE:    This function returns the most recent API error message.
//
// ARGUMENTS:  as_msgtext  - The error text ( by ref )
//
// RETURN:     The error number
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 12/06/2016  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096
Constant ULong LANG_NEUTRAL = 0
ULong lul_error, lul_Size = 255

lul_error = GetLastError()

as_msgtext = Space(lul_Size)

FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, &
               lul_error, LANG_NEUTRAL, as_msgtext, lul_Size, 0)

Return lul_error

end function

protected function string of_combineparms (string as_params[], string as_values[]);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_CombineParms
//
// PURPOSE:    This function combines parms/values into URL format.
//
// ARGUMENTS:  as_params   -  Array of parameters
//             as_values   -  Array of parameter values
//
// RETURN:     The parms/values in URL format
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_idx, li_max
String ls_urlparms

li_max = UpperBound(as_params)
For li_idx = 1 To li_max
   If li_idx = 1 Then
      ls_urlparms = as_params[li_idx]
   Else
      ls_urlparms = ls_urlparms + "&" + as_params[li_idx]
   End if
   ls_urlparms = ls_urlparms + "=" + as_values[li_idx]
Next

Return ls_urlparms

end function

public function boolean of_sortarray (ref string as_array[], string as_order);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_SortArray
//
// PURPOSE:    This function sorts the passed array using a DataStore created
//             on-the-fly.
//
//             This is based on code from Real Gagnon:
//             http://www.rgagnon.com/pbdetails/pb-0114.html
//
// ARGUMENTS:  as_array - Array of values to sort
//             as_order - The sort order:
//
//             Order value                Resulting sort order
//             ------------------------   ---------------------------
//             a, asc, ascending, ai, i   Case-insensitive ascending
//             d, desc, descending, di    Case-insensitive descending
//             as, s                      Case-sensitive ascending
//             ds                         Case-sensitive descending
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

DataStore lds_sort
String ls_source, ls_error
Long ll_idx, ll_max, ll_len, ll_maxlen
Integer li_rc

// determine maximum length of values
ll_max = UpperBound(as_array)
For ll_idx = 1 To ll_max
   ll_len = Len(as_array[ll_idx])
   If ll_len > ll_maxlen Then
      ll_maxlen = ll_len
   End If
Next

// build DataWindow source code
ls_source = "release 6; datawindow( processing=0 ) " + &
            "table(column=(type=char(" + String(ll_maxlen) + &
            ") name=array dbname=~"array~" ) )"

// create DataStore
lds_sort = Create DataStore
li_rc = lds_sort.Create(ls_source, ls_error)
If li_rc = 1 Then
   // put data into DataStore
   lds_sort.Object.array.Current = as_array
   // sort the data
   lds_sort.SetSort("array " + as_order)
   lds_sort.Sort()
   // set array to sorted data
   as_array = lds_sort.Object.array.Current
Else
   Return False
End If

// destroy DataStore
Destroy lds_sort

Return True

end function

public function long of_parsearray (string as_string, string as_separator, ref string as_outarray[]);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_ParseArray
//
// PURPOSE:    This function parses a string into an array.
//
// ARGUMENTS:  as_String      - The object that was clicked on
//             as_Separator   - The separator characters
//             as_OutArray    - By ref output array
//
// RETURN:     The number of items in the array
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Long ll_PosEnd, ll_PosStart = 1, ll_SeparatorLen, ll_Counter = 1

If UpperBound(as_OutArray) > 0 Then as_OutArray = {""}

ll_SeparatorLen = Len(as_Separator)

ll_PosEnd = Pos(as_String, as_Separator, 1)

Do While ll_PosEnd > 0
   as_OutArray[ll_Counter] = Mid(as_String, ll_PosStart, ll_PosEnd - ll_PosStart)
   ll_PosStart = ll_PosEnd + ll_SeparatorLen
   ll_PosEnd = Pos(as_String, as_Separator, ll_PosStart)
   ll_Counter++
Loop

as_OutArray[ll_Counter] = Right(as_String, Len(as_String) - ll_PosStart + 1)

Return ll_Counter

end function

private function string of_sorturlparms (string as_urlparms);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_SortURLParms
//
// PURPOSE:    This function sorts the contents of an URL parm string.
//
// ARGUMENTS:  as_urlparms - Parm string
//
// RETURN:     Sorted parm string
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_urlparms, ls_params[]
Long ll_idx, ll_max

ll_max = of_ParseArray(as_urlparms, "%26", ls_params)

of_SortArray(ls_params, "asc")

For ll_idx = 1 To ll_max
   If ll_idx = 1 Then
      ls_urlparms = ls_params[ll_idx]
   Else
      ls_urlparms = ls_urlparms + "%26" + ls_params[ll_idx]
   End If
Next

Return ls_urlparms

end function

protected function string of_getbearertoken (string as_bearerurl);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetBearerToken
//
// PURPOSE:    This function returns a Bearer Token using the ConsumerKey/ConsumerSecret.
//
// ARGUMENTS:  as_bearerurl   - The URL to send the bearer request
//
// RETURN:     Bearer token string
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// --------    -------------  -------------------------------------------------------------
// 11/24/2016  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_BearerToken, ls_Credentials
String ls_ContentType, ls_Authorization, ls_SendMsg

ls_ContentType   = "application/x-www-form-urlencoded;charset=UTF-8"
ls_Credentials   = of_URLEncode(is_ConsumerKey) + ":" + &
                        of_URLEncode(is_ConsumerSecret)
of_Base64Encode(ls_Credentials, ls_Authorization)
ls_Authorization = "Basic " + ls_Authorization
ls_SendMsg       = "grant_type=client_credentials"

If of_HTTPSend("POST", as_BearerURL, &
               ls_ContentType, ls_Authorization, ls_SendMsg) Then
   If of_GetJsonResponseString("token_type") = "bearer" Then
      ls_BearerToken = of_GetJsonResponseString("access_token")
   End If
End If

Return ls_BearerToken

end function

on n_oauth.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_oauth.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on