Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2004 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================


Option Explicit

Private Sub Workbook_Open()
    SC_XL_Startup
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    SC_XL_Shutdown
End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "IconLogout, 78, 0, MSForms, Image"
Attribute VB_Control = "IconLogin, 77, 1, MSForms, Image"
Attribute VB_Control = "IconOmniture, 75, 2, MSForms, Image"
Attribute VB_Control = "IconLogo, 76, 3, MSForms, Image"
Attribute VB_Control = "IconInsert, 79, 4, MSForms, Image"
Attribute VB_Control = "IconWizard, 80, 5, MSForms, Image"
Attribute VB_Control = "IconUpdate, 81, 6, MSForms, Image"
Attribute VB_Control = "IconUpdateAll, 82, 7, MSForms, Image"
Attribute VB_Control = "IconLibrary, 83, 8, MSForms, Image"
Attribute VB_Control = "IconPublish, 84, 9, MSForms, Image"
Attribute VB_Control = "IconHelp, 85, 10, MSForms, Image"
Attribute VB_Control = "IconSEM, 86, 11, MSForms, Image"
Attribute VB_Control = "IconSEMGet, 87, 12, MSForms, Image"
Attribute VB_Control = "IconSEMCommit, 88, 13, MSForms, Image"
Attribute VB_Control = "IconHelpMask, 89, 14, MSForms, Image"
Attribute VB_Control = "IconPublishMask, 90, 15, MSForms, Image"
Attribute VB_Control = "PublishIconMask, 154, 20, MSForms, Image"
Attribute VB_Control = "PublishIcon, 153, 21, MSForms, Image"
Attribute VB_Control = "IconSEMMask, 98, 23, MSForms, Image"
Attribute VB_Control = "IconLibraryMask, 99, 24, MSForms, Image"
Attribute VB_Control = "IconUpdateAllMask, 100, 25, MSForms, Image"
Attribute VB_Control = "IconUpdateMask, 101, 26, MSForms, Image"
Attribute VB_Control = "IconWizardMask, 102, 27, MSForms, Image"
Attribute VB_Control = "IconInsertMask, 103, 28, MSForms, Image"
Attribute VB_Control = "IconLogoutMask, 104, 29, MSForms, Image"
Attribute VB_Control = "IconLoginMask, 105, 30, MSForms, Image"
Attribute VB_Control = "IconLogoMask, 106, 31, MSForms, Image"
Attribute VB_Control = "IconOmnitureMask, 107, 32, MSForms, Image"
Attribute VB_Control = "IconSEMCommitMask, 108, 33, MSForms, Image"
Attribute VB_Control = "IconSEMGetMask, 109, 34, MSForms, Image"
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2004 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================



Private Sub Image2_Click()

End Sub

Private Sub Image6_Click()

End Sub

Attribute VB_Name = "SC_XL_Form_Web"
Attribute VB_Base = "0{E06AE859-5BBE-4C5F-A15F-27AAA94CA0D1}{9566F368-2B63-4F0A-ADD9-618309624C99}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2004 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================


Option Explicit

Public WebFormName As String
Public WebFormReady As Boolean

Public WithEvents BrowserWindow As HTMLWindow2
Attribute BrowserWindow.VB_VarHelpID = -1
Public WithEvents BrowserDocument As HTMLDocument
Attribute BrowserDocument.VB_VarHelpID = -1

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long _
) As Long

Private Declare Function SendMessage _
    Lib "user32" _
    Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
As Long
Private Declare Function GetWindowLong _
    Lib "user32" _
        Alias "GetWindowLongA" ( _
            ByVal hwnd As Long, _
            ByVal nIndex As Long) _
As Long
Private Declare Function SetWindowLong _
    Lib "user32" _
        Alias "SetWindowLongA" ( _
            ByVal hwnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) _
As Long
Private Declare Function DrawMenuBar _
    Lib "user32" ( _
        ByVal hwnd As Long) _
As Long
Private Declare Function FindWindowA _
    Lib "user32" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
As Long
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000

