Update MST

src/ctxNineButton.ctl

@@ -33,6 +33,8 @@ DefObj A-Z
 Private Const STR_MODULE_NAME As String = "ctxNineButton"
 
 #Const ImplUseShared = NPPNG_USE_SHARED <> 0
+#Const ImplNoIdeProtection = (MST_NO_IDE_PROTECTION <> 0)
+#Const ImplSelfContained = True
 
 '=========================================================================
 ' Public events
@@ -159,6 +161,8 @@ Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, pIconInf
 Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
 Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, lpBitsInfo As BITMAPINFOHEADER, ByVal wUsage As Long, lpBits As Long, ByVal Handle As Long, ByVal dw As Long) As Long
 Private Declare Function ApiUpdateWindow Lib "user32" Alias "UpdateWindow" (ByVal hWnd As Long) As Long
+Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
+Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long
 '--- gdi+
 Private Declare Function GdiplusStartup Lib "gdiplus" (hToken As Long, pInputBuf As Any, Optional ByVal pOutputBuf As Long = 0) As Long
 Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal lWidth As Long, ByVal lHeight As Long, ByVal lStride As Long, ByVal lPixelFormat As Long, ByVal Scan0 As Long, hBitmap As Long) As Long
@@ -193,6 +197,11 @@ Private Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal Image As Lon
 Private Declare Function GdipCloneImage Lib "gdiplus" (ByVal hImage As Long, hCloneImage As Long) As Long
 Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal hBitmap As Long, lpRect As Any, ByVal lFlags As Long, ByVal lPixelFormat As Long, uLockedBitmapData As BitmapData) As Long
 Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal hBitmap As Long, uLockedBitmapData As BitmapData) As Long
+#If Not ImplNoIdeProtection Then
+    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
+    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
+    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
+#End If
 #If Not ImplUseShared Then
     Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
     Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
@@ -958,7 +967,7 @@ End Sub
 
 Public Function TimerProc() As Long
 Attribute TimerProc.VB_MemberFlags = "40"
-    Const FUNC_NAME     As String = "v"
+    Const FUNC_NAME     As String = "TimerProc"
 
     On Error GoTo EH
     pvAnimateState TimerEx - m_dblAnimationStart, m_sngAnimationOpacity1, m_sngAnimationOpacity2
@@ -1537,7 +1546,7 @@ Private Function pvAnimateState(dblElapsed As Double, ByVal sngOpacity1 As Singl
     End If
     UserControl.Refresh
     If m_sngBitmapAlpha < 1 Then
-        Set m_pTimer = InitFireOnceTimerThunk(ObjPtr(Me), pvAddressOfTimerProc.TimerProc)
+        Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc)
     End If
     '--- success
     pvAnimateState = True
@@ -2050,57 +2059,81 @@ Private Function ToScaleMode(sScaleUnits As String) As ScaleModeConstants
 End Function
 
 Private Function InitAddressOfMethod(pObj As Object, ByVal MethodParamCount As Long) As Object
