Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "pvTimer"
'PV原模块

'Option Explicit
Public tmpProc As LongPtr
Public tmpProc2 As LongPtr
Public tmpProcArr() As LongPtr
Public tmpProcArrSize As Integer

'时间间隔
Function TimeEplase(eplase As Integer, pproc As LongPtr)
    If Timer2 = 0 Then
        tmpProc = pproc
        Timer2 = SetTimer(0, 0, eplase, AddressOf TimerSleepProc)
    End If
End Function

Function TimerSleepProc() As LongPtr
    KillTimer 0, Timer2
    Timer2 = 0
    CallWindowProc tmpProc, 0, 0, 0, 0
    TimerSleepProc = 0
End Function

'用于批量处理
Function TimeEplaseArr(eplase As Integer)
    If Timer2 = 0 Then
        Timer2 = SetTimer(0, 0, eplase, AddressOf TimerSleepProcArr)
    End If
End Function

Function TimerSleepProcArr() As LongPtr
    KillTimer 0, Timer2
    Timer2 = 0
    Dim i As Integer
    For i = 1 To tmpProcArrSize
        CallWindowProc tmpProcArr(i), 0, 0, 0, 0
    Next i
    
    TimerSleepProcArr = 0
End Function

Function TimeEplase2(eplase As Integer, pproc As LongPtr)
    DoEvents
    Sleep eplase
    CallWindowProc pproc, 0, 0, 0, 0
End Function


Attribute VB_Name = "Tuling_AnimSys"
'点击效果超链接模块
'此模块主要实现点击的动画效果

Private aWarningPageExit As New objAnimNode '用于实现第二页的退出（进入欢迎页）

Private aGlobalExit As New objAnimNode '全局退出（该方法需要确保退出动画永远位于第一个）
'Private aSettingPageExit As New objAnimNode '设置页
Private aSettingPageGotoEquipment As New objAnimNode '设置页前往设备页
Private aSettingPageGotoWallPaper As New objAnimNode '设置页前往个性化页
Private aSettingPageGotoSafety As New objAnimNode '设置页前往安全页
Private aSettingPageGotoAbout As New objAnimNode '设置页前往关于页
Private aSettingPageGotoDevset As New objAnimNode '设置关于页前往开发者选项页
Private aGlobalGotoSetting As New objAnimNode '返回设置页
Private aPowerPageGotoShutdown As New objAnimNode '电源页前往关机页
Private aPowerPageGotoRestart As New objAnimNode '电源页前往重启页
Private aPowerPageGotoLockScreen As New objAnimNode '电源页前往锁屏页
Private aClaorGotoinfo As New objAnimNode '计算器页前往详情页
Private aClaorGotoMath As New objAnimNode '计算器页前往计算页
Private aTerGotoinfo As New objAnimNode '终端页前往详情页
Private aTerGotoTer As New objAnimNode '终端页前往终端页
Private aFLGotoDisk As New objAnimNode '文件页前往文件磁盘页
Private aFLGotoPX As New objAnimNode '文件页前往文件螃蟹页
Private aFLGotoFC As New objAnimNode '文件页前往文件飞云页
Private aFLGotoSET As New objAnimNode '文件页前往设置页
Private aFLGotoTER As New objAnimNode '文件页前往终端页
Private aUACGotoLight As New objAnimNode 'UAC页前往照明页
Private aLightGotoON As New objAnimNode '照明页前往照明亮页
Private aLightGotoOFF As New objAnimNode '照明页前往照明关页
Private aUACGotoAllow As New objAnimNode '开发者选项UAC
Private aTextMainGotoinfo As New objAnimNode '记事本主页前往帮助页
Private aTextMainGotoMain As New objAnimNode '记事本主页
Private aTextMainGoto1 As New objAnimNode '记事本主页前往文档1页
Private aTextMainGoto2 As New objAnimNode '记事本主页前往文档2页
Private aTextMainGoto3 As New objAnimNode '记事本主页前往文档3页
Private aTextDaziSetGotoDazi As New objAnimNode '记事本大字报设置页前往大字报页
Private aTextDaziUACGotoSet As New objAnimNode '记事本大字报UAC页前往大字报设置页
Private aTodayGotoHelp As New objAnimNode 'Today页前往帮助和反馈页


