diff --git a/access-add-in/AccUnitLoader.accda b/access-add-in/AccUnitLoader.accda index 9454107..55d87b2 100644 Binary files a/access-add-in/AccUnitLoader.accda and b/access-add-in/AccUnitLoader.accda differ diff --git a/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas b/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas index a38003f..e23c33a 100644 --- a/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas +++ b/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas @@ -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 diff --git a/access-add-in/source/modules/ApplicationHandler_AppFile.cls b/access-add-in/source/modules/ApplicationHandler_AppFile.cls index c783a51..c1f86e1 100644 --- a/access-add-in/source/modules/ApplicationHandler_AppFile.cls +++ b/access-add-in/source/modules/ApplicationHandler_AppFile.cls @@ -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 diff --git a/access-add-in/source/modules/DebugPrintTestResultReporter.cls b/access-add-in/source/modules/DebugPrintTestResultReporter.cls index c31ca98..856756b 100644 --- a/access-add-in/source/modules/DebugPrintTestResultReporter.cls +++ b/access-add-in/source/modules/DebugPrintTestResultReporter.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 diff --git a/access-add-in/source/modules/LogFileTestResultReporter.cls b/access-add-in/source/modules/LogFileTestResultReporter.cls index ad7321d..82515de 100644 --- a/access-add-in/source/modules/LogFileTestResultReporter.cls +++ b/access-add-in/source/modules/LogFileTestResultReporter.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 diff --git a/access-add-in/source/modules/_config_Application.bas b/access-add-in/source/modules/_config_Application.bas index 8fc4bdd..9666e81 100644 --- a/access-add-in/source/modules/_config_Application.bas +++ b/access-add-in/source/modules/_config_Application.bas @@ -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 diff --git a/access-add-in/source/modules/modTypeLibCheck.bas b/access-add-in/source/modules/modTypeLibCheck.bas index 7e154b7..de8a949 100644 --- a/access-add-in/source/modules/modTypeLibCheck.bas +++ b/access-add-in/source/modules/modTypeLibCheck.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 diff --git a/excel-add-in/AccUnitLoader.xlam b/excel-add-in/AccUnitLoader.xlam index 64c45ac..85aea53 100644 Binary files a/excel-add-in/AccUnitLoader.xlam and b/excel-add-in/AccUnitLoader.xlam differ diff --git a/excel-add-in/source/AccUnitLoaderForm.frx b/excel-add-in/source/AccUnitLoaderForm.frx index 4584094..fb4c8c2 100644 Binary files a/excel-add-in/source/AccUnitLoaderForm.frx and b/excel-add-in/source/AccUnitLoaderForm.frx differ diff --git a/excel-add-in/source/AccUnitUserSettings.frx b/excel-add-in/source/AccUnitUserSettings.frx index fd2f355..75491c9 100644 Binary files a/excel-add-in/source/AccUnitUserSettings.frx and b/excel-add-in/source/AccUnitUserSettings.frx differ diff --git a/excel-add-in/source/ApplicationHandler_AppFile.cls b/excel-add-in/source/ApplicationHandler_AppFile.cls index 7ba92cb..b40d52c 100644 --- a/excel-add-in/source/ApplicationHandler_AppFile.cls +++ b/excel-add-in/source/ApplicationHandler_AppFile.cls @@ -208,11 +208,23 @@ Public Function SaveAppFile(ByVal FileID As String, ByVal FileName As String, _ Optional ByVal ExtFilterFieldName As String, Optional ExtFilterValue As Variant) As Boolean Dim PropertyName As String + Dim Version As String + Dim FileInfo As WinApiFileInfo PropertyName = FileID If ExtFilterFieldName = "BitInfo" Then PropertyName = PropertyName & ".x" & ExtFilterValue End If + + If SaveVersion Then + Set FileInfo = New WinApiFileInfo + Version = FileInfo.GetFileVersion(FileName) + Set FileInfo = Nothing + If Len(Version) = 0 Then + Version = VBA.Format$(Nz(FileDateTime(FileName), vbNullString), "yyyy.mm.dd") + End If + SaveCustomDocumentProperty PropertyName & ".Version", Version + End If SaveAppFile = SaveAsCustomDocumentProperty(PropertyName, FileName) @@ -220,13 +232,20 @@ End Function Private Function SaveAsCustomDocumentProperty(ByVal PropertyName As String, ByVal FilePath As String) As Boolean - Dim CustProp As Object Dim Base64FileString As String With New Base64Converter Base64FileString = .ConvertFileToBase64(FilePath) End With + SaveAsCustomDocumentProperty = SaveCustomDocumentProperty(PropertyName, Base64FileString) + +End Function + +Private Function SaveCustomDocumentProperty(ByVal PropertyName As String, ByRef PropertyValue As String) As Boolean + + Dim CustProp As Object + Set CustProp = GetCustomProperty(PropertyName) If CustProp Is Nothing Then Set CustProp = ThisWorkbook.CustomDocumentProperties.Add( _ @@ -236,12 +255,12 @@ Private Function SaveAsCustomDocumentProperty(ByVal PropertyName As String, ByVa Type:=msoPropertyTypeString) End If - CustProp.Value = Base64FileString - SaveAsCustomDocumentProperty = True + CustProp.Value = PropertyValue + + SaveCustomDocumentProperty = True End Function - '--------------------------------------------------------------------------------------- ' Function: RemoveAppFileFormAddInStorage '--------------------------------------------------------------------------------------- @@ -283,7 +302,30 @@ Private Function RemoveCustomDocumentProperties(ByVal PropertyName As String) As End Function - +Public Function GetStoredAppFileVersion(ByVal FileID As String, _ + Optional ByVal ExtFilterFieldName As String, _ + Optional ByVal ExtFilterValue As Variant) As String + + Dim PropertyName As String + Dim Prop As Object + + PropertyName = FileID + If ExtFilterFieldName = "BitInfo" Then + PropertyName = PropertyName & ".x" & ExtFilterValue + End If + PropertyName = PropertyName & ".Version" + + Set Prop = GetCustomProperty(PropertyName) + If Prop Is Nothing Then + GetStoredAppFileVersion = vbNullString + Debug.Print "CustomDocumentProperty "; PropertyName; " not exits" + Exit Function + 'Err.Raise vbObjectError, "GetStoredAppFileVersion", "CustomDocumentProperty not exits" + End If + + GetStoredAppFileVersion = Prop.Value + +End Function '--------------------------------------------------------------------------------------- ' Event handling of m_ApplicationHandler diff --git a/excel-add-in/source/References.txt b/excel-add-in/source/References.txt index aab7571..6ccb0bf 100644 --- a/excel-add-in/source/References.txt +++ b/excel-add-in/source/References.txt @@ -7,4 +7,3 @@ VBIDE|Microsoft Visual Basic for Applications Extensibility 5.3|{0002E157-0000-0 mscoree|Common Language Runtime Execution Engine 2.0 Library|{5477469E-83B1-11D2-8B49-00A0C9B7C9C4}|2|0|C:\Windows\Microsoft.NET\Framework\v2.0.50727\mscoree.tlb mscorlib|mscorlib.dll|{BED7F4EA-1A96-11D2-8F08-00A0C9A6186D}|2|0|C:\Windows\Microsoft.NET\Framework\v2.0.50727\mscorlib.tlb MSForms|Microsoft Forms 2.0 Object Library|{0D452EE1-E08F-101A-852E-02608C4D0BB4}|2|0|C:\WINDOWS\SysWOW64\FM20.DLL -AccUnit||{1575D69A-C503-4149-B3A9-2CE188B19C15}|0|9| diff --git a/excel-add-in/source/WinApiFileInfo.cls b/excel-add-in/source/WinApiFileInfo.cls new file mode 100644 index 0000000..b5f87a0 --- /dev/null +++ b/excel-add-in/source/WinApiFileInfo.cls @@ -0,0 +1,180 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "WinApiFileInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Class: api.winapi.WinApiFileInfo +'--------------------------------------------------------------------------------------- +' +' Read file information with Win-API +' +' Author: +' Josef Poetzl +' +'--------------------------------------------------------------------------------------- + +'--------------------------------------------------------------------------------------- +' +' api/winapi/WinApiFileInfo.cls +' _codelib/license.bas +' +'--------------------------------------------------------------------------------------- +' +' Code based on http://support.microsoft.com/kb/509493/ +' +Option Compare Text +Option Explicit + +#If VBA7 Then + +Private Declare PtrSafe Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" ( _ + ByVal lptstrFilename As String, _ + lpdwHandle As LongPtr) As Long + +Private Declare PtrSafe Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" ( _ + ByVal lptstrFilename As String, _ + ByVal dwHandle As LongPtr, _ + ByVal dwLen As LongPtr, _ + lpData As Any _ + ) As Long + +Private Declare PtrSafe Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" ( _ + pBlock As Any, _ + ByVal lpSubBlock As String, _ + lplpBuffer As Any, _ + puLen As Long _ + ) As Long + +Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ + Dest As Any, _ + ByVal Source As LongPtr, _ + ByVal Length As Long) + +#Else + +Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" ( _ + ByVal lptstrFilename As String, _ + lpdwHandle As Long) As Long + +Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" ( _ + ByVal lptstrFilename As String, _ + ByVal dwHandle As Long, _ + ByVal dwLen As Long, _ + lpData As Any _ + ) As Long + +Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" ( _ + pBlock As Any, _ + ByVal lpSubBlock As String, _ + lplpBuffer As Any, _ + puLen As Long _ + ) As Long + +Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ + Dest As Any, _ + ByVal Source As Long, _ + ByVal Length As Long) + +#End If + +Private Type VS_FIXEDFILEINFO + dwSignature As Long + dwStrucVersion As Long + dwFileVersionMS As Long + dwFileVersionLS As Long + dwProductVersionMS As Long + dwProductVersionLS As Long + dwFileFlagsMask As Long + dwFileFlags As Long + dwFileOS As Long + dwFileType As Long + dwFileSubtype As Long + dwFileDateMS As Long + dwFileDateLS As Long +End Type + +Private Type FILEINFOOUT + FileVersion As String + ProductVersion As String +End Type + +'--------------------------------------------------------------------------------------- +' Function: GetFileVersion +'--------------------------------------------------------------------------------------- +' +' Determines the version of a file +' +' Parameters: +' FilePath - full path to the file +' +' Returns: +' Version identifier +' +' Remarks: +' Useful for reading versions from dll files +' +'-------------------------------------------------------------------------------------- +Public Function GetFileVersion(ByVal FilePath As String) As String + Dim VerInfo As FILEINFOOUT + If GetVersion(FilePath, VerInfo) Then + GetFileVersion = VerInfo.FileVersion + Else + GetFileVersion = vbNullString + End If +End Function + +Private Function GetVersion(ByVal FilePath As String, _ + ByRef GetFileInfo As FILEINFOOUT) As Boolean + + Dim Ret As Long, Size As Long, Handle As LongPtr + Dim VerBufLen As Long, VerPointer As LongPtr + Dim FileInfo As VS_FIXEDFILEINFO + Dim BufferString() As Byte + + Size = GetFileVersionInfoSize(FilePath, Handle) + If Size = 0 Then + GetVersion = False + Exit Function + End If + + ReDim BufferString(Size) + Ret = GetFileVersionInfo(FilePath, 0&, Size, BufferString(0)) + If Ret = 0 Then + GetVersion = False + Exit Function + End If + + Ret = VerQueryValue(BufferString(0), "\", VerPointer, VerBufLen) + If Ret = 0 Then + GetVersion = False + Exit Function + End If + + Call MoveMemory(FileInfo, VerPointer, Len(FileInfo)) + + With FileInfo + + GetFileInfo.FileVersion = _ + Trim$(Str$((.dwFileVersionMS And &HFFFF0000) \ &H10000)) & "." & _ + Trim$(Str$(.dwFileVersionMS And &HFFFF&)) & "." & _ + Trim$(Str$((.dwFileVersionLS And &HFFFF0000) \ &H10000)) & "." & _ + Trim$(Str$(.dwFileVersionLS And &HFFFF&)) + + GetFileInfo.ProductVersion = _ + Trim$(Str$((.dwProductVersionMS And &HFFFF0000) \ &H10000)) & "." & _ + Trim$(Str$(.dwProductVersionMS And &HFFFF&)) & "." & _ + Trim$(Str$((.dwProductVersionLS And &HFFFF0000) \ &H10000)) & "." & _ + Trim$(Str$(.dwProductVersionLS And &HFFFF&)) + + End With + + GetVersion = True + +End Function + + diff --git a/excel-add-in/source/config_Application.bas b/excel-add-in/source/config_Application.bas index a802f0a..d6f7a06 100644 --- a/excel-add-in/source/config_Application.bas +++ b/excel-add-in/source/config_Application.bas @@ -18,8 +18,8 @@ Option Compare Text Option Explicit Option Private Module -'Version nummer -Private Const APPLICATION_VERSION As String = "0.9.6.20240312" +'Version number +Private Const APPLICATION_VERSION As String = "0.9.7.20240316" Private Const APPLICATION_NAME As String = "ACLib AccUnit Loader" Private Const APPLICATION_FULLNAME As String = "Access Code Library - AccUnit Loader" diff --git a/excel-add-in/source/defGlobal_AccUnitLoader.bas b/excel-add-in/source/defGlobal_AccUnitLoader.bas index 75b8886..e4498a5 100644 --- a/excel-add-in/source/defGlobal_AccUnitLoader.bas +++ b/excel-add-in/source/defGlobal_AccUnitLoader.bas @@ -80,8 +80,7 @@ Public Property Get AccUnitFileNames() As Variant() "AccessCodeLib.Common.Tools.dll", _ "AccessCodeLib.Common.VBIDETools.dll", _ "Microsoft.Vbe.Interop.dll") - ' "Interop.VBA.dll" - ' "AccessCodeLib.Common.VBIDETools.XmlSerializers.dll" + End Property Public Sub ExportAccUnitFiles(Optional ByVal lBit As Long = 0) diff --git a/excel-add-in/source/modTypeLibCheck.bas b/excel-add-in/source/modTypeLibCheck.bas index d695f85..8dea4c2 100644 --- a/excel-add-in/source/modTypeLibCheck.bas +++ b/excel-add-in/source/modTypeLibCheck.bas @@ -37,18 +37,31 @@ Public Sub CheckAccUnitTypeLibFile(ByVal VBProjectRef As VBProject, Optional ByR 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 On Error Resume Next + If VBProjectRef Is Nothing Then + Set VBProjectRef = CodeVBProject + End If + CheckMissingReference VBProjectRef, ReferenceFixed ReferenceFixed = ReferenceFixed Or FileFixed @@ -95,10 +108,18 @@ Private Sub CheckMissingReference(ByVal VBProjectRef As VBProject, Optional ByRe Dim AccUnitRefExists As Boolean Dim ref As Object + Dim RefName As String With VBProjectRef For Each ref In .References - If ref.Name = "AccUnit" Then +On Error Resume Next + RefName = ref.Name + If Err.Number <> 0 Then + Err.Clear + RefName = vbNullString + End If +On Error GoTo 0 + If RefName = "AccUnit" Then AccUnitRefExists = True Exit Sub End If @@ -117,14 +138,104 @@ End Sub Private Sub RemoveAccUnitTlbReference(ByVal VBProjectRef As VBProject) Dim ref As Object + Dim RefName As String For Each ref In VBProjectRef.References +On Error Resume Next + RefName = ref.Name + If Err.Number <> 0 Then + Err.Clear + RefName = vbNullString + End If +On Error GoTo 0 + If ref.IsBroken Then VBProjectRef.References.Remove ref - ElseIf ref.Name = "AccUnit" Then + ElseIf RefName = "AccUnit" Then VBProjectRef.References.Remove ref Exit Sub End If 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 = CheckDllVersion(AccUnitDllPath) + Exit Function + End If + + CheckAccUnitVersion = CheckTlbVersion(AccUnitTlbFilePath) + +End Function + +Private Function CheckDllVersion(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 + + CheckDllVersion = (CompareVersions(InstalledFileVersion, SourceTableFileVersion) >= 0) + +End Function + +Private Function CheckTlbVersion(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 + + CheckTlbVersion = (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 + + If Len(Version1) = 0 Then + CompareVersions = -1 + Exit Function + ElseIf Len(Version2) = 0 Then + CompareVersions = 1 + 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 +