Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "Questa_cartella_di_lavoro"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
#If VBA7 Then
    'declare virtual key event listener
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#Else
    'declare virtual key event listener
    Private Declare Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#End If
Private Const VK_F9 = &H78

Private Sub Workbook_Activate()
Application.DisplayAlerts = False  'importantissima: evita di vedere l'avviso che non si collega al file esterno perchè il csv se non è aperto non fornisce dati

 Application.EnableCancelKey = xlDisabled
    'FINE SERVE PER TASTO
    DoEvents
    
Application.OnKey "{ESCAPE}", ""
Application.OnKey "%^+{RIGHT}", "CelaSvelaRibbon"
Application.OnKey "^{F3}", "fainiente"
Application.OnKey "^{F4}", "fainiente"
Application.OnKey "^{F6}", "fainiente"
Application.OnKey "^{F8}", "fainiente"
Application.OnKey "+{F3}", "fainiente"
Application.OnKey "{F3}", "stampare"
Application.CommandBars("Ply").Enabled = False

Application.OnKey "+{PGUP}", ""
Application.OnKey "+{PGDN}", ""

Application.OnKey "^{PGUP}", "zoomup"
Application.OnKey "^{PGDN}", "zoomdown"
Application.OnKey "^{RIGHT}", "windowsdx"
Application.OnKey "^{LEFT}", "windowssx"
Application.OnKey "^{UP}", "windowsup"
Application.OnKey "^{DOWN}", "windowsdown"
Application.OnKey "^{HOME}", "centrafinestre"

Application.OnKey "{F6}", "VISUALIZZARE"
opendachiuso = "no"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next

Application.DisplayAlerts = False
Application.ThisWorkbook.Saved = True

Call Shell("TaskKill /F /PID " & CStr(lPid))
        DoEvents
   


Call Shell("TaskKill /F /PID " & CStr(lPid2))
DoEvents

ThisWorkbook.Saved = True

            
End Sub



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


MsgBox "Hai aggiornato il numero e la data della versione nel foglio COVER?"

If Salvo = 1 Then
GoTo 44
End If

Dim msgpass
Dim mypass
Dim dataok

Salvo = 0


dataok = MsgBox("Hai aggiornato la data di scadenza nella m. Open e nel Command B del foglio COVER?", vbYesNo, "?")
If dataok = vbYes Then


msgpass = "Insert Password if you want to save:"
mypass = InputBox(msgpass, "Studio Alfredo Ballarini alfredo@ballarini.info", "")

If mypass = "28421284" Then
Salvo = 1
End If


44
If Salvo = 1 Then

ActiveWorkbook.Unprotect Password:="28421284" 'PER EVITARE CHE QUANDO LO RIAPRO SIANO PIANTATE LE MACRO DI VISUAL BASIC
DoEvents
Salvo = 0
GoTo 4
End If


Dim lReply As Long

lReply = MsgBox("Protected copy: if you press Ok the workbook will be closed", vbQuestion + vbOKCancel)
Cancel = (lReply = vbCancel)
If Cancel = True Then

End
End If

'''''''''''''''''''''
Cancel = True
'''''''''''''''''''''
'MsgBox "chiuso"
'End If
ThisWorkbook.Close SaveChanges:=False
End
4

ActiveWorkbook.Unprotect Password:="28421284" 'PER EVITARE CHE QUANDO LO RIAPRO SIANO PIANTATE LE MACRO DI VISUAL BASIC
DoEvents
IndiceFogliNascosti
Salvo = 0
Else
MsgBox "Allora niente!!"
Cancel = True
End
End If


End Sub

Private Sub Workbook_Open()
On Error Resume Next
Application.ScreenUpdating = False
 Application.DecimalSeparator = ","
ActiveWorkbook.Protect Password:="28421284" 'NON SO PERCHE' MA FUNZIONA SOLO QUI IN ALTO! importantissima: SE PROTEGGO LA CARTELLA DI LAVORO DA MENU DI EXCEL E SALVO NON FUNZIONANO PIU' LE MACRO
DoEvents
Application.DisplayAlerts = False  'importantissima: evita di vedere l'avviso che non si collega al file esterno perchè il csv se non è aperto non fornisce dati
DoEvents
 Application.WindowState = xlNormal
 
If opendachiuso <> "no" Then
IndiceFogliScoperti
End If

Application.ScreenUpdating = False
 Application.DecimalSeparator = ","
DoEvents
Application.DisplayAlerts = False  'importantissima: evita di vedere l'avviso che non si collega al file esterno perchè il csv se non è aperto non fornisce dati
DoEvents

 Application.EnableCancelKey = xlDisabled
    'FINE SERVE PER TASTO
    DoEvents
  
