Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-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_Name = "modIO"
Option Explicit

Public Const APP_TITLE = "Itel Office"

Public Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWDEFAULT As Long = 10

Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Declare Function RegDeleteKey Lib "advapi32.dll" _
  Alias "RegDeleteKeyA" (ByVal lngKey As Long, _
  ByVal lpSubKey As String) As Long
  
Declare Function RegDeleteValue Lib "advapi32.dll" _
  Alias "RegDeleteValueA" (ByVal lngKey As Long, ByVal lpValueName _
  As String) As Long
  
Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" (ByVal lngKey As Long, ByVal lpSubKey _
  As String, ByVal ulOptions As Long, ByVal samDesired _
  As Long, phkResult As Long) As Long
  
Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal lngKey As Long) As Long

'This is a custom declare so we can pass in 0& for security attribute argument.
Declare Function RegCreateKeyExNoSec Lib "advapi32.dll" _
  Alias "RegCreateKeyExA" (ByVal lngKey As Long, ByVal lpSubKey As String, _
  ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
  As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As _
  Long, phkResult As Long, lpdwDisposition As Long) As Long

'Original declare.
Declare Function RegQueryValueEx Lib "advapi32.dll" _
  Alias "RegQueryValueExA" (ByVal lngKey As Long, ByVal lpValueName _
  As String, ByVal lpReserved As Long, lpType As Long, lpData As _
  Any, lpcbData As Long) As Long

'This is a custom declare that retrieves string values.
Declare Function RegQueryValueExString Lib "advapi32.dll" _
  Alias "RegQueryValueExA" (ByVal lngKey As Long, ByVal lpValueName _
  As String, ByVal lpReserved As Long, lpType As Long, _
  ByVal lpData As String, lpcbData As Long) As Long

'This is a custom declare that retrieves string values.
Declare Function RegSetValueExString Lib "advapi32.dll" _
  Alias "RegSetValueExA" (ByVal lngKey As Long, ByVal lpValueName As _
  String, ByVal Reserved As Long, ByVal dwType As Long, _
  ByVal lpData As String, ByVal cbData As Long) As Long

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

Public Const HIVE = HKEY_CURRENT_USER
Public Const HKLM = HKEY_LOCAL_MACHINE
Public Const KEY = "Software\Itel\IO"

'This constant preserves key when system is rebooted.
Public Const REG_OPTION_NON_VOLATILE = 0

'This constant does NOT preserve key when system is rebooted.
'Use this to write temporary values to the registry.
Public Const REG_OPTION_VOLATILE = 1

Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const SYNCHRONIZE = &H100000
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE _
  Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_SET_VALUE = &H2
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE _
  Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE _
  Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS _
  Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

'New Registry Key created.
Public Const REG_CREATED_NEW_KEY = &H1

'Existing Key opened.
Public Const REG_OPENED_EXISTING_KEY = &H2

'Free form binary.
Public Const REG_BINARY = 3

'32-bit number.
Public Const REG_DWORD = 4

'32-bit number.
Public Const REG_DWORD_BIG_ENDIAN = 5

'32-bit number (same as REG_DWORD).
Public Const REG_DWORD_LITTLE_ENDIAN = 4

'Unicode nul terminated string.
Public Const REG_EXPAND_SZ = 2

'Symbolic Link (unicode).
Public Const REG_LINK = 6

'Multiple Unicode strings.
Public Const REG_MULTI_SZ = 7

'No value type.
Public Const REG_NONE = 0

'Resource list in the resource map.
Public Const REG_RESOURCE_LIST = 8

'Unicode nul terminated string.
Public Const REG_SZ = 1

Public Const ERROR_SUCCESS = 0&

Function SetRegString(ByVal lngHive As Long, ByVal strKey As String, ByVal strValueName As String, ByVal strValue As String) As Long
'Declare variables.
  Dim lngValueLength As Long
  Dim lngKey As Long
  Dim strMsg As String

'Call custom function in modRegistry to get key handle.
  lngKey = GetKeyHandle(lngHive, strKey)
  
  If lngKey <> 0 Then
  
'Add 1 for terminating null char.
    lngValueLength = Len(strValue) + 1
    SetRegString = RegSetValueExString(lngKey, strValueName, 0&, REG_SZ, strValue, lngValueLength)
    
    If RegCloseKey(lngKey) <> ERROR_SUCCESS Then
      strMsg = "Error closing registry key handle."
      MsgBox Prompt:=strMsg, Buttons:=vbCritical, Title:=APP_TITLE
    End If
  End If
End Function
'===============================================================
'Called from SetRegString. Gets key handles.
'---------------------------------------------------------------
Function GetKeyHandle(ByVal lngHive As Long, ByVal strKey As String) As Long
'Declare variables.
  Dim strClass As String
  Dim lngReturn As Long
  Dim lngKey As Long
  Dim lngDisposition As Long
  Dim strMsg As String

  strClass = ""

