Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 c83237d12e6986ae…

MALICIOUS

Office (OOXML)

362.1 KB Created: 2006-09-13 11:12:02 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2018-06-21
MD5: e7f40e31d1a0052adc7c6c63f7b796cc SHA-1: 73d2b482494fc1e0fb6a5df4fab51e70e442315d SHA-256: c83237d12e6986ae8cc33742621c0695f66a6967de77457114cfeeea85b463b0
278 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1203 Exploitation for Client Execution T1105 Ingress Tool Transfer

The sample is an Excel document containing a Workbook_Open macro that utilizes WScript.Shell and CreateObject to execute obfuscated VBA code. This code likely attempts to download and execute a second-stage payload from one of the embedded URLs, indicated by the critical OLE_VBA_SHELL and OLE_VBA_LOLBIN heuristics. The presence of a large embedded VBA macro further supports this, suggesting a downloader or droppper functionality.

Heuristics 9

  • VBA project inside OOXML medium 6 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Dim exeret As Long
    With CreateObject("Wscript.Shell")
    On Error GoTo exeRunError
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
            .lpVerb = "runas"
        .lpFile = Interaction.Environ("SYSTEMROOT") & "\System32\msiexec.exe"
        .lpParameters = "/qn /x {" & strPram & "}"
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        On Error GoTo Err_PROC
    Set obj = CreateObject(PROG_ID_MyNumberClientInterop)
    On Error GoTo 0
  • 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.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    End Sub
Private Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        IsInstalled = FsoObject.FileExists(Environ("ProgramFiles") & DLL_NAME)
  • Suspicious extracted artifact high EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • 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 https://api.cells.jp/OfficelDocArcvService.svc/grouplist In document text (OOXML body / shared strings)
    • https://api.cells.jp/OfficelDocArcvService.svc/chatworknaIn document text (OOXML body / shared strings)
    • https://api.cells.jp/OfficelDocArcvService.svc/uploadIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/entrancecusitemIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/customitemeditIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/keycustomitemIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/customeitemsetupIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/dakojinaddjsIn document text (OOXML body / shared strings)
    • https://mypage-sr.cells.jp/loginIn document text (OOXML body / shared strings)
    • https://mypage-sr.cells.jp/login?userno=In document text (OOXML body / shared strings)
    • https://www.cells.co.jp/daityo-s/manuals#drive-srIn document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/keycustomitem�In document text (OOXML body / shared strings)
    • https://api.cells.jp/OfficelDocArcvService.svc/chatworkna�In document text (OOXML body / shared strings)
    • https://api.cells.jp/OfficelDocArcvService.svc/uploadT6In document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/entrancecusitem5In document text (OOXML body / shared strings)
    • https://api.cells.jp/OfficelDocArcvService.svc/grouplist�In document text (OOXML body / shared strings)
    • https://api.cells.jp/DaLinkService.svc/entrancecusitem�v�In document text (OOXML body / shared strings)
    • https://mypage-sr.cells.jp/login�In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 336267 bytes
SHA-256: c98c0825d440879f95ebc23dc210a3aa90cb16be8d78af5cbc7d1698cd0855f4
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 1 eval/decoder/string-building token(s).
Preview script
First 1,000 lines of the extracted script
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
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)

    Set cellsdrive = Nothing

End Sub
Private Sub Workbook_Open()

    AuthInit

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


Attribute VB_Name = "MainModule"
Option Explicit

Private Const DB_PATH As String = "MNRelevance\Syslog.accdb"
Private Const CAPTION_MSG As String = "Cellsドライブ"

'シート名
Public Const SHEET_NAME_COMPANY As String = "会社情報"
Public Const SHEET_NAME_KOJIN As String = "個人情報"
'#36895 nr 20170518 start
Public Const SHEET_NAME_KYUYO As String = "給与データ"
'#36895 nr 20170518 end
Public Const SHEET_NAME_FUYO As String = "扶養データ"
Public Const RETURN_CODE_SUCCESS As String = "0"

