PBMiner

$PBExportHeader$n_xmlhttp.sru
forward
global type n_xmlhttp from nonvisualobject
end type
end forward

global type n_xmlhttp from nonvisualobject autoinstantiate
end type

type variables
Protected:

Public:

Constant String Content-bmp   = "image/bmp"
Constant String Content-css   = "text/css"
Constant String Content-exe   = "application/octet-stream"
Constant String Content-form  = "application/x-www-form-urlencoded"
Constant String Content-gif   = "image/gif"
Constant String Content-html  = "text/html"
Constant String Content-jar   = "application/java-archive"
Constant String Content-jpg   = "image/jpeg"
Constant String Content-js    = "application/x-javascript"
Constant String Content-pdf   = "application/pdf"
Constant String Content-png   = "image/png"
Constant String Content-tif   = "image/tiff"
Constant String Content-txt   = "text/plain"
Constant String Content-xml   = "application/xml"
Constant String Content-zip   = "application/zip"

Blob responseBody
String responseText
String responseXML
String responseHeaders
String statusText
Integer httpstatus

end variables

forward prototypes
public function string of_nbr2hex (unsignedlong aul_number, integer ai_digit)
public function string of_urlencode (string as_string)
public function string of_connecterror (integer ai_returncode)
public function boolean of_httpsend (string as_method, string as_url, string as_contenttype, string as_sendstring)
public function boolean of_httpsend (string as_method, string as_url, string as_contenttype)
public function string of_gettempdir ()
public function boolean of_writefile (string as_filename, ref blob ablb_filedata)
end prototypes

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/22/2017  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 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/22/2017  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 = AscA(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(AscA(ls_Character), 2)
   end choose
   li_CurChr ++
loop

Return ls_Result

end function

public function string of_connecterror (integer ai_returncode);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_ConnectError
//
// PURPOSE:    This function returns the text of OLE connect errors.
//
// ARGUMENTS:  ai_returncode  -  The value returned by ConnectToNewObject
//
// RETURN:     Error message
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// ----------  -------------  -------------------------------------------------------------
// 11/22/2017  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

String ls_errmsg

choose case ai_returncode
   case 0
      ls_errmsg = "Success"
   case -1
      ls_errmsg = "Invalid Call: the argument is the Object property of a control"
   case -2
      ls_errmsg = "Class name not found"
   case -3
      ls_errmsg = "Object could not be created"
   case -4
      ls_errmsg = "Could not connect to object"
   case -9
      ls_errmsg = "Other error"
   case -15
      ls_errmsg = "COM+ is not loaded on this computer"
   case -16
      ls_errmsg = "Invalid Call: this function not applicable"
   case else
      ls_errmsg = "Undefined return code: " + String(ai_returncode)
end choose

Return ls_errmsg

end function

public function boolean of_httpsend (string as_method, string as_url, string as_contenttype, 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_SendString  -  String to be passed to the Send method
//
//             Microsoft Documentation:
//             https://msdn.microsoft.com/en-us/library/ms760305(v=vs.85).aspx
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// ----------  -------------  -------------------------------------------------------------
// 11/22/2017  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

OLEObject oleHTTP, oleXML
Integer li_rc

// connect to the OLE object
oleHTTP = CREATE OLEObject
li_rc = oleHTTP.ConnectToNewObject("Msxml2.XMLHTTP.6.0")
If li_rc < 0 Then
   httpstatus = li_rc
   statusText = oleHTTP.of_ConnectError(li_rc)
   Return False
End If

If Upper(as_Method) = "GET" And Len(as_SendString) > 0 Then
   as_Url = as_Url + "?" + as_SendString
   as_SendString = ""
End If

responseText = ""
responseXML  = ""
statusText   = ""
httpstatus   = 0

try
   // Initialize the request
   oleHTTP.open(Upper(as_Method), as_Url, False)
   // Set the Content-Type header
   oleHTTP.setRequestHeader("Content-Type", as_ContentType)
   // Send the request to the server and receive the response
   If as_SendString = "" Then
      oleHTTP.send()
   Else
      oleHTTP.send(as_SendString)
   End If
   // Response status
   statusText = oleHTTP.statusText
   httpstatus = oleHTTP.status
   // Response data
   responseHeaders = oleHTTP.getAllResponseHeaders()
   responseBody = oleHTTP.responseBody
   responseText = oleHTTP.responseText
   oleXML = oleHTTP.responseXML
   responseXML = oleXML.xml
catch ( OLERuntimeError err )
   // Response status
   statusText = err.Description
   httpstatus = oleHTTP.status
   // Populate the error object
   PopulateError(err.Number, err.Text)
   Error.Line = err.Line
end try

// disconnect from the OLE object
oleHTTP.DisconnectObject()
Destroy oleHTTP

If httpstatus = 200 Then
   Return True
End If

Return False

end function

public function boolean of_httpsend (string as_method, string as_url, string as_contenttype);// ----------------------------------------------------------------------------------------
// 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
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// ----------  -------------  -------------------------------------------------------------
// 11/22/2017  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Return of_HttpSend(as_Method, as_Url, as_ContentType, "")

end function

public function string of_gettempdir ();// ----------------------------------------------------------------------------------------
// SCRIPT:     of_GetTempDir
//
// PURPOSE:    This function returns the temporary directory.
//
// RETURN:     The temporary directory
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// ----------  -------------  -------------------------------------------------------------
// 11/22/2017  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

ContextKeyword lck_base
String ls_values[]

this.GetContextService("Keyword", lck_base)
lck_base.GetContextKeywords("TEMP", ls_values)

Return ls_values[1]

end function

public function boolean of_writefile (string as_filename, ref blob ablb_filedata);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_WriteFile
//
// PURPOSE:    This function writes a blob to a file on disk.
//
// ARGUMENTS:  as_filename    -  The file name
//             ablb_filedata  -  The file data
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID        DESCRIPTION OF CHANGE / REASON
// ----------  -------------  -------------------------------------------------------------
// 11/22/2017  Roland Smith   Initial Creation
// ----------------------------------------------------------------------------------------

Integer li_fnum

li_fnum = FileOpen(as_filename, StreamMode!, &
               Write!, Shared!, Replace!)
If li_fnum > 0 Then
   FileWriteEx(li_fnum, ablb_filedata)
   FileClose(li_fnum)
   Return True
End If

Return False

end function

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

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