VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "API_Ribbon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'==== Оболочка для хранения и загрузки идентификатора ленты (Ribbon) =========================
' Shared module version: 20210217
' Required reference: Microsoft Scripting Runtime
Option Explicit

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal nLen As Long)
 
Private ribbon_ As IRibbonUI
Private backup_ As String

Private Sub Class_Terminate()
  If Not ribbon_ Is Nothing Then _
    Call KillBackup
End Sub

Public Function Init(target As IRibbonUI, sBackup$)
  Set ribbon_ = target
  backup_ = sBackup
  Call SaveBackup
End Function

Public Property Get Value() As IRibbonUI
  Set Value = ribbon_
End Property

Public Function LoadFrom(sFilePath$) As IRibbonUI
  Set ribbon_ = Nothing
  backup_ = sFilePath
  
  Call LoadBackup
  
  Set LoadFrom = ribbon_
End Function

' =======
Private Function SaveBackup()
  Dim ribbonPtr As LongPtr: ribbonPtr = ObjPtr(ribbon_)
  Dim fso As New Scripting.FileSystemObject
  Dim textOut As Scripting.TextStream: Set textOut = fso.CreateTextFile(backup_, Overwrite:=True)
  If Not textOut Is Nothing Then
    Call textOut.WriteLine(ribbonPtr)
    Call textOut.Close
  End If
End Function

Private Function LoadBackup()
  Dim fso As New Scripting.FileSystemObject
  If Not fso.FileExists(backup_) Then _
    Exit Function
  
  Dim textIn As Scripting.TextStream: Set textIn = fso.OpenTextFile(backup_)
  If textIn Is Nothing Then _
    Exit Function
  
  Dim ptrSize&
  #If Win64 Then
    ptrSize = 8
  #Else
    ptrSize = 4
  #End If
  
  Dim aLine$: aLine = textIn.ReadLine
  If IsNumeric(aLine) Then
    Dim nPtr As LongPtr: nPtr = CLngPtr(aLine)
    Dim objRibbon As Object
    Call CopyMemory(objRibbon, nPtr, ptrSize)
    Set ribbon_ = objRibbon
    Call CopyMemory(objRibbon, 0&, ptrSize)
  End If
End Function

Private Function KillBackup()
  Dim fso As New Scripting.FileSystemObject
  If fso.FileExists(backup_) Then _
    Call fso.DeleteFile(backup_)
End Function