Авторские программы, библиотеки, надстройки и шаблоны

' 16.08.2026 Testuse2
'Модуль mdStateKeeper: решение проблеммы "потри состояния" (State Loss или Global Variable Reset)
' В стандартном модуле
'LONG_PTR SetWindowLongPtrW(
'  [in] HWND     hWnd,
'  [in] int      nIndex,
'  [in] LONG_PTR dwNewLong
');
Option Explicit
 
#If Win64 Then
    Private Declare PtrSafe Function SetWindowLongPtrW Lib "User32.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#Else
    Private Declare PtrSafe Function SetWindowLongPtrW Lib "User32.dll" Alias "SetWindowLongW" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#End If
'LRESULT CallWindowProcW(
'  [in] WNDPROC lpPrevWndFunc,
'  [in] HWND    hWnd,
'  [in] UINT    Msg,
'  [in] WPARAM  wParam,
'  [in] LPARAM  lParam
');
Private Declare PtrSafe Function CallWindowProcW Lib "User32.dll" ( _
    ByVal lpPrevWndFunc As LongPtr, _
    ByVal hWnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As LongPtr
 
Private Const GWL_WNDPROC = -4
Private Const WM_CLOSE = &H10
Private Const WM_DESTROY = &H2
 
Private PrevWndProc As LongPtr
Private FormHandle As LongPtr
Public oForm As frmStateKeeper
 
Private Function NewWndProc(ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    If Msg = WM_DESTROY Then
        RemoveHook
        Debug.Print "Восстановление состояния"
        Application.OnTime Now, "StartStateKeeper"
        ' Если нужно отменить закрытие, можно не передавать сообщение дальше
        ' NewWndProc = 0
         Exit Function
    End If
    ' Все остальные сообщения передаём стандартной процедуре
    NewWndProc = CallWindowProcW(PrevWndProc, hWnd, Msg, wParam, lParam)
End Function
 
Sub StartStateKeeper()
    If PrevWndProc = 0 Then Else Exit Sub
    Set oForm = New frmStateKeeper
    ' Thanks to Christian Buse for this trick https://github.com/cristianbuse/VBA-SafeTimer/blob/master/src/SafeTimer.cls
    FormHandle = oForm.Frame1.[_GethWnd] 'FindWindowW(StrPtr("ThunderDFrame"), StrPtr("frmStateKeeper"))
    ' Установка перехвата
    PrevWndProc = SetWindowLongPtrW(FormHandle, GWL_WNDPROC, AddressOf NewWndProc)
End Sub
 
' Снятие хука для корректного уничтожения окна формы (возможно это не нужно)
Sub RemoveHook()
    If FormHandle <> 0 And PrevWndProc <> 0 Then
        Call SetWindowLongPtrW(FormHandle, GWL_WNDPROC, PrevWndProc)
    End If
End Sub

Option Explicit
 
Private hWndForm As LongPtr
Private Productions As New Collection
Private Init As Boolean
 
Private Sub ExapmleUsing()
    If Init Then Else Initialize      ' инициализируем все нужные переменные
    Start_StateLossDetector           ' запускаем детектор
    
    Dim filePath$: filePath = "C:\Test\5555.txt"
    Dim fileNum&
    fileNum = StoreHandle(FreeFile)   ' открываем условный хэндл и сохраняем его в надежном месте
    Open filePath For Binary Access Read As #fileNum
    
    End ' не предвиденная плохая ситуация, сопровождаемая "State Loss", и прерывание кода
    
    '***
    Close fileNum
End Sub
 
Private Sub Initialize()
    If PersistData.Exists("Продукты") Then
        Set Productions = PersistData("Продукты")
    Else
        Productions.Add "редиска"
        Productions.Add "картошка"
        Productions.Add "укроп"
        Productions.Add "повидло"
        
        PersistData.Add "Продукты", Productions
    End If
    Init = True
End Sub
 
Private Sub Start_StateLossDetector()
    ' В VBA-проекте обязательно должна быть форма!
    hWndForm = GetFormHWnd(DummyForm)
    StartStateLossDetector _
        hWndForm, _
        "'" & ThisWorkbook.FullName & "'!Module1.AfterStateLoss_Event"
End Sub
 
Private Function StoreHandle(ByVal lHandle As Long) As Long
    ' Handles - объект Collection, находящийся в модуле надстройки, т.о. он защищен от сбоя в данной книге
    Handles.Add lHandle
    StoreHandle = lHandle
End Function
 
' При возникновении сбоя, если быть точнее сразу после него будет запщено это "событие"
Private Sub AfterStateLoss_Event()
    Debug.Print "AfterStateLoss_Event"
    ReleaseAllHandles ' освобождение всех хэндлов, оставшихся после аварийного завершения
    Initialize        ' восстанавливаем инициализацию переменных
'    Start_StateLossDetector ' запускаем по новой
End Sub
 
Private Sub ReleaseAllHandles()
    Dim Handle
    For Each Handle In Handles
        Close Handle
    Next
    Set Handles = New Collection
End Sub

Private SLDetector As SLDetector
 
Private Sub ExampeUsing()
    Set SLDetector = New_SLDetector
    SLDetector.StartDetector "'" & ThisWorkbook.FullName & "'!Example2.AfterStateLoss_Event"
'    End
End Sub
 
Private Sub AfterStateLoss_Event()
    Debug.Print "AfterStateLoss_Event"
    ' Производим необходимые действия
    
    ' Перезапускаем детектор (если необходимо)
    Set SLDetector = New_SLDetector
'    SLDetector.StartDetector "'" & ThisWorkbook.FullName & "'!Example2.AfterStateLoss_Event"
End Sub