Private isInitialized As Boolean
Private Sub animsInitialize()
    If isInitialized = False Then
        aWarningPageExit.Initialize 1, 200, , AddressOf callbackGotoMainScreen
        aGlobalExit.Initialize 1, 200, , AddressOf callbackExitPresentation
        aGlobalGotoSetting.Initialize 2, 200, , AddressOf callbackGotoSetting
        aSettingPageGotoEquipment.Initialize 3, 200, , AddressOf callbackGotoEquipment
        aSettingPageGotoWallPaper.Initialize 4, 200, , AddressOf callbackGotoWallPaper
        aSettingPageGotoSafety.Initialize 5, 200, , AddressOf callbackGotoSafety
        aSettingPageGotoAbout.Initialize 6, 200, , AddressOf callbackGotoAbout
        aSettingPageGotoDevset.Initialize 3, 200, , AddressOf callbackGotoDevset
        aPowerPageGotoShutdown.Initialize 2, 200, , AddressOf callbackGotoShutdown
        aPowerPageGotoRestart.Initialize 3, 200, , AddressOf callbackGotoRestart
        aPowerPageGotoLockScreen.Initialize 4, 200, , AddressOf callbackGotoLockScreen
        aClaorGotoinfo.Initialize 2, 200, , AddressOf callbackClaorGotoinfo
        aClaorGotoMath.Initialize 2, 200, , AddressOf callbackClaorGotoMath
        aTerGotoinfo.Initialize 2, 200, , AddressOf callbackTerGotoinfo
        aTerGotoTer.Initialize 2, 200, , AddressOf callbackTerGotoTer
        aFLGotoDisk.Initialize 2, 200, , AddressOf callbackFLGotoDisk
        aFLGotoPX.Initialize 3, 200, , AddressOf callbackFLGotoPX
        aFLGotoFC.Initialize 4, 200, , AddressOf callbackFLGotoFC
        aFLGotoSET.Initialize 5, 200, , AddressOf callbackFLGotoSET
        aFLGotoTER.Initialize 6, 200, , AddressOf callbackFLGotoTER
        aUACGotoLight.Initialize 2, 200, , AddressOf callbackUACGotoLight
        aLightGotoON.Initialize 1, 200, , AddressOf callbackLightGotoON
        aLightGotoOFF.Initialize 1, 200, , AddressOf callbackLightGotoOFF
        aUACGotoAllow.Initialize 2, 200, , AddressOf callbackUACGotoAllow
        aTextMainGotoinfo.Initialize 2, 200, , AddressOf callbackTextMainGotoinfo
        aTextMainGotoMain.Initialize 2, 200, , AddressOf callbackTextMainGotoMain
        aTextMainGoto1.Initialize 3, 200, , AddressOf callbackTextMainGoto1
        aTextMainGoto2.Initialize 4, 200, , AddressOf callbackTextMainGoto2
        aTextMainGoto3.Initialize 5, 200, , AddressOf callbackTextMainGoto3
        aTextDaziSetGotoDazi.Initialize 3, 200, , AddressOf callbackTextDaziSetGotoDazi
        aTextDaziUACGotoSet.Initialize 2, 200, , AddressOf callbackTextDaziUACGotoSet
        aTodayGotoHelp.Initialize 1, 200, , AddressOf callbackTodayGotoHelp
        isInitialized = True
    End If
End Sub

Public Sub Anim_进入主屏幕()
    animsInitialize
    aWarningPageExit.Run
End Sub

Public Sub Anim_退出放映()
    animsInitialize
    aGlobalExit.Run
End Sub

Public Sub Anim_进入设置页()
    animsInitialize
    aGlobalGotoSetting.Run
End Sub

Public Sub Anim_进入设备页()
    animsInitialize
    aSettingPageGotoEquipment.Run
End Sub