Private Sub UserForm_Activate()
    Dim lFrmWndHdl As Long
    Dim lStyle As Long
    Dim hIcon As Long

    lFrmWndHdl = FindWindowA(vbNullString, Me.Caption)
    lStyle = GetWindowLong(lFrmWndHdl, GWL_STYLE)
    lStyle = lStyle Or WS_SYSMENU
    SetWindowLong lFrmWndHdl, GWL_STYLE, lStyle
    hIcon = Icon.Picture.Handle
    Call SendMessage(lFrmWndHdl, WM_SETICON, ICON_SMALL, ByVal hIcon)
    Call SendMessage(lFrmWndHdl, WM_SETICON, ICON_BIG, ByVal hIcon)
    DrawMenuBar lFrmWndHdl
    On Error Resume Next
    AppActivate ("Microsoft excel")
    On Error GoTo 0

    WebFormReady = True
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Cursor = xlDefault
    If InStr(WebFormName, "BUILDING") > 0 Then
        SC_XL_Queries_Running = 0
    End If
    SC_XL_WebForms_Hide WebFormName
    Cancel = 1
End Sub

Private Sub SetupBrowser()
    Set BrowserDocument = Browser.Document
    Set BrowserWindow = BrowserDocument.parentWindow
End Sub

Private Sub Browser_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Dim SCURL As SC_XL_Class_URL
    Dim Msg As String
    Dim MsgParts() As String
    Dim MsgPartNum As Long
    Dim MsgData As SC_XL_Class_StringMap
    Dim MsgDataStr As String
    Dim MsgDataLen As Long
    Dim MsgDataPos As Long

    On Error GoTo NotLeaving
    If UCase(Left(URL, 6)) = "EXCEL:" Then
        Cancel = True
        
        Set SCURL = New SC_XL_Class_URL
        Msg = Mid(URL, 7)
        MsgParts = Split(Msg, ":")
        For MsgPartNum = 0 To UBound(MsgParts)
            MsgParts(MsgPartNum) = SCURL.URLDecode(MsgParts(MsgPartNum))
        Next

        MsgDataStr = ""
        MsgDataLen = LenB(PostData)
        If MsgDataLen > 0 Then
            For MsgDataPos = 1 To (MsgDataLen - 1)
                MsgDataStr = MsgDataStr & Chr(AscB(MidB(PostData, MsgDataPos, 1)))
            Next
            SCURL.SetURL "?" & MsgDataStr
            Set MsgData = SCURL.QueryStringGetStringMap
        Else
            Set MsgData = New SC_XL_Class_StringMap
        End If

        SC_XL_WebForms_HandleMsg WebFormName, MsgParts, MsgData
    Else
        If (Left(URL, 11) <> "javascript:") And (InStr(URL, ".exe") = 0) And (InStr(URL, "download") = 0) Then
            If InStr(WebFormName, "BUILDING") <= 0 Then
                Application.Cursor = xlWait
            End If
            Set BrowserDocument = Nothing
            Set BrowserWindow = Nothing
        End If
    End If
NotLeaving:
    On Error GoTo 0
End Sub

Private Sub Browser_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    SetupBrowser
    If InStr(WebFormName, "BUILDING") <= 0 Then
        Application.Cursor = xlDefault
    End If
    WebFormReady = True
End Sub

Attribute VB_Name = "SC_XL_Class_StringMap"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2006 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================


Option Explicit

Private KeyList() As String
Private ValueList() As String
Private NumKeys As Long

Public Sub Class_Initialize()
    ReDim KeyList(16)
    ReDim ValueList(16)
    NumKeys = 0
End Sub

Private Function FindKeyNum(Key As String) As Long
    Dim KeyNum As Long

    For KeyNum = 0 To (NumKeys - 1)
        If KeyList(KeyNum) = Key Then
            FindKeyNum = KeyNum
            Exit Function
        End If
    Next
    FindKeyNum = -1
End Function

