Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "runGAMS"

Option Explicit
' ------------------------------
'
' Description:
'   VB 4.0 code for running gams (version 2.25.089 or later) under Windows 95 or
'     Windows 3.1
'
'   This code is generic and does not change from application to application
'      to start it up use GAMSRUN as function as in spplication module
'
' ' Gams Specific Procedures/Function
'
'   GamsErrorString       - Function returns descriptive text about process object
'
' General Procedures/Function
'
'   ShowWait              - change cursor
' -------------------------------
'
' Public GAMS Constants
Public Const GAMS_STILL_ACTIVE = 258
' -----------------
' BEGIN API DECLARATIONS (API)
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Any, ByVal lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Any, ByVal lpCurrentDriectory As Any, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

'
' Constants used with CreateProcess
Public Const SW_SHOWMINNOACTIVE = 7
Public Const STARTF_USESHOWWINDOW = &H1
Public Const STARTF_USEPOSITION = &H4
Public Const STARTF_USESIZE = &H2
Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const WM_CLOSE = &H10
Public Const STILL_ACTIVE = 259

' Constants used with GetWindowLong
Public Const GWL_STYLE = (-16)
'
' Constants used with GetWindow
Public Const GW_HWNDNEXT = 2
'
' Structures used with CreateProcess
Public Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long      'LPBYTE
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type

Public Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type
' END API DECLARATIONS  (/API)
'-----------------------------


' run gams and return gams return code
Public Function GAMSrun(params As String, sGAMSFl As String) As Long
    Dim sError As String, sText As String, bOK As Boolean
    Dim sappfl As String
    Dim command As String
    Dim hWnd As Long, lSecs As Long
    Dim lCreateFlag As Long
    Dim StartUp As STARTUPINFO, udtProcess As PROCESS_INFORMATION
    Dim lRetAPI As Long, lRetProcess As Long, lRetWait As Long, lRetExit As Long, lRetErr As Long
    Dim sTitle As String, lRetWT As Long, lLength As Long, sFinished As String
    Dim return_code As Long
    Dim strBuffer As String
    Dim lenstr As Long
    Dim i As Long
    Dim substring As String
    Dim s As String
    ShowWait True
    
    'look in gamside.ini file and find name of gams executable
    strBuffer = Space(1024)
    lenstr = Len(strBuffer)
    return_code = GetPrivateProfileString("EXECUTE", "EXECUTABLE", "*NOT FOUND*", strBuffer, lenstr, "gamside.ini")
    
   
    If (return_code >= lenstr - 2) Then
        MsgBox "Buffer too small"
    End If
    
    'find e at end of gams.exe
    For i = Len(strBuffer) To 1 Step -1
      If Mid(strBuffer, i, 1) = "e" Then
            Exit For
       End If
    Next
    
    'take just non blank part of name for gams executable
    sappfl = Mid(strBuffer, 1, i)

    'form gams call for dos
    command = sappfl & " " & sGAMSFl & " " & params
    
    sFinished = "FINISHED"
    lLength = Len(sFinished) + 1

    ' wait in milliseconds for process completion
    lSecs = 1000
   
    ' set default return value
    lRetProcess = -1
    StartUp.lpTitle = "VB GAMS"
    StartUp.dwFlags = STARTF_USESHOWWINDOW
    StartUp.wShowWindow = SW_SHOWMINNOACTIVE
    StartUp.dwFlags = StartUp.dwFlags + STARTF_USEPOSITION + STARTF_USESIZE
    StartUp.dwXSize = 800
    StartUp.dwYSize = 600
    StartUp.cb = Len(StartUp)
    lCreateFlag = NORMAL_PRIORITY_CLASS
    
    ' Call CreateProcess to actually run GAMS
    '
    If CreateProcess(vbNullString, command, 0&, 0&, 1, lCreateFlag, 0&, 0&, StartUp, udtProcess) Then
        ' WaitForInputIdle call necessary to allow process to initialize itself.
        '  After call, it is possible to ascertain the window handle from the process handle.
        lRetWait = WaitForInputIdle(udtProcess.hProcess, lSecs)
     
        ' Get the window handle of the process
        hWnd = ProcToWnd32(udtProcess.dwProcessId)
     
        ' loop until process completed
        Do
            lRetAPI = WaitForSingleObject(udtProcess.hProcess, lSecs)
            If lRetAPI = GAMS_STILL_ACTIVE Then
                ' If the process is still running and there is a valid window handle,
                '   check the window's title to see if sFinished appears in the first
                '   lLength characters of the title.  If it does, then close window.
                ' This is necessary when the calling process doesn't have a console and
                '   the spawned job "hangs" untill the user closes the window.
                '   This "hanging" occurs when batch files call other batch files or
                '   executables.
                If IsWindowEnabled(hWnd) Then
                    sTitle = String(lLength, " ")
                    lRetWT = GetWindowText(hWnd, sTitle, lLength)
                    If InStr(UCase(sTitle), sFinished) Then
                        Call PostMessage(hWnd, WM_CLOSE, 0, 0)
                    End If
                End If
            Else   ' get the exit code of the spawned process
                lRetExit = GetExitCodeProcess(udtProcess.hProcess, lRetProcess)
            End If
        Loop While lRetAPI = GAMS_STILL_ACTIVE
        
        If lRetProcess = STILL_ACTIVE Then
            lRetProcess = -1
        End If

        ' Close process and thread handles.  Otherwise, memory leaks will occur.
        Call CloseHandle(udtProcess.hProcess)
        Call CloseHandle(udtProcess.hThread)
    Else
        lRetProcess = -1