Public Sub Anim_进入个性化页()
    animsInitialize
    aSettingPageGotoWallPaper.Run
End Sub

Public Sub Anim_进入安全页()
    animsInitialize
    aSettingPageGotoSafety.Run
End Sub

Public Sub Anim_进入关于页()
    animsInitialize
    aSettingPageGotoAbout.Run
End Sub

Public Sub Anim_进入开发者选项页()
    animsInitialize
    aSettingPageGotoDevset.Run
End Sub

Public Sub Anim_进入关机页()
    animsInitialize
    aPowerPageGotoShutdown.Run
End Sub

Public Sub Anim_进入重启页()
    animsInitialize
    aPowerPageGotoRestart.Run
End Sub

Public Sub Anim_进入锁屏页()
    animsInitialize
    aPowerPageGotoLockScreen.Run
End Sub

Public Sub Anim_进入计算器信息页()
    animsInitialize
    aClaorGotoinfo.Run
End Sub

Public Sub Anim_进入计算器计算页()
    animsInitialize
    aClaorGotoMath.Run
End Sub

Public Sub Anim_进入终端信息页()
    animsInitialize
    aTerGotoinfo.Run
End Sub

Public Sub Anim_进入终端页()
    animsInitialize
    aTerGotoTer.Run
End Sub

Public Sub Anim_进入文件磁盘页()
    animsInitialize
    aFLGotoDisk.Run
End Sub

Public Sub Anim_进入文件螃蟹页()
    animsInitialize
    aFLGotoPX.Run
End Sub

Public Sub Anim_进入文件飞云页()
    animsInitialize
    aFLGotoFC.Run
End Sub

Public Sub Anim_文件》设置页()
    animsInitialize
    aFLGotoSET.Run
End Sub

Public Sub Anim_文件》终端页()
    animsInitialize
    aFLGotoTER.Run
End Sub

Public Sub Anim_照明UAC》照明页()
    animsInitialize
    aUACGotoLight.Run
End Sub

Public Sub Anim_进入照明亮页()
    animsInitialize
    aLightGotoON.Run
End Sub

Public Sub Anim_进入照明关页()
    animsInitialize
    aLightGotoOFF.Run
End Sub

Public Sub Anim_UAC_允许()
    animsInitialize
    aUACGotoAllow.Run
End Sub

Public Sub Anim_进入记事本关于页()
    animsInitialize
    aTextMainGotoinfo.Run
End Sub

Public Sub Anim_进入记事本主页()
    animsInitialize
    aTextMainGotoMain.Run
End Sub

Public Sub Anim_进入记事本文档1页()
    animsInitialize
    aTextMainGoto1.Run
End Sub

Public Sub Anim_进入记事本文档2页()
    animsInitialize
    aTextMainGoto2.Run
End Sub

Public Sub Anim_进入记事本文档3页()
    animsInitialize
    aTextMainGoto3.Run
End Sub

Public Sub Anim_进入记事本大字报页()
    animsInitialize
    aTextDaziSetGotoDazi.Run
End Sub

Public Sub Anim_进入记事本大字报设置页()
    animsInitialize
    aTextDaziUACGotoSet.Run
End Sub

Public Sub Anim_Today》帮助和反馈()
    animsInitialize
    aTodayGotoHelp.Run
End Sub



'进入主界面
Private Function callbackGotoMainScreen() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_MainScreen
    callbackGotoMainScreen = 0
End Function

'退出
Private Function callbackExitPresentation() As LongPtr
    pvShow.ExitSlideShow
    callbackExitPresentation = 0
End Function

'返回设置页
Private Function callbackGotoSetting() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Setting
    callbackGotoSetting = 0
End Function

'进入设备页
Private Function callbackGotoEquipment() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Equipment
    callbackGotoEquipment = 0
End Function

'进入个性化壁纸页
Private Function callbackGotoWallPaper() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_WallPaper
    callbackGotoWallPaper = 0
End Function

'进入安全页
Private Function callbackGotoSafety() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Safety
    callbackGotoSafety = 0
End Function

'进入关于页
Private Function callbackGotoAbout() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_About
    callbackGotoAbout = 0
