Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Attribute VB_Control = "cmdProtectBakBak, 17, 0, MSForms, CommandButton"
Attribute VB_Control = "lblPrj_XML, 16, 1, MSForms, Label"
Attribute VB_Control = "CmdShowOutline, 15, 2, MSForms, CommandButton"
Attribute VB_Control = "lblMmb_CName10, 14, 3, MSForms, Label"
Attribute VB_Control = "lblMmb_CName9, 13, 4, MSForms, Label"
Attribute VB_Control = "lblMmb_CName8, 12, 5, MSForms, Label"
Attribute VB_Control = "lblMmb_CName7, 11, 6, MSForms, Label"
Attribute VB_Control = "lblMmb_CName6, 10, 7, MSForms, Label"
Attribute VB_Control = "lblMmb_CName5, 9, 8, MSForms, Label"
Attribute VB_Control = "lblMmb_CName4, 8, 9, MSForms, Label"
Attribute VB_Control = "lblMmb_CName3, 7, 10, MSForms, Label"
Attribute VB_Control = "lblMmb_CName2, 6, 11, MSForms, Label"
Attribute VB_Control = "lblDtl_ppsCName, 5, 12, MSForms, Label"
Attribute VB_Control = "lblDtl_CoOrgCName2, 4, 13, MSForms, Label"
Attribute VB_Control = "lblDtl_CoOrgCName1, 3, 14, MSForms, Label"
Attribute VB_Control = "lblDtl_thisOrgCName, 2, 15, MSForms, Label"
Attribute VB_Control = "lblDtl_AppCName, 1, 16, MSForms, Label"
Attribute VB_Control = "CmdProtecBB, 0, 17, MSForms, CommandButton"

Const gcstrWarning = "您现在不能检查保护文档或打印文档，请根据以下三个步骤操作：" & vbCr _
                        & " 1)如果您是Word2000,word XP, word 2003或以上版本用户，请把Word宏的安全性设为:""中""" & vbCr _
                        & "     方法: Word菜单->工具->宏->安全性->安全级,设置为""中""" & vbCr _
                        & "     (如果您是Word97用户，继续执行以下步骤)" & vbCr _
                        & "     (如果您是Office2007用户，点击word左上角""安全警告""处""选项""中的""启用此内容"")" & vbCr _
                        & " 2)关闭本文档，重新打开本文档" & vbCr _
                        & " 3)点击""启用宏""按钮，即可开始填写本文档或打印了"
                        
Private Const mstrPassword = "997168"

'// hys added only for hide the undo menu when caculate the form fields 2005-12-5
Private WithEvents thisApp As Application
Attribute thisApp.VB_VarHelpID = -1

Private undoTag As Integer

'//end


