$PBExportHeader$n_winhttp.sru $PBExportComments$WinHTTP API object forward global type n_winhttp from nonvisualobject end type type url_components from structure within n_winhttp end type type url_components64 from structure within n_winhttp end type end forward type url_components from structure unsignedlong dwstructsize long lpszscheme unsignedlong dwschemelength unsignedlong nscheme string lpszhostname unsignedlong dwhostnamelength long nport long lpszusername unsignedlong dwusernamelength long lpszpassword unsignedlong dwpasswordlength string lpszurlpath unsignedlong dwurlpathlength long lpszextrainfo unsignedlong dwextrainfolength end type type url_components64 from structure unsignedlong dwstructsize unsignedlong padding1 long lpszscheme unsignedlong dwschemelength unsignedlong nscheme string lpszhostname unsignedlong dwhostnamelength long nport long lpszusername unsignedlong dwusernamelength unsignedlong padding2 long lpszpassword unsignedlong dwpasswordlength unsignedlong padding3 string lpszurlpath unsignedlong dwurlpathlength unsignedlong padding4 long lpszextrainfo unsignedlong dwextrainfolength unsignedlong padding5 end type global type n_winhttp from nonvisualobject autoinstantiate end type type prototypes Function ulong GetLastError( ) Library "kernel32.dll" Function ulong FormatMessage( & ulong dwFlags, & ulong lpSource, & ulong dwMessageId, & ulong dwLanguageId, & Ref ulong lpBuffer, & ulong nSize, & ulong Arguments & ) Library "kernel32.dll" Alias For "FormatMessageW" Function long LocalFree( & long hMem & ) Library "kernel32.dll" Function long GetModuleHandle( & string lpModuleName & ) Library "kernel32.dll" Alias For "GetModuleHandleW" Function ulong FindMimeFromData ( & ulong pBC, & string pwzUrl, & blob pBuffer, & ulong cbSize, & ulong pwzMimeProposed, & ulong dwMimeFlags, & ref ulong ppwzMimeOut, & ulong dwReserved & ) Library "urlmon.dll" // WinHTTP Functions Function boolean WinHttpAddRequestHeaders ( & long hRequest, & string pwszHeaders, & ulong dwHeadersLength, & ulong dwModifiers & ) Library "winhttp.dll" Function boolean WinHttpCheckPlatform ( & ) Library "winhttp.dll" Function boolean WinHttpCloseHandle ( & long hInternet & ) Library "winhttp.dll" Function long WinHttpConnect ( & long hSession, & string pswzServerName, & uint nServerPort, & ulong dwReserved & ) Library "winhttp.dll" Function boolean WinHttpCrackUrl ( & string pwszUrl, & ulong dwUrlLength, & ulong dwFlags, & Ref URL_COMPONENTS lpUrlComponents & ) Library "winhttp.dll" Alias For "WinHttpCrackUrl" Function boolean WinHttpCrackUrl ( & string pwszUrl, & ulong dwUrlLength, & ulong dwFlags, & Ref URL_COMPONENTS64 lpUrlComponents & ) Library "winhttp.dll" Alias For "WinHttpCrackUrl" Function long WinHttpOpen ( & string pwszUserAgent, & ulong dwAccessType, & ulong pwszProxyName, & ulong pwszProxyBypass, & ulong dwFlags & ) Library "winhttp.dll" Function long WinHttpOpenRequest ( & long hConnect, & string pwszVerb, & string pwszObjectName, & ulong pwszVersion, & ulong pwszReferrer, & ulong ppwszAcceptTypes, & ulong dwFlags & ) Library "winhttp.dll" Function boolean WinHttpQueryDataAvailable ( & long hRequest, & Ref ulong lpdwNumberOfBytesAvailable & ) Library "winhttp.dll" Function boolean WinHttpQueryHeaders ( & long hRequest, & ulong dwInfoLevel, & ulong pwszName, & ulong lpBuffer, & Ref ulong lpdwBufferLength, & Ref ulong lpdwIndex & ) Library "winhttp.dll" Function boolean WinHttpQueryHeaders ( & long hRequest, & ulong dwInfoLevel, & ulong pwszName, & Ref string lpBuffer, & Ref ulong lpdwBufferLength, & Ref ulong lpdwIndex & ) Library "winhttp.dll" Function boolean WinHttpReadData ( & long hRequest, & Ref blob lpBuffer, & ulong dwNumberOfBytesToRead, & Ref ulong lpdwNumberOfBytesRead & ) Library "winhttp.dll" Function boolean WinHttpReceiveResponse ( & long hRequest, & ulong lpReserved & ) Library "winhttp.dll" Function boolean WinHttpSendRequest ( & long hRequest, & ulong pwszHeaders, & ulong dwHeadersLength, & ulong lpOptional, & ulong dwOptionalLength, & ulong dwTotalLength, & ulong dwContext & ) Library "winhttp.dll" Function boolean WinHttpSetOption ( & long hInternet, & ulong dwOption, & Ref ulong lpBuffer, & ulong dwBufferLength & ) Library "winhttp.dll" Function boolean WinHttpSetTimeouts ( & long hInternet, & ulong dwResolveTimeout, & ulong dwConnectTimeout, & ulong dwSendTimeout, & ulong dwReceiveTimeout & ) Library "winhttp.dll" Function boolean WinHttpWriteData ( & long hRequest, & Ref blob lpBuffer, & ulong dwNumberOfBytesToWrite, & Ref ulong lpdwNumberOfBytesWritten & ) Library "winhttp.dll" end prototypes type variables Protected: Constant String CRLF = Char(13) + Char(10) Constant Long MAX_PATH = 260 Constant ULong NULL = 0 // WinHttpAddRequestHeaders values for dwModifiers parameter. Constant ulong WINHTTP_ADDREQ_FLAG_ADD_IF_NEW = 268435456 // 0x10000000 Constant ulong WINHTTP_ADDREQ_FLAG_ADD = 536870912 // 0x20000000 Constant ulong WINHTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA = 1073741824 // 0x40000000 Constant ulong WINHTTP_ADDREQ_FLAG_COALESCE_WITH_SEMICOLON = 16777216 // 0x01000000 Constant ulong WINHTTP_ADDREQ_FLAG_COALESCE = WINHTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA Constant ulong WINHTTP_ADDREQ_FLAG_REPLACE = 2147483648 // 0x80000000 // WinHttpConnect ServerPort values Constant uint INTERNET_DEFAULT_PORT = 0 Constant uint INTERNET_DEFAULT_HTTP_PORT = 80 Constant uint INTERNET_DEFAULT_HTTPS_PORT = 443 // WinHttpCrackUrl - dwFlags Constant ulong ICU_DECODE = 268435456 // 0x10000000 Constant ulong ICU_ESCAPE = 2147483648 // 0x80000000 Constant ulong ICU_REJECT_USERPWD = 16384 // 0x80000000 // WinHttpCrackUrl - nScheme Constant ulong INTERNET_SCHEME_HTTP = 1 Constant ulong INTERNET_SCHEME_HTTPS = 2 // WinHttpOpen dwAccessType values Constant ulong WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0 Constant ulong WINHTTP_ACCESS_TYPE_NO_PROXY = 1 Constant ulong WINHTTP_ACCESS_TYPE_NAMED_PROXY = 3 Constant ulong WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY = 4 // WinHttpOpen prettifiers for optional parameters Constant ulong WINHTTP_NO_PROXY_NAME = 0 Constant ulong WINHTTP_NO_PROXY_BYPASS = 0 // WinHttpOpenRequest prettifers for optional parameters Constant ulong WINHTTP_NO_REFERER = 0 Constant ulong WINHTTP_DEFAULT_ACCEPT_TYPES = 0 // WinHttpOpenRequest dwFlags values Constant ulong WINHTTP_FLAG_BYPASS_PROXY_CACHE = 256 Constant ulong WINHTTP_FLAG_SECURE = 8388608 // WinHttpQueryHeaders values for dwInfoLevel Constant ulong WINHTTP_QUERY_STATUS_CODE = 19 Constant ulong WINHTTP_QUERY_STATUS_TEXT = 20 Constant ulong WINHTTP_QUERY_RAW_HEADERS_CRLF = 22 // WinHttpSendRequest prettifiers for optional parameters. Constant ulong WINHTTP_NO_ADDITIONAL_HEADERS = 0 Constant ulong WINHTTP_NO_REQUEST_DATA = 0 // WinHttpSetOption security options Constant ulong WINHTTP_OPTION_SECURITY_FLAGS = 31 Constant ulong SECURITY_FLAG_IGNORE_UNKNOWN_CA = 256 Constant ulong SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE = 512 Constant ulong SECURITY_FLAG_IGNORE_CERT_CN_INVALID = 4096 Constant ulong SECURITY_FLAG_IGNORE_CERT_DATE_INVALID = 8192 // WinHttpSendRequest return codes Constant ulong ERROR_INVALID_PARAMETER = 87 Constant ulong ERROR_NOT_ENOUGH_MEMORY = 8 Constant ulong ERROR_WINHTTP_CANNOT_CONNECT = 12029 Constant ulong ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED = 12044 Constant ulong ERROR_WINHTTP_CONNECTION_ERROR = 12030 Constant ulong ERROR_WINHTTP_INCORRECT_HANDLE_STATE = 12019 Constant ulong ERROR_WINHTTP_INCORRECT_HANDLE_TYPE = 12018 Constant ulong ERROR_WINHTTP_INTERNAL_ERROR = 12004 Constant ulong ERROR_WINHTTP_INVALID_URL = 12005 Constant ulong ERROR_WINHTTP_LOGIN_FAILURE = 12015 Constant ulong ERROR_WINHTTP_NAME_NOT_RESOLVED = 12007 Constant ulong ERROR_WINHTTP_OPERATION_CANCELLED = 12017 Constant ulong ERROR_WINHTTP_RESEND_REQUEST = 12032 Constant ulong ERROR_WINHTTP_RESPONSE_DRAIN_OVERFLOW = 12184 Constant ulong ERROR_WINHTTP_SECURE_FAILURE = 12175 Constant ulong ERROR_WINHTTP_SHUTDOWN = 12012 Constant ulong ERROR_WINHTTP_TIMEOUT = 12002 Constant ulong ERROR_WINHTTP_UNRECOGNIZED_SCHEME = 12006 // timeout values ULong iul_ResolveTimeout = 0 ULong iul_ConnectTimeout = 60000 ULong iul_SendTimeout = 30000 ULong iul_ReceiveTimeout = 30000 Integer ii_SecureProtocol = -1 Long il_session, il_connect, il_request Long il_write_handle, il_write_event String is_method Public: Encoding EncodingType = EncodingUTF8! Blob responseBody String responseText String UserAgent = "n_winhttp" ULong LastErrorNum String LastErrorText String Headers[] Integer StatusCode String StatusText end variables forward prototypes private subroutine closehandles () public function boolean setrequestheader (readonly string as_name, readonly string as_value) public function boolean open (readonly string as_method, readonly string as_url) private function unsignedlong geterrormsg (readonly string as_function, ref string as_msgtext) public subroutine setwriteprogress (long al_handle, long al_event) public function string getmimetype (readonly string as_filename, ref blob ablob_filedata) public function string getmimetype (readonly string as_filename, ref string as_filedata) public function string hex (unsignedlong aul_number, integer ai_digit) public function string urlencode (string as_string) public function long parse (string as_string, string as_separator, ref string as_outarray[]) public function boolean setrequestoption (unsignedlong aul_option, unsignedlong aul_value) public subroutine settimeouts (unsignedlong al_resolvetimeout, unsignedlong al_connecttimeout, unsignedlong al_sendtimeout, unsignedlong al_receivetimeout) public function boolean setsessionoption (unsignedlong aul_option, unsignedlong aul_value) private subroutine of_setsecureprotocol () public subroutine setsecureprotocol (integer ai_secureprotocol) public function long senddata (blob ablob_buffer, ref blob ablob_response) public function long send (readonly string as_data) public function long send (readonly blob ablob_data) public function long send () public function string getresponseheader (string as_headername) public function string getresponseheaders () public function long posturl (readonly string as_urlname, readonly blob ablob_data, readonly string as_mimetype, ref blob ablob_response) public function long geturl (readonly string as_urlname, ref blob ablob_response) protected function boolean of_sendrequesterror (ref boolean ab_retry) end prototypes private subroutine closehandles ();// ----------------------------------------------------------------------- // SCRIPT: CloseHandles // // PURPOSE: This is a private function that closes open handles // // RETURN: Error Number // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- If il_request > 0 Then WinHttpCloseHandle(il_request) il_request = 0 End If If il_connect > 0 Then WinHttpCloseHandle(il_connect) il_connect = 0 End If If il_session > 0 Then WinHttpCloseHandle(il_session) il_session = 0 End If end subroutine public function boolean setrequestheader (readonly string as_name, readonly string as_value);// ----------------------------------------------------------------------- // SCRIPT: SetRequestHeader // // PURPOSE: This function adds a request header. // // ARGUMENTS: as_name - The name of the header // as_value - The value of the header // // RETURN: True=Success, False=Error // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- String ls_header Boolean lb_results ls_Header = Trim(as_name) + ": " + Trim(as_value) + CRLF lb_Results = WinHttpAddRequestHeaders(il_request, ls_Header, -1, & WINHTTP_ADDREQ_FLAG_ADD + WINHTTP_ADDREQ_FLAG_REPLACE) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpAddRequestHeaders", LastErrorText) CloseHandles() Return False End If Return True end function public function boolean open (readonly string as_method, readonly string as_url);// ----------------------------------------------------------------------- // SCRIPT: Open // // PURPOSE: This function initiates the request. // // ARGUMENTS: as_method - The HTTP method such as GET or PUT // as_url - The requested URL // // RETURN: True=Success, False=Error // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- URL_COMPONENTS urlComp URL_COMPONENTS64 urlComp64 Integer ProcessBitness = 32 UInt lui_port = INTERNET_DEFAULT_HTTP_PORT String ls_ServerName, ls_FileName ULong lul_dwFlags Boolean lb_results If ProcessBitness = 64 Then // initialize the structure - 64bit urlComp64.dwStructSize = 104 urlComp64.lpszHostName = Space(MAX_PATH) urlComp64.dwHostNameLength = MAX_PATH urlComp64.lpszUrlPath = Space(MAX_PATH * 5) urlComp64.dwUrlPathLength = MAX_PATH * 5 urlComp64.dwSchemeLength = -1 // separate the URL into its component parts lb_results = WinHttpCrackUrl(as_url, 0, 0, urlComp64) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpCrackUrl", LastErrorText) CloseHandles() Return False End If // copy values to individual variables If urlComp64.nScheme = INTERNET_SCHEME_HTTPS Then lul_dwFlags = WINHTTP_FLAG_SECURE End If ls_ServerName = urlComp64.lpszHostName ls_FileName = urlComp64.lpszUrlPath lui_port = urlComp64.nPort Else // initialize the structure - 32bit urlComp.dwStructSize = 60 urlComp.lpszHostName = Space(MAX_PATH) urlComp.dwHostNameLength = MAX_PATH urlComp.lpszUrlPath = Space(MAX_PATH * 5) urlComp.dwUrlPathLength = MAX_PATH * 5 urlComp.dwSchemeLength = -1 // separate the URL into its component parts lb_results = WinHttpCrackUrl(as_url, 0, 0, urlComp) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpCrackUrl", LastErrorText) CloseHandles() Return False End If // copy values to individual variables If urlComp.nScheme = INTERNET_SCHEME_HTTPS Then lul_dwFlags = WINHTTP_FLAG_SECURE End If ls_ServerName = urlComp.lpszHostName ls_FileName = urlComp.lpszUrlPath lui_port = urlComp.nPort End If // Use WinHttpOpen to obtain a session handle. il_session = WinHttpOpen(UserAgent, & WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY, & WINHTTP_NO_PROXY_NAME, & WINHTTP_NO_PROXY_BYPASS, 0) If il_session = 0 Then LastErrorNum = GetErrorMsg("WinHttpOpen", LastErrorText) Return False End If // apply the SecureProtocol option if one was set If ii_SecureProtocol > -1 Then of_SetSecureProtocol() End If // set the timeouts lb_results = WinHttpSetTimeouts(il_session, iul_ResolveTimeout, & iul_ConnectTimeout, iul_SendTimeout, iul_ReceiveTimeout) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpSetTimeouts", LastErrorText) CloseHandles() Return False End If // Specify an HTTP server. il_connect = WinHttpConnect(il_session, & ls_ServerName, lui_port, 0) If il_connect = 0 Then LastErrorNum = GetErrorMsg("WinHttpConnect", LastErrorText) CloseHandles() Return False End If // Note that use of WINHTTP_DEFAULT_ACCEPT_TYPES restricts // the request to Text type files. // Create an HTTP request handle. is_method = Upper(as_method) il_request = WinHttpOpenRequest(il_connect, is_method, & ls_FileName, 0, WINHTTP_NO_REFERER, & WINHTTP_DEFAULT_ACCEPT_TYPES, lul_dwFlags) If il_request = 0 Then LastErrorNum = GetErrorMsg("WinHttpOpenRequest", LastErrorText) CloseHandles() Return False End If Return True end function private function unsignedlong geterrormsg (readonly string as_function, ref string as_msgtext);// ----------------------------------------------------------------------- // SCRIPT: GetErrorMsg // // PURPOSE: This is a private function that gets the most recent // API error message. // // ARGUMENTS: as_function - The function that failed // as_msgtext - The error message text (by ref) // // RETURN: Error Number // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // 12/17/2019 RolandS Changed to strip trailing CRLF and add period // ----------------------------------------------------------------------- Constant ULong FORMAT_MESSAGE_ALLOCATE_BUFFER = 256 // 0x0100 Constant ULong FORMAT_MESSAGE_IGNORE_INSERTS = 512 // 0x0200 Constant ULong FORMAT_MESSAGE_FROM_STRING = 1024 // 0x0400 Constant ULong FORMAT_MESSAGE_FROM_HMODULE = 2048 // 0x0800 Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096 // 0x1000 Constant ULong FORMAT_MESSAGE_ARGUMENT_ARRAY = 8192 // 0x2000 Constant ULong FORMAT_MESSAGE_MAX_WIDTH_MASK = 255 // 0x00FF Constant ULong LANG_NEUTRAL = 0 ULong lul_error, lul_flags, lul_source ULong lul_buffer, lul_return String ls_msgtext lul_error = GetLastError() lul_source = GetModuleHandle("winhttp.dll") lul_flags = FORMAT_MESSAGE_ALLOCATE_BUFFER + & FORMAT_MESSAGE_FROM_HMODULE + & FORMAT_MESSAGE_IGNORE_INSERTS lul_return = FormatMessage(lul_flags, lul_source, & lul_error, LANG_NEUTRAL, & lul_buffer, 255, NULL) ls_msgtext = String(lul_buffer, "address") LocalFree(lul_buffer) If Right(ls_msgtext, 2) = "~r~n" Then ls_msgtext = Left(ls_msgtext, lul_return - 2) End If as_msgtext = as_function + ": ~r~n~r~n" + Trim(ls_msgtext) + "." Return lul_error end function public subroutine setwriteprogress (long al_handle, long al_event);// ----------------------------------------------------------------------- // SCRIPT: SetWriteProgress // // PURPOSE: This function sets the object handle and event id that // write progress is reported to. // The al_event arg is 1023 + the pbm_custom## number. // // ARGUMENTS: al_handle - Window/UserObject handle. // al_event - Event id of the event to trigger. // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- il_write_handle = al_handle il_write_event = al_event end subroutine public function string getmimetype (readonly string as_filename, ref blob ablob_filedata);// ----------------------------------------------------------------------------- // SCRIPT: GetMIMEType // // PURPOSE: This function is determines the file MIME type. // // ARGUMENTS: as_filename - Filename // ablob_filedata - The file contents // // RETURN: MIME Type // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 03/27/2014 RolandS Initial coding // ----------------------------------------------------------------------------- String ls_mimetype, ls_errmsg ULong lul_ptr, lul_rtn lul_rtn = FindMimeFromData(0, as_filename, ablob_filedata, & Len(ablob_filedata), 0, 0, lul_ptr, 0) If lul_rtn = 0 Then ls_mimetype = String(lul_ptr, "address") Else LastErrorNum = GetErrorMsg("FindMimeFromData", LastErrorText) SetNull(ls_mimetype) End If Return ls_mimetype end function public function string getmimetype (readonly string as_filename, ref string as_filedata);// ----------------------------------------------------------------------------- // SCRIPT: GetMIMEType // // PURPOSE: This function is determines the file MIME type. // // ARGUMENTS: as_filename - Filename // as_filedata - The file contents // // RETURN: MIME Type // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 03/27/2014 RolandS Initial coding // ----------------------------------------------------------------------------- Blob lblob_filedata lblob_filedata = Blob(as_filedata) Return GetMIMEType(as_filename, lblob_filedata) end function public function string hex (unsignedlong aul_number, integer ai_digit);// ----------------------------------------------------------------------------- // SCRIPT: Hex // // PURPOSE: This function converts a number to a hex string. // // ARGUMENTS: aul_number - A number to convert // ai_digit - The number of hex digits expected // // RETURN: Hex string // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 04/24/2014 RolandS Initial coding // ----------------------------------------------------------------------------- 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 + Hex(aul_number - lul_temp1, ai_digit - 1) End If Return "" end function public function string urlencode (string as_string);// ----------------------------------------------------------------------------- // SCRIPT: URLEncode // // PURPOSE: This function URL encodes the passed string. // // ARGUMENTS: as_string - String to encode // // RETURN: The encoded string // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 04/24/2014 RolandS Initial coding // ----------------------------------------------------------------------------- String ls_result, ls_char Integer li_idx For li_idx = 1 To Len(as_string) ls_char = Mid(as_string, li_idx, 1) choose case Asc(ls_char) case 48 To 57, 65 To 90, 97 To 122 ls_result += ls_char case 32 ls_result += "+" case else ls_result += "%" + Hex(Asc(ls_char), 2) end choose Next Return ls_result end function public function long parse (string as_string, string as_separator, ref string as_outarray[]);// ----------------------------------------------------------------------------- // SCRIPT: Parse // // PURPOSE: This function parses a string into an array. // // ARGUMENTS: as_string - The string to be separated // as_separate - The separator characters // as_outarray - By ref output array // // RETURN: The number of items in the array // // DATE CHANGED BY DESCRIPTION OF CHANGE / REASON // ---------- ---------- ----------------------------------------------------- // 04/17/2015 RolandS Initial coding // ----------------------------------------------------------------------------- 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 public function boolean setrequestoption (unsignedlong aul_option, unsignedlong aul_value);// ----------------------------------------------------------------------- // SCRIPT: SetRequestOption // // PURPOSE: This function sets a request level option. // // ARGUMENTS: aul_option - The option being set // aul_value - The value of the option // // RETURN: True=Success, False=Error // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 05/01/2015 RolandS Initial Coding // ----------------------------------------------------------------------- Boolean lb_Results lb_Results = WinHttpSetOption(il_request, aul_option, aul_value, 4) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpSetOption", LastErrorText) CloseHandles() Return False End If Return True end function public subroutine settimeouts (unsignedlong al_resolvetimeout, unsignedlong al_connecttimeout, unsignedlong al_sendtimeout, unsignedlong al_receivetimeout);// ----------------------------------------------------------------------- // SCRIPT: SetTimeouts // // PURPOSE: This function sets the timeout options. All are in // milliseconds. // // ARGUMENTS: aul_ResolveTimeout - Timeout for name resolution. // Default=0 (Infinite) // aul_ConnectTimeout - Timeout for server connection requests. // Default=60000 (60 seconds) // aul_SendTimeout - Timeout for sending requests. // Default=30000 (30 seconds) // aul_ReceiveTimeout - Timeout for receiving a response. // Default=30000 (30 seconds) // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- iul_ResolveTimeout = al_ResolveTimeout iul_ConnectTimeout = al_ConnectTimeout iul_SendTimeout = al_SendTimeout iul_ReceiveTimeout = al_ReceiveTimeout end subroutine public function boolean setsessionoption (unsignedlong aul_option, unsignedlong aul_value);// ----------------------------------------------------------------------- // SCRIPT: SetSessionOption // // PURPOSE: This function sets a request level option. // // ARGUMENTS: aul_option - The option being set // aul_value - The value of the option // // RETURN: True=Success, False=Error // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 05/01/2015 RolandS Initial Coding // ----------------------------------------------------------------------- Boolean lb_Results lb_Results = WinHttpSetOption(il_session, aul_option, aul_value, 4) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpSetOption", LastErrorText) CloseHandles() Return False End If Return True end function private subroutine of_setsecureprotocol ();// ----------------------------------------------------------------------- // SCRIPT: of_SetSecureProtocol // // PURPOSE: This sets the HTTP secure protocol option. // // ARGUMENTS: ai_SecureProtocol - The same values as the HTTPClient // object in PowerBuilder 2017. // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/18/2019 RolandS Initial Coding // 03/30/2023 RolandS Added TLS 1.3 // ----------------------------------------------------------------------- Constant ULong WINHTTP_OPTION_SECURE_PROTOCOLS = 84 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_SSL2 = 8 // 0x00000008 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_SSL3 = 32 // 0x00000020 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_TLS1 = 128 // 0x00000080 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_1 = 512 // 0x00000200 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2 = 2048 // 0x00000800 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_3 = 8192 // 0x00002000 Constant ULong WINHTTP_FLAG_SECURE_PROTOCOL_ALL = WINHTTP_FLAG_SECURE_PROTOCOL_SSL2 + & WINHTTP_FLAG_SECURE_PROTOCOL_SSL3 + & WINHTTP_FLAG_SECURE_PROTOCOL_TLS1 choose case ii_SecureProtocol case 1 // SSL 2 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_SSL2) case 2 // SSL 3 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_SSL3) case 3 // TLS 1.0 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_TLS1) case 4 // TLS 1.1 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_1) case 5 // TLS 1.2 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2) case 6 // TLS 1.3 SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_3) case else // All secure protocols SetSessionOption(WINHTTP_OPTION_SECURE_PROTOCOLS, & WINHTTP_FLAG_SECURE_PROTOCOL_ALL) end choose end subroutine public subroutine setsecureprotocol (integer ai_secureprotocol);// ----------------------------------------------------------------------- // SCRIPT: SetSecureProtocol // // PURPOSE: This sets the HTTP secure protocol option. // // ARGUMENTS: ai_SecureProtocol - The same values as the HTTPClient // object in PowerBuilder 2017. // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/18/2019 RolandS Initial Coding // ----------------------------------------------------------------------- ii_SecureProtocol = ai_SecureProtocol end subroutine public function long senddata (blob ablob_buffer, ref blob ablob_response);// ----------------------------------------------------------------------- // SCRIPT: SendData // // PURPOSE: This function sends the request and returns the response. // // ARGUMENTS: ablob_buffer - The data to be sent with the request // ablob_response - The reponse data // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // 04/17/2015 RolandS Added get of headers into instance array // 05/08/2015 RolandS Changed to send blob length // 04/02/2019 RolandS Added code to initialize the blob & errors // Changed return to long with -1 as error // 12/17/2019 RolandS Moved where ll_BufferLen is set to make // debugging easier // 03/06/2020 RolandS Added retry logic to WinHttpSendRequest // with error handling in of_SendRequestError. // ----------------------------------------------------------------------- Blob lblob_buffer Boolean lb_results, lb_retry Long ll_TotalRead, ll_NextChunk, ll_BufferLen, ll_Length ULong lul_size, lul_read, lul_written, lul_hdrIndex String ls_hdrBuffer // initialize ablob_response = Blob("") LastErrorText = "" LastErrorNum = 0 ll_BufferLen = Len(ablob_buffer) // Send a request do lb_retry = False lb_Results = WinHttpSendRequest(il_request, & WINHTTP_NO_ADDITIONAL_HEADERS, & 0, WINHTTP_NO_REQUEST_DATA, 0, ll_BufferLen, 0) If lb_Results = False Then LastErrorNum = GetErrorMsg("WinHttpSendRequest", LastErrorText) // handle errors If of_SendRequestError(lb_retry) Then CloseHandles() Return -1 End If End If loop while lb_retry // Write data to the server. ll_BufferLen = Len(ablob_buffer) If ll_BufferLen > 0 Then ll_NextChunk = 1 do while ll_NextChunk <= ll_BufferLen // break out a chunk of data lblob_buffer = BlobMid(ablob_buffer, ll_NextChunk, 8192) lul_size = Len(lblob_buffer) // write the chunk to the server lb_Results = WinHttpWriteData(il_request, & lblob_buffer, lul_size, lul_written) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpWriteData", LastErrorText) CloseHandles() Return -1 End If ll_NextChunk += lul_size SetNull(lblob_buffer) // trigger progress event If il_write_handle > 0 Then Send(il_write_handle, il_write_event, ll_NextChunk, ll_BufferLen) End If loop End If // End the request. lb_Results = WinHttpReceiveResponse(il_request, 0) If Not lb_Results Then LastErrorNum = GetErrorMsg("WinHttpReceiveResponse", LastErrorText) CloseHandles() Return -1 End If // get the status code WinHttpQueryHeaders(il_request, WINHTTP_QUERY_STATUS_CODE, & 0, 0, lul_Size, lul_hdrIndex) If lul_Size > 0 Then ls_hdrBuffer = Space(lul_Size/2) lb_results = WinHttpQueryHeaders(il_request, WINHTTP_QUERY_STATUS_CODE, & 0, ls_hdrBuffer, lul_Size, lul_hdrIndex) If lb_Results Then StatusCode = Integer(ls_hdrBuffer) Else LastErrorNum = GetErrorMsg("WinHttpQueryHeaders", LastErrorText) CloseHandles() Return -1 End If End If // get the status text WinHttpQueryHeaders(il_request, WINHTTP_QUERY_STATUS_TEXT, & 0, 0, lul_Size, lul_hdrIndex) If lul_Size > 0 Then ls_hdrBuffer = Space(lul_Size/2) lb_results = WinHttpQueryHeaders(il_request, WINHTTP_QUERY_STATUS_TEXT, & 0, ls_hdrBuffer, lul_Size, lul_hdrIndex) If lb_Results Then StatusText = ls_hdrBuffer Else LastErrorNum = GetErrorMsg("WinHttpQueryHeaders", LastErrorText) CloseHandles() Return -1 End If End If // return Headers into array WinHttpQueryHeaders(il_request, WINHTTP_QUERY_RAW_HEADERS_CRLF, & 0, 0, lul_Size, lul_hdrIndex) If lul_Size > 0 Then ls_hdrBuffer = Space(lul_Size/2) lb_results = WinHttpQueryHeaders(il_request, WINHTTP_QUERY_RAW_HEADERS_CRLF, & 0, ls_hdrBuffer, lul_Size, lul_hdrIndex) If lb_Results Then // remove the trailing CRLF pairs ll_Length = Len(ls_hdrBuffer) ls_hdrBuffer = Left(ls_hdrBuffer, ll_Length - 4) // parse headers into the array Parse(ls_hdrBuffer, CRLF, Headers) Else LastErrorNum = GetErrorMsg("WinHttpQueryHeaders", LastErrorText) CloseHandles() Return -1 End If End If // Keep checking for response data until there is nothing left. do // Check for available data. lul_size = 0 If Not WinHttpQueryDataAvailable(il_request, lul_size) Then LastErrorNum = GetErrorMsg("WinHttpQueryDataAvailable", LastErrorText) CloseHandles() Return -1 End If If lul_size > 0 Then // Allocate space for the buffer. lblob_buffer = Blob(Space(lul_size+1), EncodingAnsi!) // Read the Data. If Not WinHttpReadData(il_request, & lblob_buffer, lul_size, lul_read) Then LastErrorNum = GetErrorMsg("WinHttpReadData", LastErrorText) CloseHandles() Return -1 End If ll_TotalRead = ll_TotalRead + lul_read // Append data to by reference argument ablob_response += BlobMid(lblob_buffer, 1, lul_read) // Free the memory allocated to the buffer. SetNull(lblob_buffer) End If loop while lul_size > 0 // Close any open handles. CloseHandles() Return ll_TotalRead end function public function long send (readonly string as_data);// ----------------------------------------------------------------------- // SCRIPT: Send // // PURPOSE: This function sends the request and saves the response // in instance variables. // // ARGUMENTS: ablob_data - The data being sent // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- Long ll_length Blob lblob_data lblob_data = Blob(as_data, EncodingType) ll_length = SendData(lblob_data, responseBody) If ll_length > 0 Then responseText = String(responseBody, EncodingType) Else responseText = "" End If Return ll_length end function public function long send (readonly blob ablob_data);// ----------------------------------------------------------------------- // SCRIPT: Send // // PURPOSE: This function sends the request and saves the response // in instance variables. // // ARGUMENTS: ablob_data - The data being sent // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- Long ll_length ll_length = SendData(ablob_data, responseBody) If ll_length > 0 Then responseText = String(responseBody, EncodingType) Else responseText = "" End If Return ll_length end function public function long send ();// ----------------------------------------------------------------------- // SCRIPT: Send // // PURPOSE: This function sends the request and saves the response // in instance variables. // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- Blob lblob_data Return Send(lblob_data) end function public function string getresponseheader (string as_headername);// ----------------------------------------------------------------------------- // SCRIPT: GetResponseHeader // // PURPOSE: This function gets the specified header value from the array. // // ARGUMENTS: as_headername - Name of the header to look for // // RETURN: Header value, empty string if not found // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 04/03/2019 RolandS Initial coding // ----------------------------------------------------------------------------- Integer li_idx, li_max, li_len String ls_header, ls_compare ls_compare = Lower(as_headername) + ": " li_len = Len(ls_compare) li_max = UpperBound(Headers) For li_idx = 1 To li_max If Lower(Left(Headers[li_idx], li_len)) = ls_compare Then ls_header = Mid(Headers[li_idx], li_len + 1) Return ls_header End If Next Return ls_header end function public function string getresponseheaders ();// ----------------------------------------------------------------------------- // SCRIPT: GetResponseHeaders // // PURPOSE: This function returns all headers in DataWindow Import format. // // RETURN: Import string - name~tvalue~r~n // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- -------- ----------------------------------------------------- // 04/03/2019 RolandS Initial coding // ----------------------------------------------------------------------------- Integer li_idx, li_max, li_pos String ls_datawindow, ls_name, ls_value li_max = UpperBound(Headers) For li_idx = 1 To li_max li_pos = Pos(Headers[li_idx], " ") ls_name = Left(Headers[li_idx], li_pos - 1) If Right(ls_name, 1) = ":" Then ls_name = Left(ls_name, Len(ls_name) - 1) End If ls_value = Mid(Headers[li_idx], li_pos + 1) If li_idx = 1 Then ls_datawindow = ls_name + "~t" + ls_value Else ls_datawindow = ls_datawindow + "~r~n" + & ls_name + "~t" + ls_value End If Next Return ls_datawindow end function public function long posturl (readonly string as_urlname, readonly blob ablob_data, readonly string as_mimetype, ref blob ablob_response);// ----------------------------------------------------------------------- // SCRIPT: PostURL // // PURPOSE: This function duplicates the standard PostURL function // except it returns the result instead of an // InternetResult object reference. // // ARGUMENTS: as_urlname - The URL where data is being posted // ablob_data - The data being posted // as_mimetype - The MIMETYPE of data being posted // ablob_response - The response data // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- ULong lul_length If Open("POST", as_urlname) = False Then Return -1 End If lul_length = Len(ablob_data) SetRequestHeader("Content-Length", String(lul_length)) SetRequestHeader("Content-Type", as_mimetype) Return SendData(ablob_data, ablob_response) end function public function long geturl (readonly string as_urlname, ref blob ablob_response);// ----------------------------------------------------------------------- // SCRIPT: GetURL // // PURPOSE: This function duplicates the standard GetURL function // except it returns the result instead of an // InternetResult object reference. // // ARGUMENTS: as_urlname - The URL whose source data is returned // ablob_response - The source data being returned // // RETURN: Length of Response or -1 for errors // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/25/2014 RolandS Initial Coding // ----------------------------------------------------------------------- Blob lblob_buffer If Open("GET", as_urlname) = False Then Return -1 End If Return SendData(lblob_buffer, ablob_response) end function protected function boolean of_sendrequesterror (ref boolean ab_retry);// ----------------------------------------------------------------------- // SCRIPT: SendRequestError // // PURPOSE: This function handles errors returned by WinHttpSendRequest // in the SendData function. This function can be overridden // in a descendant object if you want different behavior. // // ARGUMENTS: ab_Retry - By Ref boolean - True=Try again // // RETURN: True=Hard Error, False=Can be ignored // // DATE PROG/ID DESCRIPTION OF CHANGE / REASON // ---------- --------- ----------------------------------------------- // 03/06/2020 RolandS Initial Coding // ----------------------------------------------------------------------- Boolean lb_HardError ULong lul_flags choose case LastErrorNum case ERROR_WINHTTP_SECURE_FAILURE lb_HardError = True case ERROR_WINHTTP_RESEND_REQUEST ab_Retry = True case else lb_HardError = True end choose Return lb_HardError end function on n_winhttp.create call super::create TriggerEvent( this, "constructor" ) end on on n_winhttp.destroy TriggerEvent( this, "destructor" ) call super::destroy end on
File: n_winhttp.sru
Size: 43384
Date: Fri, 28 Jul 2023 18:10:06 +0200
Size: 43384
Date: Fri, 28 Jul 2023 18:10:06 +0200
- nonvisualobject autoinstantiate n_winhttp(sru)
- closehandles ()
- geterrormsg (readonly string as_function, ref string as_msgtext) returns unsignedlong
- getmimetype (readonly string as_filename, ref blob ablob_filedata) returns string
- getmimetype (readonly string as_filename, ref string as_filedata) returns string
- getresponseheader (string as_headername) returns string
- getresponseheaders () returns string
- geturl (readonly string as_urlname, ref blob ablob_response) returns long
- hex (unsignedlong aul_number, integer ai_digit) returns string
- of_sendrequesterror (ref boolean ab_retry) returns boolean
- of_setsecureprotocol ()
- open (readonly string as_method, readonly string as_url) returns boolean
- parse (string as_string, string as_separator, ref string as_outarray[]) returns long
- posturl (readonly string as_urlname, readonly blob ablob_data, readonly string as_mimetype, ref blob ablob_response) returns long
- send () returns long
- send (readonly blob ablob_data) returns long
- send (readonly string as_data) returns long
- senddata (blob ablob_buffer, ref blob ablob_response) returns long
- setrequestheader (readonly string as_name, readonly string as_value) returns boolean
- setrequestoption (unsignedlong aul_option, unsignedlong aul_value) returns boolean
- setsecureprotocol (integer ai_secureprotocol)
- setsessionoption (unsignedlong aul_option, unsignedlong aul_value) returns boolean
- settimeouts (unsignedlong al_resolvetimeout, unsignedlong al_connecttimeout, unsignedlong al_sendtimeout, unsignedlong al_receivetimeout)
- setwriteprogress (long al_handle, long al_event)
- urlencode (string as_string) returns string