End Function

'进入开发者选项页
Private Function callbackGotoDevset() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_DevSetting
    callbackGotoDevset = 0
End Function

'进入关机页
Private Function callbackGotoShutdown() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Shutdown
    callbackGotoShutdown = 0
End Function

'进入重启页
Private Function callbackGotoRestart() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Restart
    callbackGotoRestart = 0
End Function

'进入锁屏页
Private Function callbackGotoLockScreen() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_LockScreen
    callbackGotoLockScreen = 0
End Function

'进入计算器信息页
Private Function callbackClaorGotoinfo() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_ClaorInfo
    callbackClaorGotoinfo = 0
End Function

'进入计算器计算页
Private Function callbackClaorGotoMath() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_ClaorMath
    callbackClaorGotoMath = 0
End Function

'进入终端信息页
Private Function callbackTerGotoinfo() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_TerInfo
    callbackTerGotoinfo = 0
End Function

'进入终端页
Private Function callbackTerGotoTer() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Ter
    callbackTerGotoTer = 0
End Function

'进入文件磁盘页
Private Function callbackFLGotoDisk() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_FLDisk
    callbackFLGotoDisk = 0
End Function

'进入文件螃蟹页
Private Function callbackFLGotoPX() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_FLPX
    callbackFLGotoPX = 0
End Function

'进入文件飞云页
Private Function callbackFLGotoFC() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_FLFC
    callbackFLGotoFC = 0
End Function

'进入文件》设置页
Private Function callbackFLGotoSET() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Setting
    callbackFLGotoSET = 0
End Function

'进入文件》终端页
Private Function callbackFLGotoTER() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Ter
    callbackFLGotoTER = 0
End Function

'进入照明UAC》照明页
Private Function callbackUACGotoLight() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Light
    callbackUACGotoLight = 0
End Function

'进入照明亮页
Private Function callbackLightGotoON() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_LightON
    callbackLightGotoON = 0
End Function

'进入照明关页
Private Function callbackLightGotoOFF() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Light
    callbackLightGotoOFF = 0
End Function

'UAC允许页
Private Function callbackUACGotoAllow() As LongPtr
    pvShow.NextSlide
    callbackUACGotoAllow = 0
End Function

'记事本主页前往关于页
Private Function callbackTextMainGotoinfo() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_TextInfo
    callbackTextMainGotoinfo = 0
End Function

'记事本主页
Private Function callbackTextMainGotoMain() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_TextMain
    callbackTextMainGotoMain = 0
End Function

'记事本文档1页
Private Function callbackTextMainGoto1() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Text1
    callbackTextMainGoto1 = 0
End Function

'记事本文档2页
Private Function callbackTextMainGoto2() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Text2
    callbackTextMainGoto2 = 0
End Function

'记事本文档3页
Private Function callbackTextMainGoto3() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Text3
    callbackTextMainGoto3 = 0
End Function

'记事本大字报页
Private Function callbackTextDaziSetGotoDazi() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Dazi
    callbackTextDaziSetGotoDazi = 0
End Function

'记事本大字报设置页
Private Function callbackTextDaziUACGotoSet() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_DaziSet
    callbackTextDaziUACGotoSet = 0
End Function

'帮助和反馈页
Private Function callbackTodayGotoHelp() As LongPtr
    pvShow.GotoSlide Tuling_Global.TLSLDID_Help
    callbackTodayGotoHelp = 0
End Function



Attribute VB_Name = "clsTimer"
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
'循环，可用作定时器
Private tmpUpdateCallback As LongPtr
Private isActive__ As Boolean
Private interval__ As Single
Public Timer As Variant
Private pTimer_ As LongPtr
Private nEvent As Long

Sub Initialize(pUpdateFunc As LongPtr, Optional interval_ As Single = 100)
    tmpUpdateCallback = pUpdateFunc
    interval__ = interval_
End Sub