Private Declare Function Htmlhelp Lib "hhctrl.ocx" Alias "HtmlHelpA" ( _
                ByVal hwndCaller As Long, _
                ByVal pszFile As String, _
                ByVal uCommand As Long, _
                ByVal dwData As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
                ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
Private gblnClosing As Boolean
                

'得到业务处理对象
Private Function GetProjectDoc() As Object
    On Error Resume Next
    Dim lobjPJInput  As Object
    Set lobjPJInput = CreateObject("ISIS_Proposal.TDocument")
    If lobjPJInput Is Nothing Then
        MsgBox "不能检查保护，导致该问题的原因可能有：" & Chr(13) & "  1. 文件ISIS_Proposal2010.dll和申请书不在同一目录" & Chr(13) & "  2. 您同时打开了旧版本的申请书" & Chr(13) & Chr(13) & "请确认不再存在以上问题后，关闭【所有】已打开的Word文件，然后重新打开此申请书！" & Chr(13) & Chr(13) & "  注：如果您使用的是Vista系统，在关闭【所有】已打开的Word文件后，" & Chr(13) & "  还需要运行申请书同一目录下的FirstRun.exe程序，然后再重新打开此申请书。", vbOKOnly, "自然科学基金申请书"
        Exit Function
    End If
    
    Dim version As String
    version = lobjPJInput.GetVersion
    If version <> "2009" Then
        MsgBox "不能检查保护，导致该问题的原因可能有：" & Chr(13) & "  1. 文件ISIS_Proposal2010.dll和申请书不在同一目录" & Chr(13) & "  2. 您同时打开了旧版本的申请书" & Chr(13) & Chr(13) & "请确认不再存在以上问题后，关闭【所有】已打开的Word文件，然后重新打开此申请书！" & Chr(13) & Chr(13) & "  注：如果您使用的是Vista系统，在关闭【所有】已打开的Word文件后，" & Chr(13) & "  还需要运行申请书同一目录下的FirstRun.exe程序，然后再重新打开此申请书。", vbOKOnly, "自然科学基金申请书"
        Exit Function
    End If
    
    Set GetProjectDoc = lobjPJInput
End Function

Public Sub PrintDoc()
    '打印前作些页面上的处理，
    '例如：将文档中的所有lbl设背景为白，检查保护按钮背景消失，

    Dim strPrintPages As String
    Dim strWarning As String
    Dim lret As Long
    Dim strVersion As String
    On Error Resume Next
'
    Dim lobjPJInput  As Object
    Set lobjPJInput = GetProjectDoc
    
    If Not lobjPJInput.ischecked(ThisDocument) Then
        strWarning = "注：申请书在提交之前必须检查保护"
        lret = MsgBox(strWarning, vbYesNoCancel + vbQuestion, "自然科学基金申请书")
        If lret = vbYes Then
            lobjPJInput.ClickButton ThisDocument
            Exit Sub
        ElseIf lret = vbNo Then

        ElseIf lret = vbCancel Then
            Exit Sub
        End If
    End If
    
    On Error Resume Next
    ThisDocument.Unprotect mstrPassword
    strVersion = Trim(ThisDocument.Bookmarks("version").Range.Text)
    ThisDocument.Protect wdAllowOnlyFormFields, True, mstrPassword
    MsgBox "请注意：您要打印的纸件申请书的版本号是：" & strVersion & Chr(13) & _
            "您提交的纸件申请书资料的版本号必须与您提交的电子申请书的版本号一致", vbInformation, "自然科学基金申请书"
    On Error GoTo ErrHandle
    
    Dim dlgPrint As Dialog
    lobjPJInput.ForPrint ThisDocument, True
    
    Set dlgPrint = Dialogs(wdDialogFilePrint)
    lret = -1
    Err.Clear
    On Error GoTo ErrNoPrinter
    lret = dlgPrint.Display
    If lret = 0 Then
        GoTo ErrHandle
    End If
    dlgPrint.Execute
    
    GoTo ErrHandle
ErrNoPrinter:
    If lret < 0 Then
        MsgBox "没有装有打印机或别的错误，请检查打印机！", vbInformation, 自然科学基金申请书
    End If
ErrHandle:
    lobjPJInput.ForPrint ThisDocument, False
    
    Set lobjPJInput = Nothing
End Sub

'miniIRIS打印
Public Sub PrePrint()
    '//hys 2002-12.24
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ForPrint ThisDocument, True
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
End Sub



Private Sub CmdProtecBB_Click()
    
    On Error Resume Next
    
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    gblnClosing = True

    objPrjDoc.ClickButton ThisDocument
        
    gblnClosing = False
    
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
End Sub

Private Sub cmdProtectBakBak_Click()
    CmdProtecBB_Click
End Sub

Private Sub CmdShowOutline_Click()

    Dim i As Integer
    Dim FilePath As String
    'Dim objDoc As Word.Document
    Dim granttype As String
    Dim showSection As Integer
    Dim helpFile    As String
    Dim fileName    As String
    Dim objPrjDoc As Object
    
    Set objPrjDoc = GetProjectDoc
    
    granttype = objPrjDoc.getPJType(ThisDocument)
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
 
    Select Case granttype
        Case "面上项目"
            fileName = "310.htm"
        Case "重点项目"
            fileName = "320.htm"
        Case "重大项目"
            fileName = "330.htm"
        Case "重大研究计划"
            fileName = "340.htm"
        Case "国家杰出青年科学基金"
            fileName = "353.htm"
        Case "海外青年学者合作研究基金"
            fileName = "352.htm"
        Case "海外及港澳学者合作研究基金"
            fileName = "355.htm"
        Case "创新研究群体科学基金"
            fileName = "360.htm"
        Case "青年科学基金项目"
            fileName = "311.htm"
        Case "地区科学基金项目"
            fileName = "312.htm"
        Case "专项基金项目"
            fileName = "380.htm"
        Case "专项基金项目-科普项目"
            fileName = "385.htm"
        Case "专项基金项目-科学仪器基础研究专款"
            fileName = "383.htm"
        Case "专项基金项目-重点学术期刊"
            fileName = "387.htm"
        Case "联合资助基金项目-面上项目"
            fileName = "410.htm"
        Case "联合资助基金项目-重点项目"
            fileName = "420.htm"
        Case "国家杰出青年科学基金(外籍)"
            fileName = "354.htm"
        Case Else
            fileName = "200.htm"
        
    End Select
    
    'If showSection = 1 Then
    '    MsgBox "请先填写项目详细信息,才能查看相应项目的正文撰写提纲", vbOKOnly, "自然科学基金申请书"
    If showSection = 99 Then
        MsgBox "您的项目暂时没有相关的正文撰写提纲！", vbOKOnly, "自然科学基金申请书"
    End If
    
    'FilePath = GetPath(ThisDocument.FullName) & "填报说明及正文撰写提纲.doc"
    'On Error Resume Next
    'Set objDoc = ThisDocument.Application.Documents.Open(FilePath)
    'If objDoc Is Nothing Then
    '    MsgBox "无法找到文件path=" & FilePath, vbOKOnly, "自然科学基金申请书"
    '    Exit Sub
    'End If
    
    helpFile = GetPath(ThisDocument.FullName) & "NSFC申请书帮助文档.chm"
    On Error Resume Next
    If Dir(helpFile) = "" Then
        MsgBox "无法找到帮助文件path=" & helpFile, vbOKOnly, "自然科学基金申请书"
        Exit Sub
    End If
    
    'If WaitForProcess(Htmlhelp(hwnd, helpFile, 0, ByVal fileName), 600, "") Then
    'End If
    Call Htmlhelp(hwnd, helpFile, 0, ByVal fileName)
    'Shell Htmlhelp(hwnd, helpFile, 0, ByVal fileName)
    'On Error Resume Next
    'objDoc.Unprotect mstrPassword
    'For i = 0 To objDoc.Bookmarks.Count - 1
    '    ShowText objDoc, "Desc" & Trim(Str(i)), False
    'Next
    'If showSection = 1 Or showSection = 99 Then
    '    ShowText objDoc, "Desc0", True
    'End If
    '
    'If (showSection > 1 And showSection <> 99) Then
    '    ShowText objDoc, "Desc1", True
    '    ShowText objDoc, "Desc" & Trim(Str(showSection)), True
    'End If
    
    'On Error Resume Next
    '    objDoc.Sections.Item(1).ProtectedForForms = True
    '    objDoc.Protect wdAllowOnlyComments, True, mstrPassword
    'On Error Resume Next
    '    objDoc.save
        
End Sub

Private Sub ShowText(objWord As Word.Document, strName As String, isShow As Boolean)
    
    If isShow Then
        With objWord.Bookmarks.Item(strName).Range.Font
            .NameFarEast = ""
            .NameAscii = ""
            .NameOther = ""
            .Name = ""
            .Hidden = False
        End With
    Else
        With objWord.Bookmarks.Item(strName).Range.Font
            .NameFarEast = ""
            .NameAscii = ""
            .NameOther = ""
            .Name = ""
            .Hidden = True
        End With
    End If
End Sub

Private Sub showCmdShowOutline(ByVal blnPrepare As Boolean)
    
    Dim sngW, sngH As Integer
    Dim bkColor As Long
    sngW = 1
    sngH = 1

    bkColor = RGB(255, 255, 255)
 
  If Not blnPrepare Then
    bkColor = RGB(192, 192, 192)
    sngW = 126
    sngH = 18.75
  End If

  ThisDocument.CmdShowOutline.BackColor = bkColor
  ThisDocument.CmdShowOutline.Width = sngW
  ThisDocument.CmdShowOutline.Height = sngH


End Sub


Private Sub Document_Close()
    On Error Resume Next
    '显示提示信息
    
    'enable undo button
    gblnClosing = True
    
    If Application.version <> "8.0" Then  '//97 don't support this
        Call EnableUndobutton
    End If
    
    CloseHelp
    
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ForPrint ThisDocument, False
    objPrjDoc.ShowHideTip ThisDocument, True, gcstrWarning
    ThisDocument.save
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
End Sub

Private Sub CloseHelp()

    Const WM_CLOSE = &H10
    Const winTitle = "NSFC申请书帮助文档"
    Dim WinWnd As Long

    WinWnd = FindWindow(vbNullString, winTitle) ' ThunderRTMain under VB4
    If WinWnd <> 0 Then
        PostMessage WinWnd, WM_CLOSE, 0&, 0&
    End If
End Sub

'根据全文件名返回路径
Public Function GetPath(ByVal strFullName As String) As String
    Dim i As Integer
    Dim intLen As Integer
    
    intLen = Len(strFullName)
    For i = intLen To 1 Step -1
        If Mid(strFullName, i, 1) = "\" Then
            Exit For
        End If
    Next
    GetPath = Left(strFullName, i)
End Function

Private Sub Document_Open()

   On Error Resume Next
    Dim strDllPath As String
    
    '// hys added 2005-12-5
    Set thisApp = ThisDocument.Application
    undoTag = -2
    gblnClosing = False
    
    '注册组件
    strDllPath = GetPath(ThisDocument.FullName) & "ISIS_Proposal2010.dll"
    strDllPath = "regsvr32 -s " & Chr(34) & strDllPath & Chr(34)
    Shell (strDllPath)

    'hide 提示信息
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ShowHideTip ThisDocument, True, ""
        
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub




Private Sub lblDtl_AppCName_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 1
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=2
        
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    

End Sub

Private Sub lblDtl_CoOrgCName1_Click()
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc

    objPrjDoc.ShowOrgDlg ThisDocument, 2
    Selection.GoTo What:=wdGoToBookmark, Name:="bmkDtl_thisOrgEmail"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblDtl_CoOrgCName2_Click()
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc

    objPrjDoc.ShowOrgDlg ThisDocument, 3
    Selection.GoTo What:=wdGoToBookmark, Name:="bmkDtl_thisOrgEmail"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblDtl_ppsCName_Click()
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc


    objPrjDoc.ShowProject ThisDocument
    Selection.GoTo What:=wdGoToBookmark, Name:="bmkDtl_thisOrgEmail"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblDtl_thisOrgCName_Click()
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc


    objPrjDoc.ShowOrgDlg ThisDocument, 1
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=2
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName1_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 1
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
End Sub

Private Sub lblMmb_CName10_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 10
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
    
End Sub

Private Sub lblMmb_CName2_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 2
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName3_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 3
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
   
End Sub

Private Sub lblMmb_CName4_Click()

    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 4
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName5_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 5
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName6_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 6
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName7_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 7
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName8_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 8
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
    
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub

Private Sub lblMmb_CName9_Click()
    '增加项目成员
    '0为项目负责人,1..10为项目成员
    Dim objPrjDoc As Object
    Set objPrjDoc = GetProjectDoc
    
    objPrjDoc.ShowAddMemberDlg ThisDocument, 9
    Selection.GoTo What:=wdGoToBookmark, Name:="tblMmb_MemberInfo"
  
    objPrjDoc.Dispose
    Set objPrjDoc = Nothing
    
End Sub
'// ------------------------------- hys added 2005-12-6 ----------------------------------------
Sub DisableUndoButton()
    
    If Application.version = "8.0" Then Exit Sub
    
    Call EnableUndobutton(False)
End Sub

Sub EnableUndobutton(Optional ByVal Enable As Boolean = True)
    
    Dim i As Long
    
    If Application.version = "8.0" Then Exit Sub
    
    On Error Resume Next
    
    Dim mUndoMenus As CommandBarControls
    
    
    Set mUndoMenus = Application.CommandBars.FindControls(, 128)
    
    For i = 1 To mUndoMenus.Count
        mUndoMenus.Item(i).Enabled = Enable
        
    Next i

End Sub


Private Sub thisApp_WindowSelectionChange(ByVal Sel As Selection)

    Dim idxSection As Long
    
    If gblnClosing Then Exit Sub
    
    On Error Resume Next
    
    Dim mUndoMenus As CommandBarControls
    
    
    
    
    idxSection = Sel.Information(wdActiveEndSectionNumber)
   
    '// 4 and 5 is the  caculatation form fields 'section index
    If idxSection = 4 Or idxSection = 5 Then
        DisableUndoButton
    Else
        EnableUndobutton
    End If
   
End Sub
'// ------------------------------- hys added 2005-12-6 end ----------------------------------------



Attribute VB_Name = "NewMacros"
Sub FilePrint()
'
' FilePrint Macro
' 打印活动文档
'
    On Error Resume Next
    Call ThisDocument.PrintDoc

End Sub
Sub FilePrintDefault()
'
' FilePrintDefault Macro
' 以默认方式打印当前文档
   'On Error Resume Next
    Call ThisDocument.PrintDoc
    
End Sub

Sub editundo()
    On Error Resume Next
    
    If Selection.Sections.Item(1).Range.FormFields.Count = 0 Then
        ThisDocument.Undo
    End If
End Sub