'        lRetErr = Err.LastDllError
        lRetErr = 1
    End If
    GAMSrun = lRetProcess
    ShowWait False
End Function

' --------
' GamsErrorString returns a message describing kind of error encountered
'   returned from vbGams
' vbGams returns
'   1000 - missing input string
'   cmexRC + 100 * vbgamsRC
Public Function GamsErrorString(lGamsRC As Long) As String
Attribute GamsErrorString.VB_ProcData.VB_Invoke_Func = " \n14"
Dim nCmexRC As Integer, nVB_GamsRC As Integer
Dim sError As String
    If lGamsRC = 0 Then
        sError = "Gams completed successfully."
    ElseIf lGamsRC = 1000 Then
        sError = "Gams call missing input string."
    ElseIf lGamsRC = 2000 Then
        sError = "Error shelling out to Gams."
    Else
        sError = ""
        nCmexRC = lGamsRC Mod 100
        nVB_GamsRC = Int(lGamsRC / 100)
        If nCmexRC < 0 Then
            sError = "GAMS is probably not in path or your path does not point to GAMS"
        End If
        If nCmexRC > 0 Then
            Select Case nCmexRC
                Case 1
                    sError = "Solve is next (should not happen)."
                Case 2
                    sError = "compilation error"
                Case 3
                    sError = "execution error"
                Case 4
                    sError = "system limits"
                Case 5
                    sError = "file error"
                Case 6
                    sError = "parameter error"
                Case 7
                    sError = "licensing error"
                Case 8
                    sError = "GAMS system error"
                Case 9
                    sError = "GAMS could not be started"
            End Select
        End If
        If nVB_GamsRC > 0 Then
            If nCmexRC > 0 Then
                sError = sError & vbCrLf
            End If
            Select Case nVB_GamsRC
                Case 1
                    sError = sError & "could not create process dir"
                Case 2
                    sError = sError & "could not run gamsparm script"
                Case 3
                    sError = sError & "could not append user input to parameter scratch file"
                Case 4
                    sError = sError & "could not spawn gamscmex.exe"
                Case 5
                    sError = sError & "could not shell off 'gamsnext' script"
                Case 6
                    sError = sError & "could not delete process directory"
                    
            End Select
        End If
    End If
    
    GamsErrorString = sError
End Function

Function optstatus() As String
    Dim oResults As Range, oX As Range, nj As Integer, stat As Integer
    Set oResults = Worksheets("Results").Range("A1").CurrentRegion
     ' for each production center, update the results
    stat = 0
    For nj = 2 To oResults.Rows.Count
       If Trim(UCase(oResults.Cells(nj, 1))) = "MODELSTAT" Then
          stat = oResults.Cells(nj, 2)
       End If
    Next
    optstatus = "Unknown I cant find model stat"
    If stat > 0 Then
          Select Case stat
                Case 1
                     optstatus = "Optimal"
                Case 2
                     optstatus = "Optimal"
                Case 3
                     optstatus = "Unbounded"
                Case 4
                     optstatus = "Infeasible"
                Case Else
                     optstatus = "Bad Result from GAMS"
            End Select
    End If
End Function

' ------
' Sub ShowWait
'   Set cursor shape depending on Wait parameter
Public Sub ShowWait(ByVal Wait As Boolean)
Attribute ShowWait.VB_ProcData.VB_Invoke_Func = " \n14"
  If Wait Then
'    Screen.MousePointer = 11   ' hourglas
  Else
'    Screen.MousePointer = 0    ' default
  End If
End Sub
' -----
' ProcToWnd32
'    Given a process handle, the function checks each active
'    windows to see if is associated with the process.
'    If the process window has a title, function return a handle to it.
Private Function ProcToWnd32(hProcess As Long) As Long
Dim hWndNext As Long, sTitle As String, hWndProc As Long, lRet As Long, nCnt As Integer
Dim lChars As Long, lLength As Integer, lProcess As Long, nCntMatch As Integer
Dim lRet_gwl As Long

    lLength = 0
    lChars = 20
    hWndNext = GetTopWindow(0&)
    nCnt = 1
    nCntMatch = 0
    Do While True And nCnt < 300
        sTitle = ""
        hWndProc = GetWindowThreadProcessId(hWndNext, lProcess)
        If lProcess = hProcess Then ' Or hWndProc = dwProcess Then
            nCntMatch = nCntMatch + 1
            lRet_gwl = GetWindowLong(hWndNext, GWL_STYLE)
            lLength = GetWindowTextLength(hWndNext)

            If lLength > 0 Then
                lLength = lLength + 1   ' allow for null terminating char
                sTitle = String(lLength, " ")
                lRet = GetWindowText(hWndNext, sTitle, lLength)
                sTitle = Left(sTitle, InStr(sTitle, Chr$(0)) - 1)

                ProcToWnd32 = hWndNext
                Exit Do
            End If
            
        End If
        hWndNext = GetWindow(hWndNext, GW_HWNDNEXT)
        If IsNull(hWndNext) Then
            Exit Do
        End If
        If hWndNext = 0 Then
            Exit Do
        End If
        
        nCnt = nCnt + 1
    Loop