Public Sub Run(Optional useAPI As Boolean = False)
    Timer = 0

    If tmpUpdateCallback = 0 Then
            Debug.Print "无更新回调"
            Exit Sub
        End If
    If useAPI Then
        If pTimer_ = 0 Then
            pTimer_ = SetTimer(0, 0, interval__, tmpUpdateCallback)
        End If
    Else
        isActive__ = True
        Dim tmpTimer: tmpTimer = VBA.Timer
        Dim curTimer: curTimer = tmpTimer
        Do
            DoEvents
            curTimer = VBA.Timer
            If curTimer >= tmpTimer + (interval__ / 1000) Then
                CallWindowProc tmpUpdateCallback, 0, 0, 0, 0
                'Debug.Print "233"
                tmpTimer = curTimer
            End If
            If isActive__ = False Then '结束循环
                Exit Do
            End If
        Loop

    End If
    isActive__ = False
End Sub

'结束死循环
Public Sub Terminate()
    isActive__ = False
    KillTimer 0, pTimer_
    pTimer_ = 0
End Sub

Private Sub Class_Initialize()
'    timerEvents = timerEvents + 1
'    nEvent = timerEvents
    isActive__ = False
    interval__ = 100
End Sub

Public Property Get Interval() As Single
    Interval = interval__
End Property

Public Property Get IsActive() As Single
    IsActive = isActive__
End Property

Attribute VB_Name = "DSE"
'PV原模块

'Option Explicit

'结构体和枚举以及默认回调，DataStruct and Enum and Default Proc
Public Type vector2i_T
    x As Long
    y As Long
End Type
    
'浮点二维向量
Public Type vector2f_T
    x As Double
    y As Double
End Type

'整形三维向量
Public Type vector3i_T
    x As Long
    y As Long
    z As Long
End Type

'浮点三维向量
Public Type vector3f_T
    x As Double
    y As Double
    z As Double
End Type

'鼠标的lparam结构体
Public Type MSLLHOOKSTRUCT
    pt As vector2i_T
    mouseData As LongPtr
    flags As LongPtr
    time As LongPtr
    dwExtraInfo As LongPtr
End Type

'鼠标事件：mouse_event
Public Const MEA = &H8000 '使用绝对坐标系
Public Const MEM = &H1 '改变鼠标的坐标
Public Const MED = &H2 '模拟鼠标左键按下
Public Const MEU = &H4 '模拟鼠标左键抬起
Public Const MaxPixel = 65535

'鼠标状态：GetAsyncKeyState
'Public Const VK_LBUTTON = 1 '鼠标左键
'Public Const VK_RBUTTON = 2 '鼠标右键
'Public Const VK_RETURN = 13 '回车键
'Public Const VK_SPACE = 32 '空格键
'Public Const VK_UP = 38 '↑键
'Public Const VK_DOWN = 40 '↓键
'Public Const VK_LEFT = 37 ' ←键
'Public Const VK_RIGHT = 39 '→键

'钩子消息宏定义：Hook
Public Const HC_ACTION = 0
Public Const WH_KEYBOARDLL = 13
Public Const WH_MOUSELL = 14
'Public Const WM_KEYDOWN = &H100  '键盘按下
Public Const WM_MOUSEMOVE = &H200  '鼠标移动
Public Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
Public Const WM_LBUTTONUP = &H202 '鼠标左键弹出
Public Const WM_LBUTTONDBLCLK = &H203 '鼠标左键双击
Public Const WM_RBUTTONDOWN = &H204 '鼠标右键按下
Public Const WM_RBUTTONUP = &H205 '鼠标右键弹出
Public Const WM_MBUTTONDOWN = &H207 '鼠标中键按下
Public Const WM_MBUTTONUP = &H208 '鼠标中键弹出


Attribute VB_Name = "API"
'PV原模块

'Option Explicit
'警告：标准API是整个游戏大部分功能的基础，如果没有一定经验请不要动这里