-    Const STR_THUNK     As String = "6AAAAABag+oFV4v6ge9QEJIAgcekEZIAuP9EJAS5+QcAAPOri8LB4AgFuQAAAKuLwsHoGAUAjYEAq7gIAAArq7hEJASLq7hJCIsEq7iBi1Qkq4tEJAzB4AIFCIkCM6uLRCQMweASBcDCCACriTrHQgQBAAAAi0QkCIsAiUIIi0QkEIlCDIHqUBCSAIvCBTwRkgCri8IFUBGSAKuLwgVgEZIAq4vCBYQRkgCri8IFjBGSAKuLwgWUEZIAq4vCBZwRkgCri8IFpBGSALn5BwAAq4PABOL6i8dfgcJQEJIAi0wkEIkRK8LCEAAPHwCLVCQE/0IEi0QkDIkQM8DCDABmkItUJAT/QgSLQgTCBAAPHwCLVCQE/0oEi0IEg/gAfgPCBABZWotCDGgAgAAAagBSUf/gZpC4AUAAgMIIALgBQACAwhAAuAFAAIDCGAC4AUAAgMIkAA=="
+    Const STR_THUNK     As String = "6AAAAABag+oFV4v6ge9QEMEAgcekEcEAuP9EJAS5+QcAAPOri8LB4AgFuQAAAKuLwsHoGAUAjYEAq7gIAAArq7hEJASLq7hJCIsEq7iBi1Qkq4tEJAzB4AIFCIkCM6uLRCQMweASBcDCCACriTrHQgQBAAAAi0QkCIsAiUIIi0QkEIlCDIHqUBDBAIvCBTwRwQCri8IFUBHBAKuLwgVgEcEAq4vCBYQRwQCri8IFjBHBAKuLwgWUEcEAq4vCBZwRwQCri8IFpBHBALn5BwAAq4PABOL6i8dfgcJQEMEAi0wkEIkRK8LCEAAPHwCLVCQE/0IEi0QkDIkQM8DCDABmkItUJAT/QgSLQgTCBAAPHwCLVCQE/0oEi0IEg/gAfgPCBABZWotCDGgAgAAAagBSUf/gZpC4AUAAgMIIALgBQACAwhAAuAFAAIDCGAC4AUAAgMIkAA==" ' 25.3.2019 14:01:08
     Const THUNK_SIZE    As Long = 16728
     Dim hThunk          As Long
     Dim lSize           As Long
 
     hThunk = VirtualAlloc(0, THUNK_SIZE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
+    If hThunk = 0 Then
+        Exit Function
+    End If
     Call CryptStringToBinary(STR_THUNK, Len(STR_THUNK), CRYPT_STRING_BASE64, hThunk, THUNK_SIZE)
     lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle("kernel32"), "VirtualFree"), VarPtr(InitAddressOfMethod))
     Debug.Assert lSize = THUNK_SIZE
 End Function
 
-Private Function InitFireOnceTimerThunk(ByVal lThisPtr As Long, ByVal pfnCallback As Long, Optional Delay As Long) As IUnknown
-    Const STR_THUNK     As String = "6AAAAABag+oFgepQELoAV1aLdCQUg8YIgz4AdCqL+oHHABK6AIvCBTQRugCri8IFcBG6AKuLwgWAEboAqzPAq7kIAAAA86WBwgASugBSahT/UhBai/iLwqu4AQAAAKszwKuLdCQUpaWD7xSLSgz/QgyBYgz/AAAAjQTKjQTIjUyIMMcB/zQkuIl5BMdBCIlEJASLwi0AEroABagRugBQweAIBbgAAACJQQxYwegYBQD/4JCJQRBR/3QkFGoAagCLD/9RGIlHCItEJBiJOF5fuDASugAtUBC6AAUAFAAAwhAADx8Ai0QkCIM4AHUqg3gEAHUkgXgIwAAAAHUbgXgMAAAARnUSi1QkBP9CBItEJAyJEDPAwgwAuAJAAIDCDACQi1QkBP9CBItCBMIEAA8fAItUJAT/SgSLQgSD+AB/FosK/3IIagD/URyLVCQEiwpS/1EUM8DCBACLVCQEiwqLQSiFwHQ8Uv/QWoP4AXU+iwpS/1EsWoXAdTOLClJq8P9xIP9RJFqpAAAACHUgiwr/cghqAP9RHItUJATHQggAAAAAM8BQVP9yDP9SEFjCFACQ"
-    Const THUNK_SIZE    As Long = 5600
+Private Function InitFireOnceTimerThunk(pObj As Object, ByVal pfnCallback As Long, Optional Delay As Long) As IUnknown
+    Const STR_THUNK     As String = "6AAAAABag+oFgeogERkAV1aLdCQUg8YIgz4AdCqL+oHHBBMZAIvCBSgSGQCri8IFZBIZAKuLwgV0EhkAqzPAq7kIAAAA86WBwgQTGQBSahj/UhBai/iLwqu4AQAAAKszwKuri3QkFKWlg+8Yi0IMSCX/AAAAUItKDDsMJHULWIsPV/9RFDP/62P/QgyBYgz/AAAAjQTKjQTIjUyIMIB5EwB101jHAf80JLiJeQTHQQiJRCQEi8ItBBMZAAWgEhkAUMHgCAW4AAAAiUEMWMHoGAUA/+CQiUEQiU8MUf90JBRqAGoAiw//URiJRwiLRCQYiTheX7g0ExkALSARGQAFABQAAMIQAGaQi0QkCIM4AHUqg3gEAHUkgXgIwAAAAHUbgXgMAAAARnUSi1QkBP9CBItEJAyJEDPAwgwAuAJAAIDCDACQi1QkBP9CBItCBMIEAA8fAItUJAT/SgSLQgR1HYtCDMZAEwCLCv9yCGoA/1Eci1QkBIsKUv9RFDPAwgQAi1QkBIsKi0EohcB0J1L/0FqD+AF3SYsKUv9RLFqFwHU+iwpSavD/cSD/USRaqQAAAAh1K4sKUv9yCGoA/1EcWv9CBDPAUFT/chD/UhSLVCQIx0IIAAAAAFLodv///1jCFABmkA==" ' 27.3.2019 9:14:57
+    Const THUNK_SIZE    As Long = 5652
     Static hThunk       As Long
     Dim aParams(0 To 9) As Long
     Dim lSize           As Long
 