'Call Win32 API function to create a key.
  lngReturn = RegCreateKeyExNoSec(lngHive, strKey, 0&, strClass, _
    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, lngKey, lngDisposition)
  
  If lngReturn <> ERROR_SUCCESS Then
    strMsg = "RegCreateKeyEx call failed."
    MsgBox Prompt:=strMsg, Buttons:=vbCritical
    lngKey = 0
  End If

  GetKeyHandle = lngKey
End Function
'===============================================================
'Called from frmUserInfo, UserForm_Initialize to retrieve keys
'stored in Registry and populate frmUserInfo text boxes.
'---------------------------------------------------------------
Function GetRegString(ByVal lngHive As Long, ByVal strKey As String, ByVal strValueName As String) As String
'Declare variables.
  Dim strBuffer As String
  Dim lngReturn As Long
  Dim lngValueType As Long
  Dim lngValueLength As Long
  Dim lngKey As Long
  Dim strMsg As String
  
'Call custom function in modRegistry to open a key.
  lngKey = OpenKey(lngHive, strKey)
  
  If lngKey <> 0 Then
    strBuffer = VBA.String$(255, 0)
    lngValueLength = 256

'Call Win32 API function to return a key's value.
    lngReturn = RegQueryValueExString(lngKey, strValueName, 0&, lngValueType, strBuffer, lngValueLength)
    If lngReturn = ERROR_SUCCESS Then
      If lngValueType = REG_SZ Then
        strBuffer = VBA.Left$(strBuffer, lngValueLength - 1)
      Else
        strMsg = "The value of the key is not a string."
        MsgBox Prompt:=strMsg, Buttons:=vbExclamation, Title:=APP_TITLE
        strBuffer = ""
      End If
    Else
      strBuffer = ""
    End If
      
'Call Win32 API function to close the open key.
    If RegCloseKey(lngKey) <> ERROR_SUCCESS Then
      strMsg = "Error closing registry key handle."
      MsgBox Prompt:=strMsg, Buttons:=vbExclamation, Title:=APP_TITLE
    End If
  End If
  
  GetRegString = strBuffer
End Function
'===============================================================
'Called from frmUserInfo, UserForm_Initialize to open keys
'stored in Registry.
'---------------------------------------------------------------
Function OpenKey(ByVal lngHive As Long, ByVal strKey As String) As Long
  Dim lngReturn As Long
  Dim lngKey As Long
  Dim strMsg As String

'Call Win32 API function to open a key so that you can get its value.
  lngReturn = RegOpenKeyEx(lngHive, strKey, 0&, KEY_ALL_ACCESS, lngKey)
  
  If lngReturn <> ERROR_SUCCESS Then
    lngKey = 0
  End If
  
  OpenKey = lngKey
End Function


'===============================================================
' Retrieves a DWORD value from Registry. Closest VB type equivalent is a Long
' lngHive is handle to reg key hive
' strKey is key name - eg Software\Itel\IO
' strValue is registry item to retrieve
' Returns Long value
'---------------------------------------------------------------
Function GetRegLong(ByVal lngHive As Long, ByVal strKey As String, ByVal strValue As String) As Long

'Declare variables.
  'Dim strBuffer As Byte
  Dim lngReturn As Long
  Dim lngValueType As Long  ' REG_DWORD in this case
  Dim lngValueLength As Long  ' How much data to get - 4 bytes worth
  Dim lngKey As Long
  Dim strMsg As String
  
  Dim lBuffer As Long   ' Buffer for long value
  
'  Dim lDataBufferSize As Long
  lngValueLength = 4 '4 bytes = 32 bits = long
  
  lngValueType = REG_DWORD   ' 4
'Call custom function in modRegistry to open a key.
  lngKey = OpenKey(lngHive, strKey)
  
  If lngKey <> 0 Then
    lBuffer = -1

'Call Win32 API function to return a key's value.
    lngReturn = RegQueryValueEx(lngKey, strValue, 0&, lngValueType, lBuffer, lngValueLength)
                 
'    lngReturn = RegQueryValueEx(lngKey, strValueName, 0&, lngValueType, strBuffer, lngValueLength)
    If lngValueLength < 1 Then
        GetRegLong = -1   ' error
        RegCloseKey lngKey
        Exit Function
    End If
    If lngReturn = ERROR_SUCCESS Then
      If lngValueType = REG_DWORD Then
        'strBuffer = VBA.Left$(strBuffer, lngValueLength - 1)
      Else
      '  strMsg = "The value of the key is not a DWORD as expected."
      '  MsgBox Prompt:=strMsg, Buttons:=vbExclamation, Title:=APP_TITLE
        lBuffer = -2
      End If

    End If
      