'获得回调函数
Declare PtrSafe Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal msg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
'————————————鼠标相关操作———————————————
'鼠标位置的获取
Public Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As vector2i_T) As Long ' ByVal x As Long, ByVal y As Long
'设置鼠标位置
Public Declare PtrSafe Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
'获取分辨率，填“0”代表水平分辨率，填“1”代表竖直分辨率
Public Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
'鼠标事件
Public Declare PtrSafe Function mouse_event Lib "user32.dll" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As LongPtr, ByVal dwExtraInfo As Long) As Long
'设定钩子
Public Declare PtrSafe Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
'注销钩子
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As LongPtr) As LongPtr
'内存拷贝
Public Declare PtrSafe Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, source As LongPtr, ByVal length As Long) As LongPtr
'键鼠状态
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long

'————————————定时器———————————————

'设定定时器
Public Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
'销毁定时器
Public Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
'延迟
Public Declare PtrSafe Function Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) As Long
'默认提供三个定时器
Public Timer1 As LongPtr, Timer2 As LongPtr, Timer3 As LongPtr

'————————————线程————————————————
'HANDLE CreateThread(
'      lpThreadAttributes: Pointer;                    {安全设置}
'      dwStackSize: DWORD;                              {堆栈大小}
'      lpStartAddress: TFNThreadStartRoutine; {入口函数}
'      lpParameter: Pointer;                                {函数参数}
'      dwCreationFlags: DWORD;                       {启动选项}
'      var lpThreadId: DWORD                         {输出线程 ID }
')

'创建线程
Declare PtrSafe Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As LongPtr, ByVal dwStackSize As LongPtr, ByVal lpStartAddress As LongPtr, lpParameter As Any, ByVal dwCreationFlags As LongPtr, lpThreadID As LongPtr) As LongPtr
'结束线程
Declare PtrSafe Function TerminateThread Lib "kernel32" (ByVal hThread As LongPtr, ByVal dwExitCode As LongPtr) As Boolean
'————————————INI操作———————————————

Declare PtrSafe Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'lpApplicationName [Section]节标题
'lpKeyName Key键名
'lpDefault 当读取失败时返回的文本，默认填1
'lpReturnedString 读取到的文本存放的内容，是核心参数
'nSize 一次能读多少，个人喜欢填255
'lpFileName 填ini文件的绝对路径，不能填相对路径
'使用例：Call GetPrivateProfileString("MAINSETCTION", "FRISTKEY", "FAIL", buf, 255, "C:\config.ini")

Declare PtrSafe Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'lpApplicationName [Section]节标题
'lpKeyName Key键名
'lpString 修改的内容，核心参数
'lpFileName 文件地址，需要绝对地址

'Sub INI文件操作使用例()
'    Dim str As String
'    str = String(20, 0)
'    GetPrivateProfileString "Section", "Key", 1, str, 20, "C:\\Users\dell\Desktop\text.ini"
'    WritePrivateProfileString "Section2", "Key", "666", "C:\\Users\dell\Desktop\text.ini"
'    Debug.Print str
'End Sub

'functions模块用于保存当前的函数，以便更好的进行游戏制作


'————————————页码类——————————————
'CurrentPageIndex()
'IsThisPage(ByVal PageIndex As Long)

'返回当前页码
Public Property Get CurrentPageIndex() As Long
    CurrentPageIndex = Application.ActivePresentation.SlideShowWindow.View.Slide.SlideNumber
End Property

'—————————————文件操作———————————————

'获取文件完整路径
Function INIPath(str As String) As String
    INIPath = Application.ActivePresentation.path & "\" & str & ".ini"
End Function

'读取
Function ReadValue(SectionName As String, KeyNmae As String, PathName As String) As String
    Dim BufferText As String, TextSize As Integer: TextSize = 255: BufferText = Space(TextSize)
    GetPrivateProfileString SectionName, KeyNmae, "Null", BufferText, 255, INIPath(PathName)
    ReadValue = Replace(BufferText, " ", "")
End Function

'写入
Function WriteValue(SectionName As String, KeyName As String, PathName As String, Buffer As String)
    WritePrivateProfileString SectionName, KeyName, Buffer, INIPath(PathName)
End Function

'读取临时信息
Function TempInfo(SectionName As String, KeyName As String) As String
    TempInfo = ReadValue(SectionName, KeyName, "temp")
End Function