Public Sub SetValue(Key As String, Value As String)
    Dim KeyNum As Long

    KeyNum = FindKeyNum(Key)
    If KeyNum < 0 Then
        If NumKeys = UBound(KeyList) Then
            ReDim Preserve KeyList(UBound(KeyList) + 16)
            ReDim Preserve ValueList(UBound(ValueList) + 16)
        End If

        KeyNum = NumKeys
        NumKeys = NumKeys + 1
    End If
    
    KeyList(KeyNum) = Key
    ValueList(KeyNum) = Value
End Sub

Public Function GetValue(Key As String) As String
    Dim KeyNum As Long

    KeyNum = FindKeyNum(Key)
    If KeyNum >= 0 Then
        GetValue = ValueList(KeyNum)
        Exit Function
    End If
    GetValue = ""
End Function

Public Function GetSize() As Long
    GetSize = NumKeys
End Function

Public Function GetPosKey(Pos As Long) As String
    GetPosKey = ""
    If Pos < NumKeys Then
        GetPosKey = KeyList(Pos)
    End If
End Function

Public Function GetPosValue(Pos As Long) As String
    GetPosValue = ""
    If Pos < NumKeys Then
        GetPosValue = ValueList(Pos)
    End If
End Function

Attribute VB_Name = "SC_XL_Module_Core"
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2006 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================


Option Explicit

Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

Public Const SC_Version = "2.23"

Public Const SC_DIR As String = "/sc14"
Public Const SUITE_DIR As String = "/p/suite/current"
Public Const SEM_DIR As String = "/p/scm/3.0"
Public Const SEM_REQUEST_IDENTIFIER As String = "/p/scm/"
Public Const SC_DOMAIN As String = "omniture.com"
Public Const SC_OM_DEFAULT_DOMAIN As String = "excelclient."
Public SC_OM_Domain As String
Public SC_HOST As String
Public SC_URL As String
Public SUITE_URL As String
Public SEM_URL As String
Public SC_HOME_URL As String
Public SC_REPORTS_LOGIN_URL As String

Public Const SC_XL_SESSION_KEY As String = "ssSession"
Public Const SC_XL_COMPANY_KEY As String = "company"

Public Const SC_XL_DIR As String = SC_DIR & "/excel"
Public SC_XL_URL As String
Public SC_XL_LOGIN_URL As String
Public SC_XL_INSERT_URL As String
Public SC_XL_WIZARD_URL As String
Public SC_XL_HELP_URL As String

Public SC_XL_SEM_GET_URL As String
Public SC_XL_SEM_COMMIT_URL As String
Public SC_XL_SEM_BUILDING_URL As String

Public SC_XL_SEM_CHANGE_COLOR As Boolean

Public SC_XL_LIBRARY_URL As String
Public SC_XL_ADD_TO_LIBRARY_URL As String
Public SC_XL_PUBLISH_URL As String

Public SC_XL_REPORT_URL As String
Public SC_XL_BUILDING_URL As String
Public SC_XL_TIMEOUT_URL As String

Public OM_WINDOW_TITLE As String

Public Const SC_XL_LOGOUT_URI As String = "/logout.html"
Public Const SC_XL_VALIDATE_URI As String = SC_XL_DIR & "/validate.html"

Public SC_XL_Session As SC_XL_Class_Session
Public SC_XL_NEW_WORKSHEET_COUNT As Long

Sub SC_XL_Startup()
    SC_XL_NEW_WORKSHEET_COUNT = 1
    SC_XL_SEM_CHANGE_COLOR = False
    
    'Pull the locale out of the registry, defaulting to en_US
    SC_XL_Current_Locale = GetSetting("Omniture", "Omniture Excel Client", "LOCALE", SC_XL_DEFAULT_LOCALE)
    SC_OM_Domain = GetSetting("Omniture", "Omniture Excel Client", "DOMAIN", SC_OM_DEFAULT_DOMAIN)
        
    'SC_XL_Current_Locale = "w" ' enable w's locale for debugging
    
    'SC_XL_FixupDomain ("beta." & SC_DOMAIN)
    'SC_XL_FixupDomain ("beta-searchcenter." & SC_DOMAIN)
    'SC_XL_FixupDomain ("excelclient." & SC_DOMAIN)
    SC_XL_FixupDomain (SC_OM_Domain & SC_DOMAIN)
    
    Set SC_XL_Session = New SC_XL_Class_Session
    Set SC_XL_Event_App.App = Application

    OM_WINDOW_TITLE = SC_XL_Strings_GetText("Omniture Excel Client")

    SC_XL_Toolbar_Create

    Application.ScreenUpdating = True
