VBCommons/utility/ex_Version.bas

131 lines
4.4 KiB
QBasic
Raw Permalink Normal View History

2024-06-07 20:46:40 +03:00
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 = "<22><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Dim sMsg$: sMsg = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!" & vbNewLine & _
"<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" & vbNewLine & _
"<22><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" & vbNewLine & _
"ID <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & sProduct & vbNewLine & _
"<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>: " & sCurrentVersion & vbNewLine & _
"<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & sLocalVersion & vbNewLine & _
"<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & 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