-    aParams(0) = lThisPtr
+    aParams(0) = ObjPtr(pObj)
     aParams(1) = pfnCallback
+    #If ImplSelfContained Then
+        If hThunk = 0 Then
+            hThunk = pvThunkGlobalData("InitFireOnceTimerThunk")
+        End If
+    #End If
     If hThunk = 0 Then
         hThunk = VirtualAlloc(0, THUNK_SIZE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
+        If hThunk = 0 Then
+            Exit Function
+        End If
         Call CryptStringToBinary(STR_THUNK, Len(STR_THUNK), CRYPT_STRING_BASE64, hThunk, THUNK_SIZE)
         aParams(2) = GetProcAddress(GetModuleHandle("ole32"), "CoTaskMemAlloc")
         aParams(3) = GetProcAddress(GetModuleHandle("ole32"), "CoTaskMemFree")
         aParams(4) = GetProcAddress(GetModuleHandle("user32"), "SetTimer")
         aParams(5) = GetProcAddress(GetModuleHandle("user32"), "KillTimer")
-        #If Not ImplNoVBIDESupport Then
-            If InIde Then
-                aParams(6) = hIdeOwner
-                aParams(7) = GetProcAddress(GetModuleHandle("user32"), "GetWindowLongA")
-                aParams(8) = GetProcAddress(GetModuleHandle("vba6"), "EbMode")
-                aParams(9) = GetProcAddress(GetModuleHandle("vba6"), "EbIsResetting")
-            End If
+        '--- for IDE protection
+        Debug.Assert pvGetIdeOwner(aParams(6))
+        If aParams(6) <> 0 Then
+            aParams(7) = GetProcAddress(GetModuleHandle("user32"), "GetWindowLongA")
+            aParams(8) = GetProcAddress(GetModuleHandle("vba6"), "EbMode")
+            aParams(9) = GetProcAddress(GetModuleHandle("vba6"), "EbIsResetting")
+        End If
+        #If ImplSelfContained Then
+            pvThunkGlobalData("InitFireOnceTimerThunk") = hThunk
         #End If
     End If
     lSize = CallWindowProc(hThunk, 0, Delay, VarPtr(aParams(0)), VarPtr(InitFireOnceTimerThunk))
     Debug.Assert lSize = THUNK_SIZE
 End Function
 
-Private Property Get InIde() As Boolean
-    Debug.Assert pvSetTrue(InIde)
-End Property
-
-Private Function pvSetTrue(bValue As Boolean) As Boolean
-    bValue = True
-    pvSetTrue = True
+Private Function pvGetIdeOwner(hIdeOwner As Long) As Boolean
+    #If Not ImplNoIdeProtection Then
+        Dim lProcessId      As Long
+
+        Do
+            hIdeOwner = FindWindowEx(0, hIdeOwner, "IDEOwner", vbNullString)
+            Call GetWindowThreadProcessId(hIdeOwner, lProcessId)
+        Loop While hIdeOwner <> 0 And lProcessId <> GetCurrentProcessId()
+    #End If
+    pvGetIdeOwner = True
 End Function
 
-Private Property Get hIdeOwner() As Long
+Private Property Get pvThunkGlobalData(sKey As String) As Long
+    Dim sBuffer     As String
+
+    sBuffer = String$(50, 0)
+    Call GetEnvironmentVariable("_MST_GLOBAL" & App.hInstance & "_" & sKey, sBuffer, Len(sBuffer) - 1)
+    pvThunkGlobalData = Val(Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1))
+End Property
 
+Private Property Let pvThunkGlobalData(sKey As String, ByVal lValue As Long)
+    Call SetEnvironmentVariable("_MST_GLOBAL" & App.hInstance & "_" & sKey, lValue)
 End Property
 #End If