End Sub

Sub SC_XL_Shutdown()
    SC_XL_Toolbar_Delete
    SC_XL_Query_Refresh_Timeout_Stop_All
End Sub

Function SC_XL_RangeIsValid(RngStr As String) As Boolean
    Dim Rng As Range
    On Error GoTo Invalid
    Set Rng = Application.Range(RngStr)
    SC_XL_RangeIsValid = True
    On Error GoTo 0
    Exit Function
Invalid:
    SC_XL_RangeIsValid = False
    On Error GoTo 0
End Function


Sub SC_XL_RangeOutline(Rng As Range)
    Dim FirstRow As Long
    Dim LastRow As Long
    Dim FirstCol As Long
    Dim LastCol As Long
    Dim RowNum As Long
    Dim ColNum As Long
    Dim DeepestLevel
    Dim Level
    Dim CurLevel
    Dim GroupRowList() As Long
    Dim GroupNumRows As Long
    Dim GroupRowNum As Long
    Dim GroupRngStr As String
    Dim GroupRng As Range

    ' Get rectangle
    FirstRow = Rng.Cells(1, 1).row
    LastRow = Rng.Cells(Rng.Rows.Count, 1).row
    FirstCol = Rng.Cells(1, 1).Column
    LastCol = Rng.Cells(1, Rng.Columns.Count).Column

    ' Skip headers
    For RowNum = FirstRow To LastRow
        If (Rng.Worksheet.Cells(RowNum, LastCol).Value = vbNullString) Or _
           ((Rng.Worksheet.Cells(RowNum, FirstCol).Value <> vbNullString) And _
            (Rng.Worksheet.Cells(RowNum, (FirstCol + 1)).Value <> vbNullString)) Then
            FirstRow = FirstRow + 1
        End If
    Next

    ' Find Deepest Level
    DeepestLevel = 0
    For RowNum = LastRow To FirstRow Step -1
        ColNum = FirstCol
        Do While (ColNum <= LastCol) And (Rng.Worksheet.Cells(RowNum, ColNum).Value = vbNullString)
            ColNum = ColNum + 1
        Loop
        Level = (ColNum - FirstCol)
        If Level > DeepestLevel Then
            DeepestLevel = Level
        End If
    Next

    ' Build Level Groups
    Rng.Worksheet.Outline.SummaryRow = xlSummaryAbove
    ReDim GroupRowList(16)
    GroupNumRows = 0
    For CurLevel = DeepestLevel To 1 Step -1
        For RowNum = LastRow To FirstRow Step -1
            ColNum = FirstCol
            Do While (ColNum <= LastCol) And (Rng.Worksheet.Cells(RowNum, ColNum).Value = vbNullString)
                ColNum = ColNum + 1
            Loop
            Level = (ColNum - FirstCol)
            If Level >= CurLevel Then
                If GroupNumRows = UBound(GroupRowList) Then
                    ReDim Preserve GroupRowList(UBound(GroupRowList) + 16)
                End If
                GroupRowList(GroupNumRows) = RowNum
                GroupNumRows = GroupNumRows + 1
            Else
                If GroupNumRows > 0 Then
                    If GroupNumRows > 1 Then
                        Set GroupRng = Rng.Worksheet.Range(Rows(GroupRowList(0)), Rows(GroupRowList(GroupNumRows - 1)))
                    Else
                        Set GroupRng = Rng.Worksheet.Range(Rows(GroupRowList(0)), Rows(GroupRowList(0)))
                    End If
                    GroupRng.Group
                    GroupNumRows = 0
                End If
            End If
        Next
    Next
    If GroupNumRows > 0 Then
        If GroupNumRows > 1 Then
            Set GroupRng = Rng.Worksheet.Range(Rows(GroupRowList(0)), Rows(GroupRowList(GroupNumRows - 1)))
        Else
            Set GroupRng = Rng.Worksheet.Range(Rows(GroupRowList(0)), Rows(GroupRowList(0)))
        End If
        GroupRng.Group
    End If
