Attribute VB_Name = "ex_Version" ' ======== Versioning helpers ======== ' Shared module version: 20221031 ' Tested in: ' Depends on: API_DistrManifest ' Required reference: Option Private Module Option Explicit Public Const CP_TOOLS_LOCAL = "C:\Tools" Public Const CP_UPDATE_SCRIPT = "UpdateConceptProducts" Public Const CP_VERSION_MSG_DELAY = 2000 Public Const CP_TOOLS_SERVER = "\\fs1.concept.ru\Exchange\ConceptDistr" Public Const FILE_DISTRIBUTION_MANIFEST = "distribution_manifest.json" Public Const CONCEPT_INSTALLER = "install.bat" Public Const ADDIN_NAME_CONCEPT = "CONCEPT.dotm" Public Const ADDIN_NAME_NPA = "_Concept-NPA.dotm" Public Const ADDIN_NAME_MARKUP = "MARKUP.dotm" Public Const ADDIN_NAME_PARSER = "Parsers.dotm" Public Const ADDIN_NAME_MAKET = "_Maket.dotm" Public Function VersionValidate(sProduct$, sCurrentVersion$) Dim iLocal As API_DistrManifest: Set iLocal = VersionLocalManifest Dim sLocalVersion$: sLocalVersion = iLocal.GetVersion(sProduct) If sLocalVersion = vbNullString Then Debug.Print "Cannot access local manifest" Exit Function End If Dim iServer As API_DistrManifest: Set iServer = VersionServerManifest Dim sServerVersion$: sServerVersion = iServer.GetVersion(sProduct) Dim bResult As Boolean: bResult = True If VersionCompare(sLocalVersion, sCurrentVersion) > 0 Then _ bResult = False If sServerVersion <> vbNullString Then _ If VersionCompare(sServerVersion, sCurrentVersion) > 0 Then _ bResult = False If bResult Then _ Exit Function If sServerVersion = vbNullString Then _ sServerVersion = "не доступна" Dim sMsg$: sMsg = "Внимание! Используемая версия продукта устарела!" & vbNewLine & _ "Создайте файл в новой версии продукта" & vbNewLine & _ "При необходимости обновите продукт с сервера" & vbNewLine & _ "ID продукта: " & sProduct & vbNewLine & _ "Версия файла: " & sCurrentVersion & vbNewLine & _ "Версия локальная: " & sLocalVersion & vbNewLine & _ "Версия серверная: " & sServerVersion Call MsgBox(sMsg, vbOKOnly + vbExclamation, "Version control") End Function Public Function VersionCreateFile(sPath$, sVersion$) As Boolean On Error GoTo RETURN_FALSE Dim sFile$: sFile = sPath & "\" & "VERSION" Dim nFileID&: nFileID = FreeFile Open sFile For Output As nFileID Print #nFileID, sVersion Close #nFileID VersionCreateFile = True Exit Function RETURN_FALSE: VersionCreateFile = False End Function Public Function VersionCompare(ver1$, ver2$) As Long Dim vals1() As String: vals1 = VBA.Split(ver1, ".") Dim vals2() As String: vals2 = VBA.Split(ver2, ".") VersionCompare = CLng(vals1(0)) - CLng(vals2(0)) If VersionCompare <> 0 Then _ Exit Function VersionCompare = CLng(vals1(1)) - CLng(vals2(1)) If VersionCompare <> 0 Then _ Exit Function VersionCompare = CLng(vals1(2)) - CLng(vals2(2)) End Function Public Function VersionLocalManifest() As API_DistrManifest Static s_Manifest As API_DistrManifest If s_Manifest Is Nothing Then Set s_Manifest = New API_DistrManifest Call s_Manifest.LoadLocal End If Set VersionLocalManifest = s_Manifest End Function Public Function VersionServerManifest() As API_DistrManifest Static s_Manifest As API_DistrManifest If s_Manifest Is Nothing Then Set s_Manifest = New API_DistrManifest Call s_Manifest.LoadServer End If Set VersionServerManifest = s_Manifest End Function Public Function VersionUpdateProducts(Optional sParams$ = "all") VersionUpdateProducts = False Dim fso As New Scripting.FileSystemObject Dim sScriptPath$: sScriptPath = CP_TOOLS_LOCAL & "\script\" & CP_UPDATE_SCRIPT & ".ps1" If Not fso.FileExists(sScriptPath) Then _ Exit Function On Error GoTo RETURN_FALSE Dim sExec$: sExec = "PowerShell -Command """ & _ "." & " " & "'" & sScriptPath & "'" & ";" & _ CP_UPDATE_SCRIPT & " " & "'" & CP_TOOLS_SERVER & "'" & " " & sParams & _ """" Dim iShell As Object: Set iShell = CreateObject("WScript.Shell") VersionUpdateProducts = iShell.Run(sExec, waitOnReturn:=True) = 0 Exit Function RETURN_FALSE: On Error GoTo 0 End Function ' ======= Private Function LocalWordAddin(sName$) As String LocalWordAddin = VBA.Environ$("APPDATA") & "\Microsoft\Word\STARTUP" & "\" & sName End Function