Public cellsdrive As New MyNumber

Private Const PROG_ID_MyNumberClientInterop As String = "CellsDriveInterop.MyNumber.MyNumberClientInterop"

Private log As New LogManager
Public Function LogWrite(ByRef obj As Object, ByVal GUID As String, ByVal CompanyName As String, ByVal Screen As String, ByVal Process As String, ByVal result As String) As Boolean

    log.DatabasePath = PathCombine(ThisWorkbook.Path, DB_PATH)
    log.CellsDriveManager = obj

'20160316 kon    29859
    log.ADDSysLog GUID, CompanyName, Screen, Process, result
'    log.ADDSysLog guid, Replace(CompanyName, "'", "''", , , vbDatabaseCompare), Screen, Process, result
    
    log.AddSysLogDetails
    
End Function
Public Function LogWrite2( _
        ByVal CompanySystemkey As String, _
        ByVal CompanyName As String, _
        ByVal CompanyAccount As String, _
        ByVal Screen As String, _
        ByVal Processing As String, _
        ByVal summary As String, _
        ByVal systemkey As String, _
        ByVal Name As String, _
        ByVal result As String, _
        ByVal UpdateUserName As String, _
        ByVal UpdateMacineName As String, _
        ByVal UpdateDate As String)

    log.DatabasePath = PathCombine(ThisWorkbook.Path, DB_PATH)
    
    Dim col As Collection
    
'20160316 kon    29859
    Set col = SysLogParamerterCollection(CompanySystemkey, CompanyName, CompanyAccount, "1", Screen, Processing, summary, result, UpdateUserName, UpdateMacineName, UpdateDate)
    
'    Set col = SysLogParamerterCollection(CompanySystemkey, Replace(CompanyName, "'", "''", , , vbDatabaseCompare), CompanyAccount, "1", Screen, Processing, summary, result, UpdateUserName, UpdateMacineName, UpdateDate)
    
    Dim Id As String
    
    Id = log.AddLog2(col)
    
    'If summary = vbNullString Then summary = "1"
    If Not IsNumeric(summary) Then summary = "1"
    
    Set col = SysLogDetailsParamerterCollection(Id, "1", summary, systemkey, Name, result, vbNullString, UpdateDate)

    log.addLogD2 col
    
End Function
Public Function IsInstalled()

    Dim cm As New ComponentManager
    
    IsInstalled = cm.IsInstalled()

    Set cm = Nothing

End Function
Public Function IsOldInstalled()

    Dim cm As New ComponentManager
    
    IsOldInstalled = cm.IsOldInstalled

    Set cm = Nothing

End Function
Public Function IsNewVersion()

    Dim cm As New ComponentManager
    
    IsNewVersion = cm.IsNewVersion()

    Set cm = Nothing

End Function
Public Sub CellsDriveOldToolUnInstall()

    Dim cm As New ComponentManager
    
   '旧バージョンをサイレントアンインストール
    
    cm.UninstallProc "EF0C18A4-AA3A-4FDA-8C99-9D15A6930D14" '1.1.0.0
    cm.UninstallProc "EEC4F680-67EB-4EE6-8112-90D64F2967C5" '1.2.0.0
    
    Set cm = Nothing
    
End Sub
Public Function CellsDriveObject() As MyNumber

    Set CellsDriveObject = cellsdrive

End Function
Public Function SysLogParamerterCollection( _
    ByVal systemkey As String, _
    ByVal Name As String, _
    ByVal Account As String, _
    ByVal softId As String, _
    ByVal Screen As String, _
    ByVal proc As String, _
    ByVal summary As String, _
    ByVal result As String, _
    ByVal UpdateUserName As String, _
    ByVal UpdateMachine As String, _
    ByVal ProcDate As String) As Collection

    Dim col As New Collection
       
    col.Add systemkey, "SystemKey"
    col.Add Name, "Name"
    col.Add Account, "Account"
    col.Add softId, "softId"
    col.Add Screen, "Screen"
    col.Add proc, "Processing"
    col.Add summary, "Summary"
    col.Add result, "Results"
    col.Add UpdateUserName, "UpdateUserName"
    col.Add UpdateMachine, "UpdateMachine"
    col.Add ProcDate, "UpdateDate"

    Set SysLogParamerterCollection = col