End Sub

Sub SC_XL_FixupDomain(domain As String)
If ((InStr(LCase(domain), SC_DOMAIN) <> 0)) Then
    SC_HOST = domain

    SC_URL = "https://" & domain & SC_DIR
    SEM_URL = "https://" & domain
    SUITE_URL = "https://" & domain & SUITE_DIR & "/index.html"
    SC_HOME_URL = "http://www.omniture.com"
    SC_REPORTS_LOGIN_URL = SC_URL & "/reports/index.html"
    
    SC_XL_URL = SC_URL & "/excel"
    
    If (SC_XL_LOGIN_URL = "") Then
        SC_XL_LOGIN_URL = "https://" & domain & SC_DIR & "/excel" & "/login.html?sess_locale=" & SC_XL_Current_Locale & "&" & SC_XL_SESSION_KEY & "="
    End If

    SC_XL_INSERT_URL = SC_XL_URL & "/insert.html?" & SC_XL_SESSION_KEY & "="
    SC_XL_WIZARD_URL = SC_XL_URL & "/wizard.html?" & SC_XL_SESSION_KEY & "="
    SC_XL_HELP_URL = SC_XL_URL & "/excel_help.html?sess_locale=" & SC_XL_Current_Locale & "&" & SC_XL_SESSION_KEY & "="

    SC_XL_SEM_GET_URL = SEM_URL & SEM_DIR & "/excel/get.html?" & SC_XL_SESSION_KEY & "="
    SC_XL_SEM_COMMIT_URL = SEM_URL & SEM_DIR & "/excel/commit.html?" & SC_XL_SESSION_KEY & "="
    SC_XL_SEM_BUILDING_URL = SEM_URL & SEM_DIR & "/excel/building.html?sess_locale=" & SC_XL_Current_Locale

    SC_XL_LIBRARY_URL = SUITE_URL & "?a=Tools.GetExcelWorkbookLibraryFromExcel&" & SC_XL_SESSION_KEY & "="
    SC_XL_ADD_TO_LIBRARY_URL = SUITE_URL & "?a=Tools.SaveExcelWorkbookLibrary&from_excel=1&" & SC_XL_SESSION_KEY & "="
    SC_XL_PUBLISH_URL = SC_REPORTS_LOGIN_URL & "?a=Excel.UploadWorkbook&" & SC_XL_SESSION_KEY & "="

    SC_XL_REPORT_URL = SC_XL_URL & "/report.html?" & SC_XL_SESSION_KEY & "="
    SC_XL_BUILDING_URL = SC_XL_URL & "/building.html?sess_locale=" & SC_XL_Current_Locale
    SC_XL_TIMEOUT_URL = SC_XL_URL & "/timeout.html?" & SC_XL_SESSION_KEY & "="
End If
End Sub

Function SC_XL_GetTempDirectory() As String
    Dim Directory As String
    Directory = Space(1024)
    ExpandEnvironmentStrings "%TEMP%", Directory, 1024
    SC_XL_GetTempDirectory = Left(Directory, InStr(Directory, Chr(0)) - 1)
End Function



