131 lines
4.4 KiB
QBasic
131 lines
4.4 KiB
QBasic
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
|