'写入临时信息
Function TempLog(SectionName As String, KeyName As String, Buffer As String)
    WriteValue SectionName, KeyName, "temp", Buffer
End Function
    
'——————————————————【暂未被开发】————————————————————

'PPT默认且唯一的自动代码: 当换页时开启
Private Sub OnSlideShowPageChange()
End Sub


'Sub ChangeNewMotion(self As Shape)
'    Dim sizeX As Integer, sizeY As Integer
'    sizeX = Application.ActivePresentation.SlideMaster.width
'    sizeY = Application.ActivePresentation.SlideMaster.Height
'
'    Dim shp As Shape: Set shp = Application.ActivePresentation.Slides(2).Shapes("bit")
'    Dim newPX As Double, newPY As Double
'    With self
'    newPX = .LEFT + .width / 2: newPY = .Top + .Height / 2
'    End With
'
'    Dim newRatioX As Double, newRatioY As Double
'    With shp
'    newRatioX = -(newPX - .LEFT - .width / 2) / sizeX
'    newRatioY = -(newPY - .Top - .Height / 2) / sizeY
'    .LEFT = newPX - .width / 2
'    .Top = newPY - .Height / 2
'    End With
'    Dim bhv As AnimationBehavior
'
'    Set bhv = Application.ActivePresentation.Slides(2).TimeLine.MainSequence(1).Behaviors(1)
'    bhv.MotionEffect.Path = "M " & VBA.CStr(newRatioX) & " " & VBA.CStr(newRatioY) & " L 0 0 E"
'
'End Sub
'
'Sub test()
'    ChangeNewMotion Application.ActivePresentation.Slides(2).Shapes(1)
'End Sub


''动画对象相关调试与封装
'Public node As New objAnimNode
'
'Sub nnn()
'    node.Initialize 2, 1500, AddressOf test1, AddressOf test2
'    node.Run
'End Sub
'
'Function test1() As LongPtr
'    Debug.Print "1"
'    test1 = 0
'End Function
'Function test2() As LongPtr
'    Debug.Print "2"
'    test2 = 0
'End Function
'
'Sub aaa()
'    Dim seqc As Sequence: Set seqc = Application.ActivePresentation.Slides(2).TimeLine.MainSequence
'    Debug.Print seqc(1).index
'    Debug.Print
'End Sub
'
'Sub test233()
'    Dim nodes As New objAnimNodes
'    nodes.Initialize Application.ActivePresentation.Slides(2)
'    'Debug.Print nodes.Count
'    Debug.Print nodes.Item(3).effectIndex
'    Debug.Print nodes.Item(2).Count
'    Debug.Print nodes.Count
'End Sub
'
'Sub aaaa()
'    Dim arr As New Collection
'    Dim i As Integer
'    For i = 1 To 10
'        arr.Add i
'    Next i
'End Sub
'
'Sub aaaaaa2()
'    aaaa
'    Debug.Print arr.Count
'End Sub

Attribute VB_Name = "clsAnim"
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

'这是一个有关动画控制的类

'暂停
Function Pause()
      Application.ActivePresentation.SlideShowWindow.View.State = ppSlideShowPaused
End Function

'运行
Function Run()
    Application.ActivePresentation.SlideShowWindow.View.State = ppSlideShowRunning
End Function

'状态切换，暂停/运行
Function StateSwitch()
    If Application.ActivePresentation.SlideShowWindow.View.State = 1 Then
        Application.ActivePresentation.SlideShowWindow.View.State = 2
    ElseIf Application.ActivePresentation.SlideShowWindow.View.State = 2 Then
        Application.ActivePresentation.SlideShowWindow.View.State = 1
    End If
End Function

'重置
Function Reset()
    Application.ActivePresentation.SlideShowWindow.View.ResetSlideTime
    Run
End Function

'跳转
'用法：跳转到动画窗格第X次单击时的位置，并从这个断点开始动画，如果不填，那么默认会使得动画放完
Function NodeWarp(Optional index As Integer = -1)
    If index = -1 Then
        Application.ActivePresentation.SlideShowWindow.View.GotoClick Application.ActivePresentation.SlideShowWindow.View.GetClickCount
    Else
        Application.ActivePresentation.SlideShowWindow.View.GotoClick index
    End If