Attribute VB_Name = "SC_XL_Class_HTTP"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'=====================================================================
'Omniture SiteCatalyst Software Copyright Notice and License
'
'Copyright © 2006 Omniture, Inc.  All Rights Reserved.
'
'This software is intellectual property owned by Omniture and is
'copyright of Omniture.  The copyright holders ("Omniture") are
'providing this software [including documentation, icons, or other
'related items] ("Software") under the following license.  By
'obtaining and/or using this Software, you ("the Licensee") agree
'that you have read, understood, and will comply with the following
'terms and conditions:
'
'*  Licensee is not allowed to distribute any part of this Software
'*  Licensee is not allowed to make any modifications to this
'   Software unless specific, written authorization has been received
'   from Omniture.
'*  Licensee is not allowed to copy this Software
'*  Licensee is not allowed to remove or alter any trademark, logo,
'   copyright, or other proprietary notices, legends, symbols or
'   labels in the Software.
'THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
'HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
'FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
'OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
'COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
'COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
'SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
'SOFTWARE OR DOCUMENTATION.
'The name and trademarks of copyright holders may NOT be used in
'advertising or publicity pertaining to the software without specific,
'written prior permission. Title to copyright in this software and
'any associated documentation will at all times remain with copyright
'holders.
'=====================================================================


Option Explicit

Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_HTTP = 3

Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_SECURE = &H800000
Private Const INTERNET_FLAG_FROM_CACHE = &H1000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Const INTERNET_FLAG_IGNORE_CERT_CN_INVALID = &H1000
Private Const INTERNET_FLAG_IGNORE_CERT_DATE_INVALID = &H2000

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
    ByVal Agent As String, _
    ByVal AccessType As Long, _
    ByVal ProxyName As String, _
    ByVal ProxyBypass As String, _
    ByVal Flags As Long _
) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
    ByVal hInternetSession As Long, _
    ByVal ServerName As String, _
    ByVal ServerPort As Integer, _
    ByVal Username As String, _
    ByVal Password As String, _
    ByVal Service As Long, _
    ByVal Flags As Long, _
    ByVal Context As Long _
) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInet As Long _
) As Boolean
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
    ByVal hConnect As Long, _
    ByVal Buffer As String, _
    ByVal NumberOfBytesToRead As Long, _
    NumberOfBytesRead As Long _
) As Boolean
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" ( _
    ByVal hHttpSession As Long, _
    ByVal Verb As String, _
    ByVal ObjectName As String, _
    ByVal Version As String, _
    ByVal Referer As String, _
    ByVal AcceptTypes As Long, _
    ByVal Flags As Long, _
    Context As Long _
) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" ( _
    ByVal hHttpRequest As Long, _
    ByVal Headers As String, _
    ByVal HeadersLength As Long, _
    ByVal sOptional As String, _
    ByVal OptionalLength As Long _
) As Boolean

Private m_HTTP As Long
Private m_Connection As Long

Private m_GetVars() As String
Private m_NumGetVars As Long
Private m_PostVars() As String
Private m_NumPostVars As Long

Private Sub Class_Initialize()
    ReDim m_GetVars(1, 16)
    m_NumGetVars = 0
    ReDim m_PostVars(1, 16)
    m_NumPostVars = 0
End Sub

Private Sub Class_Terminate()
    Erase m_GetVars
    Erase m_PostVars
End Sub

Public Property Let GetVars(Name As String, Value As String)
    m_GetVars(1, VarIndex("GET", Name, True)) = Value
End Property

Public Property Get GetVars(Name As String) As String
    Dim Index As Long
    Index = VarIndex("GET", Name, False)
    If Index > 0 Then
        GetVars = m_GetVars(1, Index)
    Else
        GetVars = ""
    End If
End Property

Public Property Let PostVars(Name As String, Value As String)
    m_PostVars(1, VarIndex("POST", Name, True)) = Value
End Property

Public Property Get PostVars(Name As String) As String
    Dim Index As Long
    Index = VarIndex("POST", Name, False)
    If Index > 0 Then
        PostVars = m_PostVars(1, Index)
    Else
        PostVars = ""
    End If
End Property