End Function
Public Function SysLogDetailsParamerterCollection( _
    ByVal Id As String, _
    ByVal serialnumber As String, _
    ByVal fg As String, _
    ByVal UserNo As String, _
    ByVal UserName As String, _
    ByVal Results As String, _
    ByVal sSummary As String, _
    ByVal UpdateDate As String _
) As Collection

    Dim col As New Collection
        
    col.Add Id, "ID"
    col.Add serialnumber, "serialnumber"
    col.Add fg, "FG"
    col.Add UserNo, "UserNo"
    col.Add UserName, "UserName"
    col.Add Results, "results"
    col.Add vbNullString, "sSummary"
    col.Add UpdateDate, "UpdateDate"

    Set SysLogDetailsParamerterCollection = col

End Function
'''------------------------------------------------------------------
'''
''' Cellsドライブ機能が有効かどうか
'''
''' SoftkeyFlg : ソフトキーも調べるか
''' DisplayMessage : メッセージを表示するか
'''------------------------------------------------------------------
Public Function MNMode(ByVal CheckSoftkey As Boolean, ByVal DisplayMessage As Boolean, Optional ByRef wb As Workbook = Nothing) As Boolean

    If CheckSoftkey And Not IsSoftKeyExist Then
        If DisplayMessage Then MsgBox "Cellsソフトキーが設定されていません。"
        MNMode = False
        Exit Function
    End If
    
    If IsDriveToolInstalled Then
        MNMode = True
    Else
        If DisplayMessage Then MsgBox "Cellsドライブツールがインストールされていません。"
        MNMode = False
    End If
    
End Function
'''------------------------------------------------------------------
'''
'''ソフトキーが入力されているか
'''
'''
'''------------------------------------------------------------------
Private Function IsSoftKeyExist() As Boolean

    Dim TextFilename As String
    Dim FN As Long
    Dim key As String
    
    TextFilename = PathCombine(Workbooks("DaMenu.xls").Path, "DaProcess\drivePath.txt")
        
    FN = FreeFile()
  
    If Dir(TextFilename, vbNormal) <> "" Then
        FN = FreeFile()
        Open TextFilename For Input As #FN
            Input #FN, key
            Input #FN, key
        Close #FN
    End If
    
    If key <> vbNullString Then
        IsSoftKeyExist = True
    Else
        IsSoftKeyExist = False
    End If

End Function
'''------------------------------------------------------------------
'''
'''Cellsドライブルーツがインストールされてるか
'''
'''
'''------------------------------------------------------------------
Private Function IsDriveToolInstalled() As Boolean

    Dim obj As Object

    On Error GoTo Err_PROC
    Set obj = CreateObject(PROG_ID_MyNumberClientInterop)
    On Error GoTo 0
    Set obj = Nothing

    IsDriveToolInstalled = True
    Exit Function
Err_PROC:
    IsDriveToolInstalled = False
End Function

'#35578 nr 2017/02/08 s
Public Function IsKobunshoUpCdToolVersion()
    Dim cm As New ComponentManager
    IsKobunshoUpCdToolVersion = cm.IsKobunshoUpCdToolVersion()
    Set cm = Nothing
End Function

'#35578 nr 2017/02/08 e

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

Public Enum DB_PROVIDER
    DB_PROVIDER_JET = 1
    DB_PROVIDER_ACE = 2
End Enum

Private myobj As Object
Private con As ADODB.Connection

''' ログを記録するデータベースのパス
Private mDatabasePath As String
Public Property Get DatabasePath() As String
    DatabasePath = mDatabasePath
