38 install access add in compile error if tlb exists and has missing interfaces (#40)

Check dll version/tlb file date + remove file if new version exists

Author: josef-poetzl

access-add-in/AccUnitLoader.accda

@@ -128,9 +128,8 @@ Public Property Get AccUnitFileNames() As Variant()
                         ACCUNIT_DLL_FILE, _
                         "AccessCodeLib.Common.Tools.dll", _
                         "AccessCodeLib.Common.VBIDETools.dll", _
-                        "AccessCodeLib.Common.VBIDETools.XmlSerializers.dll", _
                         "Microsoft.Vbe.Interop.dll")
-   '                       "Interop.VBA.dll"
+
 End Property
 
 Public Sub ExportAccUnitFiles(Optional ByVal lBit As Long = 0)
@@ -142,7 +141,7 @@ Public Sub ExportAccUnitFiles(Optional ByVal lBit As Long = 0)
 On Error GoTo HandleErr
 
    If lBit = 0 Then
-      lBit = GetCurrentAccessBitSystem
+      lBit = GetCurrentVbaBitSystem
    End If
 
    sBit = CStr(lBit)
@@ -172,7 +171,7 @@ Public Sub ImportAccUnitFiles(Optional ByVal lBit As Long = 0)
    Dim DllPath As String
 
    If lBit = 0 Then
-      lBit = GetCurrentAccessBitSystem
+      lBit = GetCurrentVbaBitSystem
    End If
 
    sBit = CStr(lBit)
@@ -192,16 +191,16 @@ Public Sub ImportAccUnitFiles(Optional ByVal lBit As Long = 0)
 
 End Sub
 
-Public Function GetCurrentAccessBitSystem() As Long
+Public Function GetCurrentVbaBitSystem() As Long
 
 #If VBA7 Then
 #If Win64 Then
-      GetCurrentAccessBitSystem = 64
+      GetCurrentVbaBitSystem = 64
 #Else
-      GetCurrentAccessBitSystem = 32
+      GetCurrentVbaBitSystem = 32
 #End If
 #Else
-      GetCurrentAccessBitSystem = 32
+      GetCurrentVbaBitSystem = 32
 #End If
 
 End Function

access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas

@@ -199,7 +199,7 @@ End Sub
 Public Function SaveAppFile(ByVal FileID As String, ByVal FileName As String, _
                    Optional ByVal SaveVersion As Boolean = False, _
                    Optional ByVal ExtFieldName As String, Optional ByVal ExtFieldValue As Variant, _
-                   Optional ByVal ExtFilterFieldName As String, Optional ExtFilterValue As Variant) As Boolean
+                   Optional ByVal ExtFilterFieldName As String, Optional ByVal ExtFilterValue As Variant) As Boolean
 
    Dim FileNo As Integer
    Dim Binfile() As Byte
@@ -295,6 +295,28 @@ Private Function CreateAppFileTable() As Boolean
 
 End Function
 
+Public Function GetStoredAppFileVersion(ByVal FileID As String, _
+                               Optional ByVal ExtFilterFieldName As String, _
+                               Optional ByVal ExtFilterValue As Variant) As String
+
+   Dim SelectSql As String
+   Dim rst As DAO.Recordset
+
+   SelectSql = "select version from " & TABLE_APPFILES & " where id='" & Replace(FileID, "'", "''") & "'"
+   If Len(ExtFilterFieldName) > 0 Then
+      SelectSql = SelectSql & " and " & ExtFilterFieldName & " = '" & Replace(ExtFilterValue, "'", "''") & "'"
+   End If
+
+   Set rst = CodeDb.OpenRecordset(SelectSql, dbOpenForwardOnly)
+   With rst
+      If Not .EOF Then
+         GetStoredAppFileVersion = Nz(.Fields(0).Value, vbNullString)
+      End If
+      .Close
+   End With
+
+End Function
+
 
 '---------------------------------------------------------------------------------------
 ' Event handling of m_ApplicationHandler

access-add-in/source/modules/ApplicationHandler_AppFile.cls

@@ -72,7 +72,7 @@ Private Sub PrintTestDetailSummary(ByRef TestResults() As AccUnit.ITestResult)
       i = i + 1
       If TypeOf r Is AccUnit.TestResultCollection Then
          If i > 1 Then Debug.Print String(20, "-")
-         Debug.Print CStr(i), r.test.FullName & ":", r.Result, "..."
+         Debug.Print CStr(i), r.Test.FullName & ":", r.Result, "..."
          Debug.Print String(3, " ") & String(17, "-")
          PrintSubResults i, r
          LastTestIsRowTest = True
@@ -81,7 +81,7 @@ Private Sub PrintTestDetailSummary(ByRef TestResults() As AccUnit.ITestResult)
             LastTestIsRowTest = False
             If i > 1 Then Debug.Print String(20, "-")
          End If