Private Function VarIndex(GetPost As String, Name As String, Add As Boolean) As Long
    Dim Index As Long
    Dim NumVars As Long
    If GetPost = "POST" Then
        NumVars = m_NumPostVars
    Else
        NumVars = m_NumGetVars
    End If
    For Index = 0 To NumVars - 1
        If (GetPost = "GET" And m_GetVars(0, Index) = Name) Or (GetPost = "POST" And m_PostVars(0, Index) = Name) Then
            VarIndex = Index
            Exit Function
        End If
    Next
    If Add Then
        If GetPost = "POST" Then
            If m_NumPostVars = UBound(m_PostVars, 2) Then
                ReDim Preserve m_PostVars(1, UBound(m_PostVars, 2) + 16)
            End If
            m_PostVars(0, m_NumPostVars) = Name
            m_PostVars(1, m_NumPostVars) = ""
            VarIndex = m_NumPostVars
            m_NumPostVars = m_NumPostVars + 1
        Else
            If m_NumGetVars = UBound(m_GetVars, 2) Then
                ReDim Preserve m_GetVars(1, UBound(m_GetVars, 2) + 16)
            End If
            m_GetVars(0, m_NumGetVars) = Name
            m_GetVars(1, m_NumGetVars) = ""
            VarIndex = m_NumGetVars
            m_NumGetVars = m_NumGetVars + 1
        End If
    Else
        VarIndex = -1
    End If
End Function

Private Function VarString(GetPost As String) As String
    Dim Data As String
    Dim Name As String
    Dim Value As String
    Dim Index As Long
    Dim NumVars As Long
    If GetPost = "POST" Then
        NumVars = m_NumPostVars
    Else
        NumVars = m_NumGetVars
    End If
    Data = ""
    For Index = 0 To NumVars - 1
        If GetPost = "POST" Then
            Name = m_PostVars(0, Index)
            Value = m_PostVars(1, Index)
        Else
            Name = m_GetVars(0, Index)
            Value = m_GetVars(1, Index)
        End If
        If Index > 0 Then
            Data = Data & "&"
        End If
        Data = Data & URLEncode(Name) & "=" & URLEncode(Value)
    Next
    VarString = Data
End Function

Function URLEncode(Data As String) As String
    Dim DataEncoded As String
    Dim length As Long
    Dim Pos As Long
    Dim Char As String

    length = Len(Data)
    DataEncoded = ""
    For Pos = 1 To Len(Data)
        Char = Mid$(Data, Pos, 1)
        If InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase$(Char)) = 0 Then
            If Asc(Char) < 16 Then
                Char = "%0" & Hex$(Asc(Char))
            Else
                Char = "%" & Hex$(Asc(Char))
            End If
        End If
        DataEncoded = DataEncoded & Char
    Next

    URLEncode = DataEncoded
End Function

Public Function GetPath(HOST As String, Path As String) As String
    GetPath = RequestPath(HOST, "GET", Path)
End Function

Public Function PostPath(HOST As String, Path As String) As String
    PostPath = RequestPath(HOST, "POST", Path)
End Function

Private Function RequestPath(HOST As String, method As String, Path As String) As String
    Dim Request As Long
    Dim Header As String
    Dim GetString As String
    Dim PostString As String
    Dim Data As String
    Dim DataChunk As String
    Dim DataChunkSize As Long
    Dim DataLeft As Boolean

    If OpenConnection(HOST) = False Then
        RequestPath = "ERROR: Connection Failed"
        Exit Function
    End If

    method = UCase$(method)
    Header = ""
    If method = "POST" Then
        Header = Header & "Content-Type: application/x-www-form-urlencoded"
    End If
    GetString = VarString("GET")
    PostString = ""
    If method = "POST" Then
        PostString = VarString("POST")
    End If
    Data = ""
    DataChunk = Space$(1024)

    Request = HttpOpenRequest( _
        m_Connection, _
        method, _
        Path & "?" & GetString, _
        "HTTP/1.1", _
        "", _
        0, _
        (0 _
            Or INTERNET_FLAG_SECURE _
            Or INTERNET_FLAG_PRAGMA_NOCACHE _
            Or INTERNET_FLAG_NO_CACHE_WRITE _
…