End Function





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


Attribute VB_Name = "trancode"

Option Explicit
' ------------------------------
'
' Description:
'   Application code for running a model through GAMS and Excel
'
'   There are three visual basic modules that are used in this application.
'   If you'd like to have a look at them, Select Macros from the Tool Menu, and
'   click on visual basic editor. In the project box click on modules and there they will be
'
'   The code which runs the transport application is in
'     trancode
'   Some base macros for starting up and managing the menu are in
'     basemacro
'   The code for running the GAMS job is included in
'     runGAMS
' ------------------------------
Public vbNullString As String    ' leave this variable null
Public vbCrLf As String

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

Attribute VB_Name = "basemacros"
Option Explicit
' ------------------------------
'
' Description:
'   Base Macro code for running a model through GAMS
'
'   There are six visual basic modules that are used in this application.
'   If you'd like to have a look at them, Select Macros from the Tool Menu, and
'   click on visual basic editor. In the project box click on modules and there they will be
'
'   The code which runs the transport application is in
'     trancode
'   Some base macros for starting up and managing the menu are in
'     basemacro
'   The code for running the GAMS job is included in
'     runGAMS, and GAMS_h
'   The code for managing file transfers between GAMS and Excel is in
'     utilities.
' ------------------------------

' Module Name: basemacros

' This code will not need to change much if you change applications

' Procedures/Functions:
'   Auto_Open           - setup environment on entering workbook
'   Auto_Close          - restore previous environment on exiting workbook
'   QuitApp             - forces execution of Auto_Close
'   RunApplication      - toggles edit mode to Run Application, ie without buttons, menu's
'   EditApplication     - toggles edit mode to Edit Application, ie with buttons, menu's
'   MapSheetGotoState   - go to specific state sheet from the main control form - MapSheet
'   GoToMapSheet        - go to the main control form - MapSheet
'
' See transport for model specific code.
' ------------------------------

' public variables to hold status of EXCEL environment when workbook opened.
'    Environment will be restored when workbook closed.
Public g_arToolbars(20) As String
Public g_varAppWindowState As Variant
Public g_bAppFormulaBar As Boolean
Public g_bAppStatusBar As Boolean


' toggles between Edit and Run modes.  Run mode
'   hides buttons, and most all xl native menu options.
Sub AppToggleEditMode(bEdit As Boolean)
Attribute AppToggleEditMode.VB_ProcData.VB_Invoke_Func = " \n14"
Dim varMenu As Variant
Dim nI As Integer, nTBCnt As Integer

    ActiveWorkbook.Worksheets("MapSheet").Activate
    Application.DisplayFormulaBar = bEdit
    Application.DisplayStatusBar = bEdit
    With ActiveWindow
        .DisplayWorkbookTabs = bEdit
        .DisplayHorizontalScrollBar = bEdit
        .DisplayVerticalScrollBar = bEdit
        .WindowState = xlMaximized
    End With
    For nI = 1 To Toolbars.Count
        If nI <= UBound(g_arToolbars) Then
            If bEdit Then
                If g_arToolbars(nI) <> "" Then
                    Application.Toolbars(g_arToolbars(nI)).Visible = True
                End If
            Else
                If Toolbars(nI).Visible Then
                    g_arToolbars(nI) = Toolbars(nI).Name
                    Toolbars(nI).Visible = False
                Else
                    g_arToolbars(nI) = ""
                End If
            End If
        End If
    Next
    With Application
        With .MenuBars(xlWorksheet)
            If bEdit Then
                .Reset
            Else
                For Each varMenu In .Menus
                    varMenu.Delete
                Next
            End If
            .Menus.Add "&Edit GAMS Spreadsheet Link"
            With .Menus("Edit GAMS Spreadsheet Link")
                .MenuItems.Add "&Edit Application", "EditApplication"
                .MenuItems(1).Enabled = True
            End With
        End With
        If bEdit Then
            With .MenuBars(xlWorksheet)
                .Reset
                .Menus.Add "&Execute GAMS Spreadsheet Link"
                With .Menus("Execute GAMS Spreadsheet Link")
                    .MenuItems.Add "&Run Application", "RunApplication"
                    .MenuItems(1).Enabled = True
                End With
            End With
        End If
        With .MenuBars(xlModule)
            If bEdit Then
                .Reset
            Else
                For Each varMenu In .Menus
                    varMenu.Delete
                Next
            End If
            .Menus.Add "&Edit GAMS Spreadsheet Link"
            With .Menus("Edit GAMS Spreadsheet Link")
                .MenuItems.Add "&Edit Application", "EditApplication"
                .MenuItems(1).Enabled = True
            End With
        End With
    End With
End Sub