-         Debug.Print CStr(i), r.test.FullName & ":", r.Result, r.Message
+         Debug.Print CStr(i), r.Test.FullName & ":", r.Result, r.Message
       End If
    Next
 
@@ -97,10 +97,10 @@ Private Sub PrintSubResults(ByVal mainId As String, ByVal resultCol As AccUnit.T
       Set r = resultCol.Item(i - 1)
       ResultID = mainId & "." & i
       If TypeOf r Is AccUnit.ITestResultSummary Then
-         Debug.Print String(3, " ") & ResultID, r.test.FullName & "-", r.Result, "..."
+         Debug.Print String(3, " ") & ResultID, r.Test.FullName & "-", r.Result, "..."
          PrintSubResults ResultID, r
       Else
-         Debug.Print String(3, " ") & ResultID, r.test.FullName & "-", r.Result, r.Message
+         Debug.Print String(3, " ") & ResultID, r.Test.FullName & "-", r.Result, r.Message
       End If
    Next
 

access-add-in/source/modules/DebugPrintTestResultReporter.cls

@@ -86,7 +86,7 @@ Private Sub PrintTestDetailSummary(ByRef TestResults() As AccUnit.ITestResult)
       i = i + 1
       If TypeOf r Is AccUnit.TestResultCollection Then
          If i > 1 Then PrintToFile String(20, "-")
-         PrintToFile CStr(i), r.test.FullName & ":", r.Result, "..."
+         PrintToFile CStr(i), r.Test.FullName & ":", r.Result, "..."
          PrintToFile String(3, " ") & String(17, "-")
          PrintSubResults i, r
          LastTestIsRowTest = True
@@ -95,7 +95,7 @@ Private Sub PrintTestDetailSummary(ByRef TestResults() As AccUnit.ITestResult)
             LastTestIsRowTest = False
             If i > 1 Then PrintToFile String(20, "-")
          End If
-         PrintToFile CStr(i), r.test.FullName & ":", r.Result, r.Message
+         PrintToFile CStr(i), r.Test.FullName & ":", r.Result, r.Message
       End If
    Next
 
@@ -111,10 +111,10 @@ Private Sub PrintSubResults(ByVal mainId As String, ByVal resultCol As AccUnit.T
       Set r = resultCol.Item(i - 1)
       ResultID = mainId & "." & i
       If TypeOf r Is AccUnit.ITestResultSummary Then
-         PrintToFile String(3, " ") & ResultID, r.test.FullName, r.Result, "..."
+         PrintToFile String(3, " ") & ResultID, r.Test.FullName, r.Result, "..."
          PrintSubResults ResultID, r
       Else
-         PrintToFile String(3, " ") & ResultID, r.test.FullName, r.Result, r.Message
+         PrintToFile String(3, " ") & ResultID, r.Test.FullName, r.Result, r.Message
       End If
    Next
 

access-add-in/source/modules/LogFileTestResultReporter.cls

@@ -17,8 +17,8 @@
 Option Compare Text
 Option Explicit
 
-'Version nummer
-Private Const APPLICATION_VERSION As String = "0.9.25.240313"
+'Version number
+Private Const APPLICATION_VERSION As String = "0.9.26.240316"
 
 Private Const APPLICATION_NAME As String = "ACLib AccUnit Loader"
 Private Const APPLICATION_FULLNAME As String = "Access Code Library - AccUnit Loader"
@@ -109,8 +109,6 @@ Private Sub SetAppFiles()
       Next
    End With
 
-
-
 End Sub
 
 Public Sub PrepareForVCS()
@@ -120,3 +118,11 @@ Public Sub PrepareForVCS()
    End If
    RemoveAccUnitTlbReference
 End Sub
+
+Private Sub Test()
+With New WinApiFileInfo
+   Debug.Print VBA.FileDateTime(CodeProject.Path & "\lib\x86\AccessCodeLib.AccUnit.tlb")
+   Debug.Print "Version:", .GetFileVersion(CodeProject.Path & "\lib\x86\AccessCodeLib.AccUnit.tlb")
+End With
+
+End Sub

access-add-in/source/modules/_config_Application.bas

@@ -21,16 +21,27 @@ Public Property Get DefaultAccUnitLibFolder() As String
    DefaultAccUnitLibFolder = FilePath & "lib"
 End Property
 
-Public Sub CheckAccUnitTypeLibFile(Optional ByVal VBProjectRef As VBProject = Nothing)
+Public Sub CheckAccUnitTypeLibFile(Optional ByVal VBProjectRef As VBProject = Nothing, Optional ByRef ReferenceFixed As Boolean)
 
    Dim LibPath As String
    Dim LibFile As String
+   Dim ExportFile As Boolean
+   Dim FileFixed As Boolean
 
    LibPath = GetAccUnitLibPath(True)
    LibFile = LibPath & ACCUNIT_TYPELIB_FILE
    FileTools.CreateDirectory LibPath
 
-   If Not FileTools.FileExists(LibFile) Then
+   ExportFile = Not FileTools.FileExists(LibFile)
+   If Not ExportFile Then
+      If Not CheckAccUnitVersion(LibFile) Then
+         RemoveAccUnitTlbReference VBProjectRef
+         ExportFile = True
+      End If
+   End If
+
+   If ExportFile Then
+      FileFixed = True
       ExportTlbFile LibFile
    End If
 
@@ -39,7 +50,9 @@ On Error Resume Next
       Set VBProjectRef = CodeVBProject
    End If
 
-   CheckMissingReference VBProjectRef
+   CheckMissingReference VBProjectRef, ReferenceFixed
+
+   ReferenceFixed = ReferenceFixed Or FileFixed
 
 End Sub
 
@@ -75,11 +88,11 @@ End Function
 
 Private Sub ExportTlbFile(ByVal LibFile As String)
    With CurrentApplication.Extensions(EXTENSION_KEY_APPFILE)
-      .CreateAppFile ACCUNIT_TYPELIB_FILE, LibFile
+      .CreateAppFile ACCUNIT_TYPELIB_FILE, LibFile, "BitInfo", CStr(GetCurrentVbaBitSystem)
    End With
 End Sub
 
-Private Sub CheckMissingReference(ByVal VBProjectRef As VBProject)
+Private Sub CheckMissingReference(ByVal VBProjectRef As VBProject, Optional ByRef ReferenceFixed As Boolean)
 
    Dim AccUnitRefExists As Boolean
    Dim ref As Object
@@ -102,6 +115,7 @@ On Error GoTo 0
    End With
 
    AddAccUnitTlbReference VBProjectRef
+   ReferenceFixed = True
 
 End Sub
 
@@ -132,3 +146,75 @@ On Error GoTo 0
    Next
 
 End Sub
+
+Private Function CheckAccUnitVersion(ByVal AccUnitTlbFilePath As String) As Boolean
+
+   Dim AccUnitDllPath As String
+
+   AccUnitDllPath = VBA.Replace(AccUnitTlbFilePath, ".tlb", ".dll")
+
+   If FileTools.FileExists(AccUnitDllPath) Then
+      CheckAccUnitVersion = CheckAccUnitDllVersion(AccUnitDllPath)
+      Exit Function
+   End If
+
+   CheckAccUnitVersion = CheckAccUnitTlbVersion(AccUnitTlbFilePath)
+
+End Function
+
+Private Function CheckAccUnitDllVersion(ByVal AccUnitDllFilePath As String) As Boolean
+
+   Dim InstalledFileVersion As String
+   Dim SourceTableFileVersion As String
+
+   With New WinApiFileInfo
+      InstalledFileVersion = .GetFileVersion(AccUnitDllFilePath)
+   End With
+
+   With CurrentApplication.Extensions(EXTENSION_KEY_APPFILE)
+      SourceTableFileVersion = .GetStoredAppFileVersion(ACCUNIT_DLL_FILE, "BitInfo", VBA.CStr(GetCurrentVbaBitSystem))
+   End With
+
+   CheckAccUnitDllVersion = (CompareVersions(InstalledFileVersion, SourceTableFileVersion) >= 0)
+
+End Function
+
+Private Function CheckAccUnitTlbVersion(ByVal AccUnitTlbFilePath As String) As Boolean
+
+   Dim InstalledFileVersion As String
+   Dim SourceTableFileVersion As String
+
+   InstalledFileVersion = VBA.Format(VBA.FileDateTime(AccUnitTlbFilePath), "yyyy\.mm\.dd")
+
+   With CurrentApplication.Extensions(EXTENSION_KEY_APPFILE)
+      SourceTableFileVersion = .GetStoredAppFileVersion(ACCUNIT_TYPELIB_FILE, "BitInfo", VBA.CStr(GetCurrentVbaBitSystem))
+   End With
+
+   CheckAccUnitTlbVersion = (CompareVersions(InstalledFileVersion, SourceTableFileVersion) >= 0)
+
+End Function
+
+Private Function CompareVersions(ByVal Version1 As String, ByVal Version2 As String) As Long
+
+   Dim Version1Parts() As String
+   Dim Version2Parts() As String
+   Dim i As Long
+
+   If VBA.StrComp(Version1, Version2, vbTextCompare) = 0 Then
+      CompareVersions = 0
+      Exit Function
+   End If
+
+   Version1Parts = VBA.Split(Version1, ".")
+   Version2Parts = VBA.Split(Version2, ".")
+
+   For i = 0 To UBound(Version1Parts)
+      If VBA.Val(Version1Parts(i)) > VBA.Val(Version2Parts(i)) Then
+         CompareVersions = 1
+         Exit For
+      End If
+   Next
+
+   CompareVersions = -1
+
+End Function