'Call Win32 API function to close the open key.
    If RegCloseKey(lngKey) <> ERROR_SUCCESS Then
      strMsg = "Error closing registry key handle."
      MsgBox Prompt:=strMsg, Buttons:=vbExclamation, Title:=APP_TITLE
    End If
  End If
  
  'GetRegString = strBuffer
  GetRegLong = lBuffer
End Function


Sub IO()
'
' IO Macro
' IO Macro created 01/12/00 by Angus Comber
'
Dim ret As Long
Dim sPath As String
sPath = GetRegString(HKLM, KEY, "Programs")
If sPath = "" Then
    MsgBox "The path to the Itel Office database could not be located.  Configure the Itel Office database path and try again"
    Exit Sub
End If
If VBA.Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
ret = Shell(sPath & "ab.exe", vbNormalFocus)

'frmAddress.Show
End Sub

Sub Merge_Now()
'
' Merge_Now Macro
' Merge_Now Macro created 10/03/01 by Angus Comber
'
On Error Resume Next
AppActivate ("Merge?"), False

SendKeys "{Enter}", True
End Sub




Attribute VB_Name = "NewMacros"
Option Explicit

Public bSaveAs As Boolean
Public bAlreadySaved As Boolean

Sub FileSave()
'
' FileSave Macro
' Saves the active document or template
    Dim bRet As Boolean
    ' Can we work out if already saved - eg is this a new document or
    ' saving changes to an existing document
    Dim sDocPath As String
    Dim file_name As String
    
    sDocPath = ActiveDocument.Path & "\" & ActiveDocument.Name

    file_name = VBA.Dir(sDocPath)
    If file_name = "" Then  ' Only enter in History if a new document
        bRet = SaveHistory          ' otherwise get lots of repeated entries
    End If                   ' for documents as user re-saves
    
    ' Ensure you ALWAYS do as user requested - ie Save the document
    ActiveDocument.Save
End Sub

Sub FileSaveAs()
'
' FileSaveAs Macro
' Saves a copy of the document in a separate file
'
    bSaveAs = True
    SaveHistory
    
    ' Ensure you ALWAYS do as user requested - ie Save the document
    

End Sub

Public Function SaveHistory() As Boolean
On Error Resume Next
Dim dlganswer As Long
Dim sDocPath As String
Dim sLocation As String
Dim lDT As Long

Dim ret As Long
Dim sPath As String
Dim sProgsPath As String
Dim sSiteID As String
Dim sHType As String
Dim sSite As String
Dim sComputername As String

' Default to Save document when saved to History
SaveHistory = True

' If already saved no need to do anything - so exit
' BUT if user wants to do a SaveAs to another location then allow save
bAlreadySaved = ActiveDocument.Saved
If VBA.Err.Number <> 0 Then
    If bAlreadySaved = True Then
        If bSaveAs = False Then
            'SaveHistory = False
            Exit Function
        End If
    End If
End If
' Get IOffice database path
sPath = GetRegString(HKLM, KEY, "Path")
sProgsPath = GetRegString(HKLM, KEY, "Programs")
If sProgsPath = "" Then sProgsPath = sPath
If sPath = "" Then
    MsgBox "The path to the Itel Office database could not be located.  Configure the Itel Office database path and try again"
    Exit Function
End If
If VBA.Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    
    'Show FileSaveAs Dialog
    dlganswer = Dialogs(wdDialogFileSaveAs).Show
   ' if error exit
   If dlganswer = False Then
        SaveHistory = False
        Exit Function
    End If
   ' -1 = Save
   '  0 = Cancel
    
    If ActiveDocument.Saved = True Then
        sDocPath = ActiveDocument.Path & "\" & ActiveDocument.Name
        
    Else  'user must have pressed Cancel or not saved doc
        SaveHistory = False
        Exit Function ' Don't need to save anything to IO if file not saved!
    End If

' Set Document variables so can enter in History table
'ActiveDocument.Variables("SiteID").Value = 1570
sSiteID = ActiveDocument.Variables("SiteID").Value
sHType = ActiveDocument.Variables("HType").Value
    
    sDocPath = "'" & sDocPath & "'"
    
If VBA.Right$(sProgsPath, 1) <> "\" Then sProgsPath = sProgsPath & "\"
 sProgsPath = sProgsPath & "History.exe"

Dim nPrompt As Long
nPrompt = GetRegLong(HIVE, KEY, "PromptForSite")
If nPrompt = 1 Then ' if user elected to prompt for Site
    If sSiteID = "" Then
        ret = ShellExecute(0&, "Open", sProgsPath, sDocPath & " " & sHType, 0&, SW_SHOWNORMAL)
    Else
        ret = ShellExecute(0&, "Open", sProgsPath, sDocPath & " " & sHType & " " & sSiteID, 0&, SW_SHOWNORMAL)
    End If
End If

    bSaveAs = False
End Function