End Property
Public Property Let DatabasePath(ByVal NewValue As String)
    mDatabasePath = NewValue
End Property
''' マイナンバーオブジェクト
Public Property Get CellsDriveManager() As Object
    CellsDriveManager = myobj
End Property
Public Property Let CellsDriveManager(ByRef vNewValue As Object)
    Set myobj = vNewValue
End Property

'''
'
' データベース接続を初期化する
'
'''
Private Sub InitConnection(ByVal DbType As DB_PROVIDER)

    Dim ProviderString As String

    If DbType = DB_PROVIDER_JET Then
        ProviderString = "Microsoft.Jet.OLEDB.4.0"
    ElseIf DbType = DB_PROVIDER_ACE Then
        ProviderString = "Microsoft.Ace.OLEDB.12.0"
    Else
        Err.Raise 449
    End If

    ' データベースを開く
    On Error Resume Next
    Set con = New ADODB.Connection
    con.Provider = ProviderString
    con.Open mDatabasePath

End Sub
'''
'
' データベース接続を切断する
'
'''
Private Sub CloseConnection()
    
    con.Close
    Set con = Nothing
    
End Sub
Public Function AddLog2(ByRef SyslogParamCollection As Collection) As String

    InitConnection DB_PROVIDER_ACE

    Dim sql As String

    sql = JoinInsertSQL("syslog", SyslogParamCollection)
    sql = Replace(sql, "ID,", vbNullString)

    'SQL発行
    ExecSQLProc con, sql
    
    Dim rec As Recordset
     
    Set rec = con.Execute("Select @@IDENTITY")
    
    AddLog2 = rec(0).Value
    
    Set rec = Nothing
    
    CloseConnection
    
End Function
Public Sub addLogD2(ByRef SysLogDetailsParamerter As Collection)

    InitConnection DB_PROVIDER_ACE
    
    Dim sql As String
    
    sql = JoinInsertSQL("SyslogDetails", SysLogDetailsParamerter)
    
    'SQL発行
    ExecSQLProc con, sql
    
    CloseConnection

End Sub
Private Function JoinInsertSQL(ByVal tblName As String, ByRef col As Collection) As String

    Dim FiledName() As Variant
    Dim sql As String
    Dim item As Variant

    FiledName = GetFieldsArray(con, tblName)

    'INSERT文の項目名の作成
    sql = "Insert Into " & tblName & " ("

    For Each item In FiledName
        sql = sql & item & ","
    Next
    
    sql = Left(sql, Len(sql) - 1) & ") values ("

    'Insert文の値の作成
    For Each item In col
        sql = sql & """" & item & ""","
    Next

    sql = Left(sql, Len(sql) - 1) & ")"
    
    JoinInsertSQL = sql
    
    Erase FiledName
    
End Function
Private Function GetFieldsArray(ByRef dbCon As ADODB.Connection, ByVal TableName As String) As Variant()

    Dim i As Long
    Dim rec As New ADODB.Recordset
    
    Dim FiledArray() As Variant
    
    rec.CursorLocation = adUseClient
    
    rec.Open TableName, dbCon, adOpenForwardOnly, adLockReadOnly
    
    ReDim FiledArray(0 To rec.Fields.count - 1)
    
    For i = 0 To rec.Fields.count - 1
        FiledArray(i) = rec.Fields(i).Name
    Next i

    rec.Close

    Set rec = Nothing
    
    GetFieldsArray = FiledArray

End Function
Public Sub ADDSysLog(ByVal GUID As String, ByVal CompanyName As String, ByVal Screen As String, ByVal Process As String, ByVal result As String)

    InitConnection DB_PROVIDER_ACE

    Dim sql As String

    If myobj.SystemDate = vbNullString Then myobj.SystemDate = Now

    sql = "INSERT INTO SysLog (CompanySystemNo,CompanyName,softId,Screen,Processing,results,UpdateUserName,UpdateMachine,UpdateDate) "
    sql = sql & "VALUES ("
    sql = sql & "'" & GUID & "'"                            'GUID
'20160316 kon    29859
    sql = sql & ",""" & CompanyName & """"                          '事業所名
'    sql = sql & ",'" & Replace(CompanyName, "'", "''", , , vbDatabaseCompare) & "'"                          '事業所名
    sql = sql & ",1"                                                                            'ソフト
    sql = sql & ",'" & Screen & "'"                                                   '処理画面
    sql = sql & ",'" & Process & "'"                                                     '詳細
    sql = sql & ",'" & result & "'"                                                                 '結果
    sql = sql & ",'" & myobj.Name & "'"                                                         '更新者
    sql = sql & ",'" & GetComputerName & "'"                                      '更新端末名
    sql = sql & ",#" & myobj.SystemDate & "#)"

    If Not ExecSQLProc(con, sql) Then
        MsgBox "ログの記録に失敗しました。", vbInformation, "認証"
    End If

    CloseConnection

End Sub
Public Sub AddSysLogDetails()

    InitConnection DB_PROVIDER_ACE

    Dim sql As String
    Dim rec As New ADODB.Recordset
    Dim MaxIdNo As Long

    sql = "SELECT ID FROM SysLog"

    Set rec = con.Execute("Select max(id) from SysLog")

    MaxIdNo = rec(0)

    If myobj.SystemDate = vbNullString Then myobj.SystemDate = Now

    sql = ""
    sql = "INSERT INTO SyslogDetails (Id,serialnumber,results,UpdateDate) "
    sql = sql & "VALUES ("
    sql = sql & MaxIdNo                                                                         'ID
    sql = sql & ",1"                                                            '枝番
    sql = sql & ",'成功'"   '対象者名
    sql = sql & ",#" & myobj.SystemDate & "#)"

    If Not ExecSQLProc(con, sql) Then
        MsgBox "ログの記録に失敗しました。", vbInformation, "認証"
    End If

    Set rec = Nothing

    CloseConnection
    
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'更新
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''20150204 kon マイナンバー
Private Function ExecSQLProc(ByRef dbCon As ADODB.Connection, ByVal sql As String) As Boolean

    Dim ret As Boolean
    
    ret = False

    On Error Resume Next
    
    dbCon.BeginTrans
    
    dbCon.Execute sql
    
    If Err.Number <> 0 Then
        '異常
        dbCon.RollbackTrans
        MsgBox Err.Number & ":" & Err.Description, vbCritical + vbOKOnly, "登録"
    Else
        '正常
        dbCon.CommitTrans
        ret = True
    End If
    
    ExecSQLProc = ret
    
End Function

Attribute VB_Name = "ComponentManager"
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
Option Explicit
Private Const DLL_NAME As String = "\Cells\Cellsドライブ\CellsDriveInterop.dll"
Private Const DLL_NEW_VERSION As String = "1.3.0.0"
'#35578 nr 2017/02/08 s
Private Const DLL_KUPCDTOOl_VERSION As String = "1.3.0.1"
'#35578 nr 2017/02/08 e

Private FsoObject As Object

'構造体
Private Type SHELLEXECUTEINFO
    cbSize        As Long       'SHELLEXECUTEINFO構造体のサイズ
    fMask         As Long       '処理制御フラグ（定数参照）
    hwnd          As Long       'オーナーウインドウハンドル
    lpVerb        As String     '処理制御文字列(open,propertiesなど)
    lpFile        As String     '対象ファイル名
    lpParameters  As String     'プロパティ表示時未使用
    lpDirectory   As String     'プロパティ表示時未使用
    nShow         As Long       '表示モード
    hInstApp      As Long       'インスタンスハンドル
    lpIDList      As Long       'オプション
    lpClass       As String     'オプション
    hkeyClass     As Long       'オプション
    dwHotKey      As Long       'オプション
    hIcon         As Long       'オプション
    hProcess      As Long       'オプション
End Type

Private Const SEE_MASK_INVOKEIDLIST = &HC       'lpIDListメンバ使用
Private Const SEE_MASK_NOCLOSEPROCESS = &H40    'プロセスハンドルを取得する
Private Const SEE_MASK_FLAG_NO_UI = &H400       'エラーの時メッセージを表示しない
Private Const SW_SHOWNORMAL As Long = 1
Private Const INFINITE = &HFFFF ' Infinite timeout

Private Declare Function ShellExecuteEX Lib "shell32.dll" _
                Alias "ShellExecuteEx" (lpExecInfo As SHELLEXECUTEINFO) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Function IsInstalled() As Boolean

    IsInstalled = FsoObject.FileExists(Environ("ProgramFiles") & DLL_NAME)

End Function
Public Function IsOldInstalled() As Boolean

    'IsOldInstalled = FsoObject.FileExists(Environ("ProgramFiles") & Replace(DLL_NAME, "CellsDriveInterop", "MNApiLib"))
    Dim obj As Object

    On Error GoTo Err_PROC
    Set obj = CreateObject("Cells.MNApiLib.MyNumberInterop")
    On Error GoTo 0
    Set obj = Nothing

    IsOldInstalled = True
    Exit Function
Err_PROC:
    IsOldInstalled = False
End Function
Public Function IsNewVersion() As Boolean

    If DLL_NEW_VERSION <= GetFileVersion() Then
        IsNewVersion = True
    Else
        IsNewVersion = False
    End If

End Function
Private Function GetFileVersion()

    If IsInstalled() Then
        GetFileVersion = FsoObject.GetFileVersion(Environ("ProgramFiles") & DLL_NAME)
    Else
        GetFileVersion = vbNullString
    End If

End Function
Private Sub Class_Initialize()

    Set FsoObject = CreateObject("Scripting.FileSystemObject")

End Sub
Private Sub Class_Terminate()

    Set FsoObject = Nothing

End Sub
Public Sub UninstallProc(ByVal strPram As String)

    Dim ret     As Long
    Dim sdtSEXI As SHELLEXECUTEINFO

    With sdtSEXI
        .cbSize = Len(sdtSEXI)
        .fMask = SEE_MASK_NOCLOSEPROCESS
        .hwnd = Application.hwnd
        .lpVerb = "runas"
        .lpFile = Interaction.Environ("SYSTEMROOT") & "\System32\msiexec.exe"
        .lpParameters = "/qn /x {" & strPram & "}"
        .lpDirectory = vbNullChar
        .nShow = SW_SHOWNORMAL
        .hInstApp = 0
        .lpIDList = 0
    End With

    ret = ShellExecuteEX(sdtSEXI)
    ret = WaitForSingleObject(sdtSEXI.hProcess, INFINITE)
    
End Sub

'#35578 nr 2017/02/08 s
Public Function IsKobunshoUpCdToolVersion() As Boolean

    If DLL_KUPCDTOOl_VERSION <= GetFileVersion() Then
        IsKobunshoUpCdToolVersion = True
    Else
        IsKobunshoUpCdToolVersion = False
    End If

End Function
'#35578 nr 2017/02/08 e

Attribute VB_Name = "MyNumber"
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
Option Explicit
Private MyNumberObject As Object
Private mStateview As Boolean
Private mNumdays As String
'Private MyNumberObject As MNApiLib.MyNumberInterop
Private Sub Class_Initialize()
    
    'Set MyNumberObject = CreateObject("Cells.MNApiLib.MyNumberInterop")
    '共通化したの、StoInterropに
    Set MyNumberObject = CreateObject("Cells.MNApiLib.StorageInterop")

'    Set MyNumberObject = New MNApiLib.MyNumberInterop

    InitMNObj

End Sub
Private Sub Class_Terminate()

    Me.Remove
    Me.DisConnect

    Set MyNumberObject = Nothing
    
End Sub
Public Property Get LastError() As String

    LastError = MyNumberObject.LastError

End Property
Public Property Get UserNo() As String

    UserNo = MyNumberObject.UserNumber
    
End Property
Public Property Let UserNo(ByVal vNewValue As String)

    MyNumberObject.UserNumber = vNewValue

End Property
Public Property Get UseSoft() As String

    UseSoft = MyNumberObject.UseSoft

End Property
Public Property Let UseSoft(ByVal vNewValue As String)

    MyNumberObject.UseSoft = vNewValue

End Property
Public Property Get Version() As String

    Version = MyNumberObject.Version

End Property
Public Property Let Version(ByVal vNewValue As String)
    
    MyNumberObject.Version = vNewValue

End Property
Public Property Get CellsSoftKey() As String
    
    CellsSoftKey = MyNumberObject.CellsSoftKey

End Property
Public Property Let CellsSoftKey(ByVal vNewValue As String)

    MyNumberObject.CellsSoftKey = vNewValue

End Property
Public Property Get Name() As String
    
    Name = MyNumberObject.Name

End Property
Public Property Let Name(ByVal vNewValue As String)

    MyNumberObject.Name = vNewValue

End Property
Public Property Get Ticket() As String
    
    Ticket = MyNumberObject.Ticket

End Property
Public Property Let Ticket(ByVal vNewValue As String)

    MyNumberObject.Ticket = vNewValue

End Property
Public Property Get AccessRight() As String

    AccessRight = MyNumberObject.AccessRight

End Property
Public Property Let AccessRight(ByVal vNewValue As String)

    MyNumberObject.AccessRight = vNewValue

End Property
Public Property Get SystemDate() As String

    SystemDate = MyNumberObject.SystemDate

End Property
Public Property Let SystemDate(ByVal vNewValue As String)

    MyNumberObject.SystemDate = vNewValue

End Property
Public Property Get Authenticated() As Boolean
    
    Authenticated = MyNumberObject.Authenticated
    
End Property
Public Property Let Authenticated(ByVal vNewValue As Boolean)

    MyNumberObject.Authenticated = vNewValue
    
End Property
'Public Function Login(ByVal AccountClass As String, ByVal Account As String, ByVal password As String) As Boolean
Public Function Login() As Boolean

    If Me.UserNo = vbNullString Then InitMNObj

    'Login = MyNumberObject.Login(AccountClass, Account, password)
    Login = MyNumberObject.Login()
    
End Function
Public Function TicketCheck()

    TicketCheck = MyNumberObject.TicketCheck()

End Function
Public Function Remove()

    Remove = MyNumberObject.TicketRemove()

End Function
'Public Function SystemkeyClear(ByRef rng As Object, ByRef items() As MyNumberItem) As Boolean
Public Function SystemkeyClear(ByRef rng As Object, ByRef Items() As Object) As Boolean
    
    Dim buf As Variant
    Dim index As Long
    Dim ret As Boolean
    
    index = 0
    For Each buf In rng
        ReDim Preserve Items(index)
        'Set items(index) = New MyNumberItem
        Set Items(index) = CreateObject("Cells.MNApiLib.Data.MyNumberItem")
        Items(index).systemkey = buf
        index = index + 1
    Next
    
    Dim obj As Variant
    
    obj = Items
    
    ret = MyNumberObject.SystemkeyClear(obj)
    
    If ret Then Items = obj
    
    SystemkeyClear = ret

End Function
'Public Function Exsit(ByRef Col As Range, ByRef items() As MyNumberItem) As Boolean
Public Function Exsit(ByRef col As Collection, ByRef Items() As Object) As Boolean

    Dim buf As Variant
    Dim index As Long
    Dim ret As Boolean
    
    index = 0
    For Each buf In col
        ReDim Preserve Items(index)
'        Set items(index) = New MyNumberItem
        Set Items(index) = CreateObject("Cells.MNApiLib.Data.MyNumberItem")
        Items(index).systemkey = buf
        index = index + 1
    Next
    
    Dim obj As Variant
    
    obj = Items
    
    '#28806
    On Error GoTo Err_PROC
    ret = MyNumberObject.Exist(obj)
    On Error GoTo 0

    Items = obj
    
    Exsit = ret
    Exit Function
Err_PROC:
    Exsit = ret
End Function
'Public Function Edit(ByRef rng As Object, ByRef items() As MyNumberItem) As Boolean
Public Function Edit(ByRef rng As Object, ByRef Items() As Object) As Boolean

    Dim buf As Variant
    Dim index As Long
    Dim ret As Boolean
    
    index = 0
    For Each buf In rng
        ReDim Preserve Items(index)
        'Set items(index) = New MyNumberItem
        Set Items(index) = CreateObject("Cells.MNApiLib.Data.MyNumberItem")
       
        Items(index).systemkey = buf
        Items(index).MyNo = rng.item(buf)
        index = index + 1
    Next
    
    Dim obj As Variant
    
    obj = Items
    
    ret = MyNumberObject.Edit(obj)
    
    If ret Then Items = obj
    
    Edit = ret

End Function
'Public Function Reference(ByRef rng As Range, ByRef items() As MyNumberItem) As Boolean
Public Function Reference(ByRef rng As Collection, ByRef Items() As Object) As Boolean

    Dim buf As Variant
    Dim index As Long
    Dim ret As Boolean
    
    index = 0
    For Each buf In rng
        ReDim Preserve Items(index)
'        Set items(index) = New MyNumberItem
        Set Items(index) = CreateObject("Cells.MNApiLib.Data.MyNumberItem")
        Items(index).systemkey = buf
        index = index + 1
    Next
    
    Dim obj As Variant
    
    obj = Items
    
    ret = MyNumberObject.Reference(obj)
    
    If ret Then Items = obj
    
    Reference = ret

End Function
Public Function UserLogin(ByVal password As String) As Boolean

    UserLogin = MyNumberObject.UserLogin(password)

End Function
Public Sub InitMNObj()

    Dim TextFilename As String
    Dim f As Long
    Dim vNo As String
    Dim uno As String
    Dim dno As String
    Dim Numdays As String
    Dim View As Boolean

    f = FreeFile()
    Open PathCombine(Workbooks("DaMenu.xls").Path, "ver.txt") For Input As #f
        Input #f, vNo
    Close #f

    TextFilename = PathCombine(Workbooks("DaMenu.xls").Path, "DaProcess\drivePath.txt")
    If Dir(TextFilename, vbNormal) <> "" Then
        f = FreeFile()
        Open TextFilename For Input As #f
            Input #f, uno
            Input #f, dno
            Input #f, Numdays
            Input #f, View
        Close #f
    End If

    With Me
        .UserNo = uno
        .UseSoft = "10"
        .CellsSoftKey = dno
        .Version = vNo
        .Numdays = Numdays
        .StateView = View
    End With
End Sub
Public Property Get StateView() As Boolean
    
    StateView = mStateview
    
End Property
Public Property Let StateView(ByVal vNewValue As Boolean)
    
    mStateview = vNewValue
    
End Property
Public Property Get Numdays() As String

    Numdays = mNumdays

End Property
Public Property Let Numdays(ByVal vNewValue As String)
    
    mNumdays = vNewValue

End Property
Public Function Connect() As Boolean

    Connect = MyNumberObject.Connect

End Function
Public Function DisConnect() As Boolean
    
    DisConnect = MyNumberObject.TicketRemove()

End Function
Public Function CompanyAccount(ByRef lst() As Object) As Boolean
'Public Function CompanyAccount(ByRef lst() As CompanyAccount) As Boolean

    Dim ret As Boolean
    Dim obj As Variant
    Dim item As Variant
    Dim i As Long
    
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 707584 bytes
SHA-256: de84d4445404d396759cb25d3049b76728c53925024e07a382fff8e160f6898e
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 1 eval/decoder/string-building token(s). Carved artifact contains 6 long base64-like blob(s).

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