End Function

'跳转SP
Function NodeWarpSP(Optional index As Integer = -1)
    If index = -1 Then
        Application.ActivePresentation.SlideShowWindow.View.GotoClick Application.ActivePresentation.SlideShowWindow.View.GetClickCount
    Else
        Application.ActivePresentation.SlideShowWindow.View.GotoClick index
    End If
    NodeReset
End Function

'动画等效播放（指如同鼠标单击一样，跳到下一个断点与下一页）
Function NodeNext()
    Application.ActivePresentation.SlideShowWindow.View.Next
End Function

'动画等效回溯（功能同上）
Function NodePrevious()
    Application.ActivePresentation.SlideShowWindow.View.Previous
End Function

'断点重播
Function NodeReset()
    NodePrevious
    NodeNext
End Function


Attribute VB_Name = "objAnimNode"
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 index As Integer '断点块在窗格中的现id
Public Duration As Integer  '动画周期
Public PProcStart As LongPtr '附加线程句柄
Public PProcEnd As LongPtr '结束动画句柄

Private nodeName As String '动画块名称

'动画集合初始化，该断点的效果细节
Public EffectIndex As Integer '在序列中的下标
Public count As Integer '该断点中的成员数
Private seqc_ As Sequence '该断点所在的序列
Public InheritIndex As Integer '因为断点的移动在动画断点系统中很重要，记录该断点的原id显得非常的必要
Private detailDelay() As Double '记录该断点每个效果成员的具体延迟，用于实现断点移动时的复原
Private isSync As Boolean '是否是一个具有明显断点的动画断点对象，如果不是，则说明该对象已经成为了序列的一块组合对象了。

Public PathNode As New objAnimNodePath '专门用于保存路径动画的断点对象

Private Sub Class_Initialize()
    isSync = False
End Sub

'回调绑定与初始化
Public Function Initialize(id As Integer, dur As Integer, Optional ps As LongPtr = 0, Optional pe As LongPtr = 0)
    InheritIndex = id
    index = id
    Duration = dur
    PProcStart = ps
    PProcEnd = pe
End Function

'序列中的初始化，用于为该对象注入详细的动画细节信息，与上面的初始化对象独立
Public Function InitializeInSeqc(effId As Integer, cnt As Integer, seqc As Sequence)
    EffectIndex = effId: count = cnt
    Set seqc_ = seqc
    ReDim detailDelay(1 To cnt)
    Dim i As Integer
    For i = effId To effId + cnt - 1
        detailDelay(i - effId + 1) = seqc(i).Timing.TriggerDelayTime
        '此处的if块用于是否是路径动画的识别
        If seqc(i).Behaviors(1).Type = msoAnimTypeMotion And PathNode.havePath = False Then
            PathNode.Initialize i - effId + 1
            With seqc(i).Shape
                PathNode.Left = .Left
                PathNode.Top = .Top
                PathNode.Width = .Width
                PathNode.Height = .Height
            End With
        End If
    Next i
End Function

'延迟刷新
Private Function ResetDelay()
    Dim i As Integer
    For i = EffectIndex To EffectIndex + count - 1
        seqc_(i).Timing.TriggerDelayTime = detailDelay(i - EffectIndex + 1)
    Next i
End Function

'动画运行
Public Function Run()
    If isSync = False Then
        If PProcStart <> 0 Then
            CallWindowProc PProcStart, 0, 0, 0, 0
        End If
        With Application.ActivePresentation.SlideShowWindow.View
                .GotoClick index
                .Previous
                .Next
        End With
        
        If PProcEnd <> 0 Then
            pvTimer.TimeEplase Duration, PProcEnd
        End If
    End If
End Function

'单独执行开始子程
Public Function RunStartProc()
    CallWindowProc PProcStart, 0, 0, 0, 0
    'Debug.Print nodeName; 开始子程正在执行
End Function

…