DoEvents


    
Salvo = 0  ' adesso serve per non far ricalcolare durante la creazione dell'area di stampa in id card mentre si apre il file, dopo invece la macro activate di id card deve funzionare

On Error Resume Next
Salvo = 0  ' adesso serve per non far ricalcolare durante la creazione dell'area di stampa in id card mentre si apre il file, dopo invece la macro activate di id card deve funzionare

Application.DisplayAlerts = False  'importantissima: evita di vedere l'avviso che non si collega al file esterno perchè il csv se non è aperto non fornisce dati
Application.Iteration = True




CelaSvelaRibbon
ULTIMONUMERO = 300
'areedistampaok
DoEvents

'questo qui sotto fà sì che premo il tasto CTRL salta il controllo della data
If GetAsyncKeyState(vbKeyControl) Then
'''Exit Sub
DoEvents
GoTo vieqqua
DoEvents
End If

    exdate = "04/30/2021"
    If Date > exdate Then
        MsgBox ("You have reached end of your trial period")
     Dim stexto
        stexto = InputBox("Inserire la password per proseguire", "soli x 2:")
    
If stexto <> "yalps1dyalps1d" Then
            ActiveWorkbook.Close SaveChanges:=False
            DoEvents
            DoEvents
            DoEvents
            
            End
            End If
            
    End If
    DoEvents
    DoEvents
    DoEvents
vieqqua:




Salvo = 0
Application.ScreenUpdating = True




End Sub



Attribute VB_Name = "Foglio9"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
IndiceFogliScoperti
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Attribute VB_Name = "Foglio1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "START, 2, 0, MSForms, CommandButton"
Private Sub START_Click()
Call TEST2
'Application.DisplayAlerts = False
'ThisWorkbook.Saved = True
'ActiveWorkbook.Close SaveChanges:=False
'Application.Quit
End Sub

Attribute VB_Name = "Modulo1"
'Studio Ballarini
'Sassuolo (MO)
'mobile: +39 3480029582
'Version WI-FROM Studio Ballarini
Public opendachiuso
Public Salvo As Integer
Public lPid2 As Long
Public exdate As Date
Public CelaSvela As Boolean ' Definita a livello modulo (Dichiarazioni)
Public ULTIMONUMERO As Integer
Option Explicit
'Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

#If VBA7 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 'Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'la riga sopra serve per Form_Load che verifica se ASB.exe è aperto lo attiva altrimenti lo carica chiamando Test2
'sotto fino a test2 serve per test2 che apre ASB.exe
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 'Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'la riga sopra serve per Form_Load che verifica se ASB.exe è aperto lo attiva altrimenti lo carica chiamando Test2
'sotto fino a test2 serve per test2 che apre ASB.exe
#End If



Private Const SW_SHOWMAXIMIZED = 1


#If VBA7 Then
     Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 #Else
     Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 #End If


Private Const GW_HWNDNEXT As Long = 2&
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As Long) As Long
#Else
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As Long) As Long
#End If


#If VBA7 Then
Private Declare PtrSafe Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long

#Else
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long
#End If

#If VBA7 Then
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long

#Else
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
#End If

#If VBA7 Then
Public Declare PtrSafe Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
#Else
Public Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
#End If

#If VBA7 Then
Private Declare PtrSafe Function SendMessageByString Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
#Else
Private Declare Function SendMessageByString Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
#End If


Private Const WM_SETTEXT = &HC
Public Const GW_CHILD = 5
Public lPid As Long, hwnd As Long

Public Function HwndFromPID(ByVal pid As Long) As Long
    Dim lHWND As Long, lPid As Long
    
    lHWND = FindWindow(ByVal 0&, ByVal 0&)
    Do While lHWND <> 0&
        If GetParent(lHWND) = 0& Then
            Call GetWindowThreadProcessId(lHWND, lPid)
            If lPid = pid Then
                HwndFromPID = lHWND
                Exit Do
            End If
        End If
        lHWND = GetWindow(lHWND, GW_HWNDNEXT)
    Loop

End Function
Sub sleep(i)

Dim newHour
Dim newMinute
Dim newSecond
Dim waitTime

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + i
waitTime = TimeSerial(newHour, newMinute, newSecond)
'Application.Cursor = xlDefault
Application.Wait waitTime

End Sub
Sub IndiceFogliNascosti()
'On Error Resume Next
Dim A
Dim fogl
Dim ws As Worksheet, wsSplash As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
'DoEvents
' importantissima: SE PROTEGGO LA CARTELLA DI LAVORO E SALVO NON PARTE PIU' L'EXE QUANDO COMPILO QUESTO FILE EXCEL CON XLSTOEXE (old SE PROTEGGO LA CARTELLA DI LAVORO DA MENU DI EXCEL E SALVO NON FUNZIONANO PIU' LE MACRO)
ActiveWorkbook.Unprotect Password:="28421284" 'PER EVITARE CHE QUANDO LO RIAPRO SIANO PIANTATE LE MACRO DI VISUAL BASICSet wsSplash = Worksheets("Splash screen")
Set wsSplash = Worksheets("Splash screen")
wsSplash.Visible = xlSheetVisible
Worksheets("Splash screen").Range("A1") = "prego Attivare le Macro"
Worksheets("Splash screen").Activate
'''Range("AA1").CurrentRegion.ClearContents
With Range("AA1")
     For A = 1 To Sheets.Count
     fogl = .Item(A, 1)
     'MsgBox Sheets(A).Name
     If Sheets(A).Name <> "" And Sheets(A).Name <> "Splash screen" Then
     Sheets(A).Visible = xlSheetVeryHidden
     End If
     
     'If Sheets(A).Visible = True Then
          '.Item(A, 1) = Sheets(A).Name
          'End If
     Next
End With
' importantissima: SE PROTEGGO LA CARTELLA DI LAVORO E SALVO NON PARTE PIU' L'EXE QUANDO COMPILO QUESTO FILE EXCEL CON XLSTOEXE (old SE PROTEGGO LA CARTELLA DI LAVORO DA MENU DI EXCEL E SALVO NON FUNZIONANO PIU' LE MACRO)
ActiveWorkbook.Unprotect Password:="28421284" 'PER EVITARE CHE QUANDO LO RIAPRO SIANO PIANTATE LE MACRO DI VISUAL BASICSet wsSplash = Worksheets("Splash screen")

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub IndiceFogliScoperti()
Dim A
Dim fogl
Dim ws As Worksheet, wsSplash As Worksheet
On Error Resume Next
Worksheets("Splash screen").Range("A1").Select
    Selection.ClearContents
Application.ScreenUpdating = False
Application.EnableEvents = False

ActiveWorkbook.Unprotect Password:="28421284"
DoEvents
Set wsSplash = Worksheets("Splash screen")
wsSplash.Visible = xlSheetVisible



     For A = 1 To Sheets.Count
          If Sheets(A).Name <> "" And Sheets(A).Name <> "Splash screen" Then
     Sheets(A).Visible = xlSheetVisible
     End If
     'If A = 11 Then
     wsSplash.Visible = xlSheetVeryHidden
    
     Next

Worksheets("COVER").Activate
ActiveWorkbook.Protect Password:="28421284"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Sub TEST2()

    On Error Resume Next
    Application.Cursor = xlWait
'serve per aprire e dare la password a ASB.exe
    Dim aaa As Long
    Dim paths As String
    
    'Application.ScreenUpdating = False
    
    'SERVE PER FARE IN MODO CHE PREMENDO ctrl + pausa non si interrompa il codice
 Application.EnableCancelKey = xlDisabled
   
       paths = Environ$("PUBLIC") & "\WI-FROM Ballarini1" '"c:\Users\Public\WI-FROM1"
   'MsgBox path
   DoEvents
DoEvents
Dim FileName As String
    FileName = VBA.FileSystem.Dir(paths & "\WI-FROM Studio Ballarini.exe")
    If FileName = VBA.Constants.vbNullString Then
    MsgBox "File does not exist."
    End If

DoEvents
'DoEvents
    aaa = Shell(paths & "\WI-FROM Studio Ballarini.exe yalps1d ", vbNormalFocus)
       
    DoEvents
DoEvents
Application.Cursor = xlDefault

DoEvents
DoEvents
   
    Exit Sub
    
      DoEvents
    
      DoEvents
  DoEvents
DoEvents
DoEvents
DoEvents
   

DoEvents
    DoEvents
   
DoEvents
DoEvents
DoEvents
DoEvents
'1500
End Sub
Sub CelaSvelaRibbon()
  If Not CelaSvela Then
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    'RemoveToolbars
    
  Else
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    'RestoreToolbars
    
  End If
  CelaSvela = Not CelaSvela
  
  'per riattivare il right click sulle etichette col nome dei fogli
Application.CommandBars("Ply").Enabled = True
'per riabilitare il right click sulle celle che NON SO dove cavolo l'ho disabilitato
Application.CommandBars("Cell").Enabled = True
End Sub
Sub VISUALIZZARE()
           
            Application.Cursor = xlWait              ' Clessidra
Application.Cursor = xlDefault          ' Puntatore normale
 Application.Visible = True


Exit Sub


    End Sub