diff --git a/access-add-in/AccUnitLoader.accda b/access-add-in/AccUnitLoader.accda index 823c779..55d336b 100644 Binary files a/access-add-in/AccUnitLoader.accda and b/access-add-in/AccUnitLoader.accda differ diff --git a/access-add-in/source/forms/AccUnitLoaderForm.bas b/access-add-in/source/forms/AccUnitLoaderForm.bas index 9a9f2e9..124307a 100644 --- a/access-add-in/source/forms/AccUnitLoaderForm.bas +++ b/access-add-in/source/forms/AccUnitLoaderForm.bas @@ -26,6 +26,7 @@ Begin Form 0x212b6fd80e9ce340 End Caption ="ACLib - AccUnit Loader" + OnOpen ="[Event Procedure]" DatasheetFontName ="Calibri" OnTimer ="[Event Procedure]" OnLoad ="[Event Procedure]" diff --git a/access-add-in/source/forms/AccUnitLoaderForm.cls b/access-add-in/source/forms/AccUnitLoaderForm.cls index 221e9ac..e43b7f5 100644 --- a/access-add-in/source/forms/AccUnitLoaderForm.cls +++ b/access-add-in/source/forms/AccUnitLoaderForm.cls @@ -221,14 +221,7 @@ End Sub Private Sub Form_Load() - Dim ReferenceFixed As Boolean - Dim ReferenceFixedMessage As String - On Error GoTo ErrMissingPath - CheckAccUnitTypeLibFile CodeVBProject, ReferenceFixed, ReferenceFixedMessage - If Len(ReferenceFixedMessage) Then - Me.labInfo.Caption = ReferenceFixedMessage - End If With CurrentApplication Me.Caption = .ApplicationTitle & " " & VBA.ChrW(&H25AA) & " Version " & .Version @@ -250,6 +243,18 @@ ErrMissingPath: End Sub +Private Sub Form_Open(Cancel As Integer) + + Dim ReferenceFixed As Boolean + Dim ReferenceFixedMessage As String + + modTypeLibCheck.CheckAccUnitTypeLibFile modVbProject.CodeVBProject, ReferenceFixed, ReferenceFixedMessage + If VBA.Len(ReferenceFixedMessage) Then + Me.labInfo.Caption = ReferenceFixedMessage + End If + +End Sub + Private Sub Form_Timer() Me.TimerInterval = 0 Me.labInfo.Caption = vbNullString diff --git a/access-add-in/source/modules/ACLibConfiguration.cls b/access-add-in/source/modules/ACLibConfiguration.cls index 9ddf705..47df626 100644 --- a/access-add-in/source/modules/ACLibConfiguration.cls +++ b/access-add-in/source/modules/ACLibConfiguration.cls @@ -148,11 +148,11 @@ Public Property Get LocalRepositoryPath() As String If Len(m_LocalRepositoryPath) = 0 Then m_LocalRepositoryPath = GetACLibGlobalProperty(PROPNAME_LOCALREPOSITORYROOT) If Len(m_LocalRepositoryPath) > 0 Then - If Not DirExists(m_LocalRepositoryPath) Then + If Not FileTools.DirExists(m_LocalRepositoryPath) Then Err.Raise vbObjectError, "ACLibConfiguration.LocalRepositoryPath", "Das Verzeichnis '" & m_LocalRepositoryPath & "' ist nicht vorhanden!" m_LocalRepositoryPath = vbNullString End If - If Right$(m_LocalRepositoryPath, 1) <> "\" Then + If VBA.Right$(m_LocalRepositoryPath, 1) <> "\" Then m_LocalRepositoryPath = m_LocalRepositoryPath & "\" SetACLibGlobalProperty PROPNAME_LOCALREPOSITORYROOT, m_LocalRepositoryPath End If @@ -165,8 +165,8 @@ End Property Public Property Let LocalRepositoryPath(ByVal NewPath As String) - If Len(NewPath) > 0 Then - If Right$(NewPath, 1) <> "\" Then + If VBA.Len(NewPath) > 0 Then + If VBA.Right$(NewPath, 1) <> "\" Then NewPath = NewPath & "\" End If End If @@ -181,11 +181,11 @@ Public Property Get PrivateRepositoryPath() As String If Len(m_PrivateRepositoryPath) = 0 Then m_PrivateRepositoryPath = GetACLibGlobalProperty(PROPNAME_PRIVATEREPOSITORYROOT) If Len(m_PrivateRepositoryPath) > 0 Then - If Not DirExists(m_PrivateRepositoryPath) Then + If Not FileTools.DirExists(m_PrivateRepositoryPath) Then Err.Raise vbObjectError, "ACLibConfiguration.PrivateRepositoryPath", "Das Verzeichnis '" & m_PrivateRepositoryPath & "' ist nicht vorhanden!" m_PrivateRepositoryPath = vbNullString End If - If Right$(m_PrivateRepositoryPath, 1) <> "\" Then + If VBA.Right$(m_PrivateRepositoryPath, 1) <> "\" Then m_PrivateRepositoryPath = m_PrivateRepositoryPath & "\" SetACLibGlobalProperty PROPNAME_PRIVATEREPOSITORYROOT, m_PrivateRepositoryPath End If @@ -198,8 +198,8 @@ End Property Public Property Let PrivateRepositoryPath(ByVal NewPath As String) - If Len(NewPath) > 0 Then - If Right$(NewPath, 1) <> "\" Then + If VBA.Len(NewPath) > 0 Then + If VBA.Right$(NewPath, 1) <> "\" Then NewPath = NewPath & "\" End If End If @@ -214,7 +214,7 @@ Public Property Get ImportTestsDefaultValue() As Boolean ' 2 = true If m_ImportTestDefaultValue = 0 Then - m_ImportTestDefaultValue = Val(GetACLibGlobalProperty(PROPNAME_IMPORTTESTDEFAULTVALUE)) + 1 + m_ImportTestDefaultValue = VBA.Val(GetACLibGlobalProperty(PROPNAME_IMPORTTESTDEFAULTVALUE)) + 1 End If ImportTestsDefaultValue = (m_ImportTestDefaultValue = 2) @@ -222,15 +222,15 @@ End Property Public Property Let ImportTestsDefaultValue(ByVal NewValue As Boolean) - m_ImportTestDefaultValue = Abs(NewValue) + 1 - SetACLibGlobalProperty PROPNAME_IMPORTTESTDEFAULTVALUE, Abs(NewValue) + m_ImportTestDefaultValue = VBA.Abs(NewValue) + 1 + SetACLibGlobalProperty PROPNAME_IMPORTTESTDEFAULTVALUE, VBA.Abs(NewValue) End Property Public Property Get GitHubAuthPersonalAccessToken() As String 'm_GitHubAuthPersonalAccessToken: vbnullstring = noch nicht abgefragt - If StrPtr(m_GitHubAuthPersonalAccessToken) = 0 Then + If VBA.StrPtr(m_GitHubAuthPersonalAccessToken) = 0 Then m_GitHubAuthPersonalAccessToken = GetACLibGlobalProperty(PROPNAME_GITHUBAUTHPERSONALACCESSTOKEN) & "" End If GitHubAuthPersonalAccessToken = m_GitHubAuthPersonalAccessToken @@ -249,7 +249,7 @@ Friend Function GetACLibGlobalProperty(ByRef PropertyName As String) As String Dim rst As DAO.Recordset Dim SelectSql As String - SelectSql = Replace(SQL_SELECT_PROPERTYVALUE, "[?]", DaoSqlTool.TextToSqlText(PropertyName)) + SelectSql = VBA.Replace(SQL_SELECT_PROPERTYVALUE, "[?]", DaoSqlTool.TextToSqlText(PropertyName)) Set rst = ACLibPropertyDb.OpenRecordset(SelectSql) If Not rst.EOF Then GetACLibGlobalProperty = Nz(rst.Fields(SQL_CONFIG_TABLE_FIELD_PROPVALUE), vbNullString) @@ -265,7 +265,7 @@ Friend Function SetACLibGlobalProperty(ByRef PropertyName As String, ByRef NewVa Dim rst As DAO.Recordset Dim SelectSql As String - SelectSql = Replace(SQL_SELECT_PROPERTYVALUE, "[?]", DaoSqlTool.TextToSqlText(PropertyName)) + SelectSql = VBA.Replace(SQL_SELECT_PROPERTYVALUE, "[?]", DaoSqlTool.TextToSqlText(PropertyName)) Set rst = ACLibPropertyDb.OpenRecordset(SelectSql) If rst.EOF Then rst.AddNew @@ -310,7 +310,7 @@ Private Function CheckConfigTableDef() As Boolean Set db = CodeDb - If Not TableDefExists(ACLIB_CONFIG_TABLEDEFNAME, db) Then + If Not DaoTools.TableDefExists(ACLIB_CONFIG_TABLEDEFNAME, db) Then Set tdf = db.CreateTableDef(ACLIB_CONFIG_TABLEDEFNAME) tdf.Connect = ";Database=" & ACLibConfigDatabaseFile @@ -319,7 +319,7 @@ Private Function CheckConfigTableDef() As Boolean Else - ConfigDataPath = Mid$(db.TableDefs(ACLIB_CONFIG_TABLEDEFNAME).Connect, Len(";Database=") + 1) + ConfigDataPath = VBA.Mid$(db.TableDefs(ACLIB_CONFIG_TABLEDEFNAME).Connect, Len(";Database=") + 1) If ConfigDataPath <> ACLibConfigDatabaseFile Then With db.TableDefs(ACLIB_CONFIG_TABLEDEFNAME) .Connect = ";Database=" & ACLibConfigDatabaseFile @@ -339,9 +339,9 @@ Public Property Get ACLibConfigDirectory() As String Dim strPath As String - strPath = Environ("Appdata") & "\" & ACLIB_CONFIG_ROOTFOLDERNAME & "\" - If Len(Dir$(strPath, vbDirectory)) = 0 Then - MkDir strPath + strPath = VBA.Environ("Appdata") & "\" & ACLIB_CONFIG_ROOTFOLDERNAME & "\" + If VBA.Len(VBA.Dir$(strPath, vbDirectory)) = 0 Then + VBA.MkDir strPath End If ACLibConfigDirectory = strPath @@ -352,7 +352,7 @@ Private Property Get ACLibConfigDirectoryDepr() As String Dim strPath As String - strPath = Environ("Appdata") & "\" & ACLIB_CONFIG_ROOTFOLDERNAME_DEPR & "\" + strPath = VBA.Environ("Appdata") & "\" & ACLIB_CONFIG_ROOTFOLDERNAME_DEPR & "\" ACLibConfigDirectoryDepr = strPath @@ -373,8 +373,8 @@ Private Property Get ACLibConfigDatabaseFile() As String #End If strDbFileExt = CodeDb.Name - strDbFileExt = Mid$(strDbFileExt, InStrRev(strDbFileExt, ".")) - If Left$(strDbFileExt, 5) = ".accd" Then + strDbFileExt = VBA.Mid$(strDbFileExt, VBA.InStrRev(strDbFileExt, ".")) + If VBA.Left$(strDbFileExt, 5) = ".accd" Then strDbFileExt = ".accdu" Else strDbFileExt = ".mdt" @@ -382,17 +382,17 @@ Private Property Get ACLibConfigDatabaseFile() As String strDbFile = ACLibConfigDirectory & ACLIB_CONFIG_DATABASENAME & strDbFileExt ' Try transfer file from deprecated folder path: - If Len(Dir$(strDbFile)) = 0 Then + If VBA.Len(VBA.Dir$(strDbFile)) = 0 Then strDbFileDepr = ACLibConfigDirectoryDepr & ACLIB_CONFIG_DATABASENAME & strDbFileExt - If Len(Dir$(strDbFileDepr)) > 0 Then - FileCopy strDbFileDepr, strDbFile + If VBA.Len(VBA.Dir$(strDbFileDepr)) > 0 Then + VBA.FileCopy strDbFileDepr, strDbFile End If End If - If Len(Dir$(strDbFile)) = 0 Then + If VBA.Len(VBA.Dir$(strDbFile)) = 0 Then 'Datenbank anlegen - If CodeDb.Version = "4.0" Then + If Application.CodeDb.Version = "4.0" Then Set db = DBEngine.CreateDatabase(strDbFile, dbLangGeneral, dbVersion40) Else Set db = DBEngine.CreateDatabase(strDbFile, dbLangGeneral) diff --git a/access-add-in/source/modules/AccUnitConfiguration.cls b/access-add-in/source/modules/AccUnitConfiguration.cls index dba831f..c021b0f 100644 --- a/access-add-in/source/modules/AccUnitConfiguration.cls +++ b/access-add-in/source/modules/AccUnitConfiguration.cls @@ -20,8 +20,6 @@ Option Explicit Private m_DaoSqlTools As SqlTools -Private Const EXTENSION_KEY As String = "AccUnitConfiguration" - #Const ADODB_EARLYBINDING = 0 'ADODB wird hier über Late binding eingesetzt, da es nur zum Erstellen der Tabelle genutzt wird @@ -36,58 +34,6 @@ Private m_PrivateRepositoryPath As String ' privates Verzeichnis (nicht in CodeL Private m_ImportTestDefaultValue As Long Private m_ACLibPropertyDb As DAO.Database -'--------------------------------------------------------------------------------------- -' Standard-Initialisierung von Erweiterungen -'--------------------------------------------------------------------------------------- - -Private WithEvents m_ApplicationHandler As ApplicationHandler -Attribute m_ApplicationHandler.VB_VarHelpID = -1 - -Public Property Set ApplicationHandlerRef(ByRef ObjRef As ApplicationHandler) - Set m_ApplicationHandler = ObjRef -End Property - -Public Property Get ExtensionKey() As String - ExtensionKey = EXTENSION_KEY -End Property - -'--------------------------------------------------------------------------------------- -' Standard-Ereignisbehandlung von Erweiterungen -'--------------------------------------------------------------------------------------- - -' CheckExtension -Private Sub m_ApplicationHandler_CheckExtension(ByVal ExtensionKeyToCheck As String, ByRef Exists As Boolean) - If ExtensionKeyToCheck = EXTENSION_KEY Then Exists = True -End Sub - -' ExtensionLookup -Private Sub m_ApplicationHandler_ExtensionLookup(ByVal ExtensionKeyToCheck As String, ByRef ExtensionReference As Object) - If ExtensionKeyToCheck = EXTENSION_KEY Then - Set ExtensionReference = Me - End If -End Sub - -'ExtensionPropertyLookup -Private Sub m_ApplicationHandler_ExtensionPropertyLookup( _ - ByVal ExtensionKeyToCheck As String, ByVal PropertyName As String, _ - ByRef ResumeMode As ApplicationHandlerResumeModes, ByRef ResumeMessage As Variant) - If ExtensionKeyToCheck = EXTENSION_KEY Then - GetExtensionPropertyLookup PropertyName, ResumeMode, ResumeMessage - End If -End Sub - -' AfterDispose -Private Sub m_ApplicationHandler_AfterDispose(ByRef ResumeMode As ApplicationHandlerResumeModes, ByRef ResumeMessage As Variant) -'=> Referenz in m_ApplicationHandler auf Nothing setzen - Set m_ApplicationHandler = Nothing -End Sub - - -'--------------------------------------------------------------------------------------- -' Ergänzungen für Erweiterung: AccUnitConfiguration -'--------------------------------------------------------------------------------------- - - Public Property Get ACLibConfig() As ACLibConfiguration If m_ACLibConfig Is Nothing Then Set m_ACLibConfig = New ACLibConfiguration @@ -95,21 +41,6 @@ Public Property Get ACLibConfig() As ACLibConfiguration Set ACLibConfig = m_ACLibConfig End Property -Private Sub GetExtensionPropertyLookup(ByVal PropertyName As String, ByRef ResumeMode As ApplicationHandlerResumeModes, ByRef ResumeMessage As Variant) - - ResumeMode = AppResumeMode_Completed - - Select Case PropertyName - Case PROPNAME_ACCUNITDLLPATH - ResumeMessage = AccUnitDllPath - - Case Else 'Property wurde nicht erkannt - ResumeMode = AppResumeMode_Error - - End Select - -End Sub - Public Property Get AccUnitDllPathPropertyName() As String AccUnitDllPathPropertyName = PROPNAME_ACCUNITDLLPATH End Property diff --git a/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas b/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas index 5ccfb24..e2888e1 100644 --- a/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas +++ b/access-add-in/source/modules/AccUnitLoaderConfigProcedures.bas @@ -2,16 +2,19 @@ Option Explicit Option Compare Text -' Integrierte Erweiterungen -Private Const EXTENSION_KEY_AccUnitConfiguration As String = "AccUnitConfiguration" +#Const AccUnitEarlyBinding = 0 +#If AccUnitEarlyBinding Then Public Property Get CurrentAccUnitConfiguration() As AccUnitConfiguration - Set CurrentAccUnitConfiguration = CurrentApplication.Extensions(EXTENSION_KEY_AccUnitConfiguration) +#Else +Public Property Get CurrentAccUnitConfiguration() As Object +#End If + Set CurrentAccUnitConfiguration = New AccUnitConfiguration End Property Public Sub AddAccUnitTlbReference() RemoveAccUnitTlbReference - CurrentVbProject.References.AddFromFile CurrentAccUnitConfiguration.AccUnitDllPath & "\AccessCodeLib.AccUnit.tlb" + modVbProject.CurrentVbProject.References.AddFromFile CurrentAccUnitConfiguration.AccUnitDllPath & "\AccessCodeLib.AccUnit.tlb" End Sub Public Sub RemoveAccUnitTlbReference() @@ -19,7 +22,7 @@ Public Sub RemoveAccUnitTlbReference() Dim ref As VBIDE.Reference Dim RefName As String - With CurrentVbProject + With modVbProject.CurrentVbProject For Each ref In .References On Error Resume Next RefName = ref.Name @@ -39,13 +42,17 @@ End Sub Public Sub InsertFactoryModule() +#If AccUnitEarlyBinding Then Dim Configurator As AccUnit.Configurator +#Else + Dim Configurator As Object +#End If With New AccUnitLoaderFactory Set Configurator = .Configurator End With - Configurator.InsertAccUnitLoaderFactoryModule AccUnitTlbReferenceExists, True, CurrentVbProject, Application + Configurator.InsertAccUnitLoaderFactoryModule AccUnitTlbReferenceExists, True, modVbProject.CurrentVbProject, Application Set Configurator = Nothing On Error Resume Next @@ -58,7 +65,7 @@ Private Function AccUnitTlbReferenceExists() As Boolean Dim ref As VBIDE.Reference Dim RefName As String - For Each ref In CurrentVbProject.References + For Each ref In modVbProject.CurrentVbProject.References On Error Resume Next RefName = ref.Name If Err.Number <> 0 Then @@ -76,13 +83,17 @@ End Function Public Sub ImportTestClasses() +#If AccUnitEarlyBinding Then Dim Configurator As AccUnit.Configurator +#Else + Dim Configurator As Object +#End If With New AccUnitLoaderFactory Set Configurator = .Configurator End With - Configurator.InsertAccUnitLoaderFactoryModule AccUnitTlbReferenceExists, False, CurrentVbProject, Application + Configurator.InsertAccUnitLoaderFactoryModule AccUnitTlbReferenceExists, False, modVbProject.CurrentVbProject, Application Configurator.ImportTestClasses Set Configurator = Nothing @@ -93,7 +104,11 @@ End Sub Public Sub ExportTestClasses() +#If AccUnitEarlyBinding Then Dim Configurator As AccUnit.Configurator +#Else + Dim Configurator As Object +#End If With New AccUnitLoaderFactory Set Configurator = .Configurator @@ -106,13 +121,17 @@ End Sub Public Sub RemoveTestEnvironment(ByVal RemoveTestModules As Boolean, Optional ByVal SaveTestModules As Boolean = True) +#If AccUnitEarlyBinding Then Dim Configurator As AccUnit.Configurator +#Else + Dim Configurator As Object +#End If With New AccUnitLoaderFactory Set Configurator = .Configurator End With - Configurator.RemoveTestEnvironment RemoveTestModules, SaveTestModules, CurrentVbProject + Configurator.RemoveTestEnvironment RemoveTestModules, SaveTestModules, modVbProject.CurrentVbProject Set Configurator = Nothing On Error Resume Next @@ -140,7 +159,7 @@ On Error GoTo HandleErr DllPath = CurrentAccUnitConfiguration.AccUnitDllPath - With CurrentApplication.Extensions("AppFile") + With modApplication.CurrentApplication.Extensions("AppFile") For Each accFileName In AccUnitFileNames .CreateAppFile accFileName, DllPath & accFileName Next @@ -164,54 +183,49 @@ Public Sub ImportAccUnitFiles() DllPath = CurrentAccUnitConfiguration.AccUnitDllPath - With CurrentApplication.Extensions("AppFile") + With modApplication.CurrentApplication.Extensions("AppFile") For Each accFileName In AccUnitFileNames .SaveAppFile accFileName, DllPath & accFileName, True Next End With End Sub -' -'Private Function GetCurrentVbaBitSystem() As Long -' -'#If VBA7 Then -'#If Win64 Then -' GetCurrentVbaBitSystem = 64 -'#Else -' GetCurrentVbaBitSystem = 32 -'#End If -'#Else -' GetCurrentVbaBitSystem = 32 -'#End If -' -'End Sub Public Function AutomatedTestRunVCS() As Variant Dim ResultMessage As String Dim Success As Boolean - Success = AutomatedTestRun(ResultMessage) + Success = AutomatedTestRun(ResultMessage, TestReportOutput.DebugPrint + TestReportOutput.MsAccessVCS, False) If Success Then AutomatedTestRunVCS = "Success: " & ResultMessage Else - AutomatedTestRunVCS = "Alert: " & ResultMessage + AutomatedTestRunVCS = "Failed: " & ResultMessage End If End Function -Public Function AutomatedTestRun(Optional ByRef ResultMessage As String) As Boolean +Public Function AutomatedTestRun(Optional ByRef ResultMessage As String, _ + Optional ByVal TestReportOutputTo As TestReportOutput = TestReportOutput.LogFile + TestReportOutput.DebugPrint, _ + Optional ByVal SetFocusToImmediateWindowBeforeTestStart As Boolean = True) As Boolean Dim Success As Boolean + +#If AccUnitEarlyBinding Then Dim TestSummary As AccUnit.ITestSummary +#Else + Dim TestSummary As Object +#End If AddAccUnitTlbReference InsertFactoryModule ImportTestClasses - SetFocusToImmediateWindow + If SetFocusToImmediateWindowBeforeTestStart Then + SetFocusToImmediateWindow + End If - Set TestSummary = GetAccUnitFactory.TestSuite(LogFile + DebugPrint).AddFromVBProject.Run.Summary + Set TestSummary = AccUnitLoaderFactoryCall.GetAccUnitFactory.TestSuite(TestReportOutputTo).AddFromVBProject.Run.Summary Success = TestSummary.Success RemoveTestEnvironment True @@ -231,7 +245,7 @@ End Function Private Sub SetFocusToImmediateWindow() Dim VbeWin As VBIDE.Window For Each VbeWin In Application.VBE.Windows - If VbeWin.Type = vbext_wt_Immediate Then + If VbeWin.Type = VBIDE.vbext_WindowType.vbext_wt_Immediate Then If Not VbeWin.Visible Then VbeWin.Visible = True End If diff --git a/access-add-in/source/modules/AccUnitLoaderFactory.cls b/access-add-in/source/modules/AccUnitLoaderFactory.cls index 435d7dd..e76f920 100644 --- a/access-add-in/source/modules/AccUnitLoaderFactory.cls +++ b/access-add-in/source/modules/AccUnitLoaderFactory.cls @@ -20,11 +20,6 @@ Option Explicit Private m_AccUnitFactory As Object Private m_MatchResultCollector As Object -Public Enum TestReportOutput - DebugPrint = 1 - LogFile = 2 -End Enum - Private Sub Class_Initialize() ' End Sub @@ -42,7 +37,7 @@ On Error Resume Next End Sub -Private Property Get AccUnitFactory() As AccUnit.AccUnitFactory +Private Property Get AccUnitFactory() As Object 'AccUnit.AccUnitFactory If m_AccUnitFactory Is Nothing Then InitAccUnitFactory End If @@ -133,6 +128,10 @@ Private Sub AppendTestResultReporter(ByVal TestSuite As TestSuite, ByVal TestRep TestSuite.AppendTestResultReporter New LogFileTestResultReporter End If + If (TestReportOutputTo And TestReportOutput.MsAccessVCS) = TestReportOutput.MsAccessVCS Then + TestSuite.AppendTestResultReporter New MsAccessVcsTestResultReporter + End If + End Sub Public Property Get CodeCoverageTracker() As Object 'AccUnit.CodeCoverageTracker diff --git a/access-add-in/source/modules/AccUnitLoaderFactoryCall.bas b/access-add-in/source/modules/AccUnitLoaderFactoryCall.bas index f3cd7c2..7c9a315 100644 --- a/access-add-in/source/modules/AccUnitLoaderFactoryCall.bas +++ b/access-add-in/source/modules/AccUnitLoaderFactoryCall.bas @@ -6,6 +6,6 @@ Option Compare Text Option Explicit Public Function GetAccUnitFactory() As AccUnitLoaderFactory - CheckAccUnitTypeLibFile CodeVBProject + modTypeLibCheck.CheckAccUnitTypeLibFile modVbProject.CodeVBProject Set GetAccUnitFactory = New AccUnitLoaderFactory End Function diff --git a/access-add-in/source/modules/MsAccessVcsTestResultReporter.cls b/access-add-in/source/modules/MsAccessVcsTestResultReporter.cls new file mode 100644 index 0000000..01118b5 --- /dev/null +++ b/access-add-in/source/modules/MsAccessVcsTestResultReporter.cls @@ -0,0 +1,173 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "MsAccessVcsTestResultReporter" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Class: LogFileTestResultReporter +'--------------------------------------------------------------------------------------- +' +' Output test results to log file (text file) +' +'--------------------------------------------------------------------------------------- +Option Compare Text +Option Explicit + +Private Const LineSeperatorLen As Long = 40 +Private Const MsAccessVcsAddInFileName As String = "Version Control" + +Implements AccUnit.ITestResultReporter +Private m_VCS As Object + +Private WithEvents m_TestResultCollector As AccUnit.TestResultCollector +Attribute m_TestResultCollector.VB_VarHelpID = -1 + +Private Sub Class_Terminate() + Set m_VCS = Nothing +End Sub + +Private Property Get ITestResultReporter_TestResultCollector() As AccUnit.ITestResultCollector + Set ITestResultReporter_TestResultCollector = m_TestResultCollector +End Property + +Private Property Set ITestResultReporter_TestResultCollector(ByVal TestResultCollectorToListen As ITestResultCollector) + Set TestResultCollector = TestResultCollectorToListen +End Property + +Private Property Set TestResultCollector(ByVal TestResultCollectorToListen As TestResultCollector) + Set m_TestResultCollector = TestResultCollectorToListen +End Property + +Private Sub m_TestResultCollector_TestSuiteStarted(ByVal TestSuite As AccUnit.ITestSuite) + PrintToFile String(LineSeperatorLen, "#") + PrintToFile Format(Now(), "yyyy-mm-dd hh:nn:ss") +End Sub + +Private Sub m_TestResultCollector_TestTraceMessage(ByVal Message As String, ByVal CodeCoverageTracker As AccUnit.ICodeCoverageTracker) +' +End Sub + +Private Sub m_TestResultCollector_NewTestResult(ByVal Result As AccUnit.ITestResult) +' +End Sub + +Private Sub m_TestResultCollector_TestSuiteFinished(ByVal TestSummary As AccUnit.ITestSummary) + PrintSummary TestSummary, True + PrintToFile String(LineSeperatorLen, "#") +End Sub + +Private Sub m_TestResultCollector_PrintSummary(ByVal TestSummary As AccUnit.ITestSummary, ByVal PrintTestResults As Boolean) + PrintSummary TestSummary, PrintTestResults +End Sub + +Private Sub PrintSummary(ByVal TestSummary As AccUnit.ITestSummary, ByVal PrintTestResults As Boolean) + + If PrintTestResults Then + PrintToFile String(LineSeperatorLen, "-") + PrintTestDetailSummary TestSummary.GetTestResults + End If + PrintToFile String(LineSeperatorLen, "-") + PrintToFile "Tests: " & TestSummary.Total + PrintToFile " ", "Passed: " & TestSummary.Passed + PrintToFile " ", "Failed: " & TestSummary.Failed + PrintToFile " ", "Ignored: " & TestSummary.Ignored + PrintToFile String(LineSeperatorLen, "-") + + If TestSummary.Failed + TestSummary.Error > 0 Then + PrintToFile (TestSummary.Failed + TestSummary.Error) & " / " & TestSummary.Total & " failed" + ElseIf TestSummary.Passed = TestSummary.Total Then + PrintToFile (TestSummary.Passed) & " / " & TestSummary.Total & " passed" + Else + PrintToFile (TestSummary.Ignored) & " / " & TestSummary.Total & " ignored" + End If + + PrintToFile String(LineSeperatorLen, "-") + +End Sub + +Private Sub PrintTestDetailSummary(ByRef TestResults() As AccUnit.ITestResult) + + Dim i As Long + Dim r As Variant 'AccUnit.ITestResult + Dim LastTestIsRowTest As Boolean + + For Each r In TestResults + 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 String(3, " ") & String(17, "-") + PrintSubResults i, r + LastTestIsRowTest = True + Else + If LastTestIsRowTest Then + LastTestIsRowTest = False + If i > 1 Then PrintToFile String(20, "-") + End If + PrintToFile CStr(i), r.Test.FullName & ":", r.Result, r.Message + End If + Next + +End Sub + +Private Sub PrintSubResults(ByVal mainId As String, ByVal resultCol As AccUnit.TestResultCollection) + + Dim i As Long + Dim r As AccUnit.ITestResult + Dim ResultID As String + + For i = 1 To resultCol.Count + 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, "..." + PrintSubResults ResultID, r + Else + PrintToFile String(3, " ") & ResultID, r.Test.FullName, r.Result, r.Message + End If + Next + +End Sub + +Private Sub PrintToFile(ParamArray LogItems()) + + Dim LineString As String + Dim i As Long + + LineString = LogItems(LBound(LogItems)) + For i = LBound(LogItems) + 1 To UBound(LogItems) + LineString = LineString & vbTab & LogItems(i) + Next + + If m_VCS Is Nothing Then + InitVcs + End If + +'Interface: +'Public Sub AddLog(strText As String, Optional blnPrint As Boolean = True, _ +' Optional blnNextOutputOnNewLine As Boolean = True, _ +' Optional strColor As String = vbNullString, _ +' Optional blnBold As Boolean = False, _ +' Optional blnItalic As Boolean = False) +' + m_VCS.AddLog LineString, False + +End Sub + +Private Sub InitVcs() + Dim VcsRef As Object + Set m_VCS = Application.Run(GetVcsAddInRunPath & ".VCS") +End Sub + +Private Function GetVcsAddInRunPath() As String + + Dim AddInPath As String + AddInPath = Environ("appdata") & "\MsAccessVCS\" + + GetVcsAddInRunPath = AddInPath & MsAccessVcsAddInFileName + +End Function diff --git a/access-add-in/source/modules/_config_Application.bas b/access-add-in/source/modules/_config_Application.bas index d158b1a..0a89fe5 100644 --- a/access-add-in/source/modules/_config_Application.bas +++ b/access-add-in/source/modules/_config_Application.bas @@ -18,7 +18,7 @@ Option Compare Text Option Explicit 'Version number -Private Const APPLICATION_VERSION As String = "0.9.402.240323" +Private Const APPLICATION_VERSION As String = "0.9.601.240326" Private Const APPLICATION_NAME As String = "ACLib AccUnit Loader" Private Const APPLICATION_FULLNAME As String = "Access Code Library - AccUnit Loader" @@ -29,7 +29,7 @@ Public Const ACCUNIT_DLL_FILE As String = "AccessCodeLib.AccUnit.dll" Private Const APPLICATION_STARTFORMNAME As String = "AccUnitLoaderForm" -Private m_Extensions As ApplicationHandler_ExtensionCollection +Private m_Extensions As Object 'ApplicationHandler_ExtensionCollection '--------------------------------------------------------------------------------------- ' Sub: InitConfig @@ -44,7 +44,7 @@ Private m_Extensions As ApplicationHandler_ExtensionCollection ' '**/ '--------------------------------------------------------------------------------------- -Public Sub InitConfig(Optional ByRef CurrentAppHandlerRef As ApplicationHandler = Nothing) +Public Sub InitConfig(Optional ByRef CurrentAppHandlerRef As Object = Nothing) '---------------------------------------------------------------------------- ' Globale Variablen einstellen @@ -55,13 +55,13 @@ Public Sub InitConfig(Optional ByRef CurrentAppHandlerRef As ApplicationHandler ' Anwendungsinstanz einstellen ' If CurrentAppHandlerRef Is Nothing Then - Set CurrentAppHandlerRef = CurrentApplication + Set CurrentAppHandlerRef = modApplication.CurrentApplication End If With CurrentAppHandlerRef 'Zur Sicherheit AccDb einstellen - Set .AppDb = CodeDb 'muss auf CodeDb zeigen, + Set .AppDb = Application.CodeDb 'muss auf CodeDb zeigen, 'da diese Anwendung als Add-In verwendet wird 'Anwendungsname @@ -84,7 +84,6 @@ Public Sub InitConfig(Optional ByRef CurrentAppHandlerRef As ApplicationHandler With m_Extensions Set .ApplicationHandler = CurrentAppHandlerRef .Add New ApplicationHandler_AppFile - .Add New AccUnitConfiguration End With End Sub @@ -103,8 +102,8 @@ Private Sub SetAppFiles() Dim accFileName As Variant ' Call CurrentApplication.Extensions("AppFile").SaveAppFile("AppIcon", CodeProject.Path & "\" & APPLICATION_ICONFILE) - With CurrentApplication.Extensions("AppFile") - For Each accFileName In AccUnitFileNames + With modApplication.CurrentApplication.Extensions("AppFile") + For Each accFileName In AccUnitLoaderConfigProcedures.AccUnitFileNames .SaveAppFile accFileName, CodeProject.Path & "\lib\" & accFileName, True Next End With @@ -112,17 +111,17 @@ Private Sub SetAppFiles() End Sub Public Sub PrepareForVCS() - If TableDefExists("ACLib_ConfigTable") Then - CurrentDb.TableDefs.Delete "ACLib_ConfigTable" + If DaoTools.TableDefExists("ACLib_ConfigTable") Then + Application.CurrentDb.TableDefs.Delete "ACLib_ConfigTable" Application.RefreshDatabaseWindow End If - RemoveAccUnitTlbReference + AccUnitLoaderConfigProcedures.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 +'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/defGlobal_AccUnitLoader.bas b/access-add-in/source/modules/defGlobal_AccUnitLoader.bas index 8cc79a4..b9a70ce 100644 --- a/access-add-in/source/modules/defGlobal_AccUnitLoader.bas +++ b/access-add-in/source/modules/defGlobal_AccUnitLoader.bas @@ -5,6 +5,12 @@ Option Compare Text Option Explicit +Public Enum TestReportOutput + DebugPrint = 1 + LogFile = 2 + MsAccessVCS = 1024 +End Enum + Public Enum CodeLibElementType 'angelehnt an Enum vbext_ComponentType clet_StdModule = 1 ' = vbext_ComponentType.vbext_ct_StdModule clet_ClassModule = 2 ' = vbext_ComponentType.vbext_ct_ClassModule diff --git a/access-add-in/source/modules/modTypeLibCheck.bas b/access-add-in/source/modules/modTypeLibCheck.bas index 0f316eb..a3380d6 100644 --- a/access-add-in/source/modules/modTypeLibCheck.bas +++ b/access-add-in/source/modules/modTypeLibCheck.bas @@ -10,13 +10,11 @@ Option Compare Text Option Explicit Option Private Module -#Const EARLYBINDING = 1 - Private Const EXTENSION_KEY_APPFILE As String = "AppFile" Public Property Get DefaultAccUnitLibFolder() As String Dim FilePath As String - FilePath = CodeVBProject.FileName + FilePath = modVbProject.CodeVBProject.FileName FilePath = VBA.Left(FilePath, VBA.InStrRev(FilePath, "\")) DefaultAccUnitLibFolder = FilePath & "lib" End Property @@ -31,10 +29,11 @@ Public Sub CheckAccUnitTypeLibFile(Optional ByVal VBProjectRef As VBProject = No Dim FileFixed As Boolean If VBProjectRef Is Nothing Then - Set VBProjectRef = CodeVBProject + Set VBProjectRef = modVbProject.CodeVBProject End If - LibPath = GetAccUnitLibPath(True) + LibPath = modTypeLibCheck.GetAccUnitLibPath(True) + 'LibPath = modTypeLibCheck.DefaultAccUnitLibFolder LibFile = LibPath & ACCUNIT_TYPELIB_FILE FileTools.CreateDirectory LibPath @@ -71,14 +70,15 @@ Private Function GetAccUnitLibPath(Optional ByVal BackSlashAtEnd As Boolean = Fa Dim LibPath As String Dim LibFile As String - With CurrentAccUnitConfiguration + 'With AccUnitLoaderConfigProcedures.CurrentAccUnitConfiguration + With New AccUnitConfiguration On Error GoTo ErrMissingPath LibPath = .AccUnitDllPath On Error GoTo 0 End With If VBA.Len(LibPath) = 0 Then - LibPath = DefaultAccUnitLibFolder + LibPath = modTypeLibCheck.DefaultAccUnitLibFolder End If If BackSlashAtEnd Then diff --git a/access-add-in/source/modules/modVbProject.bas b/access-add-in/source/modules/modVbProject.bas index d9a593d..942c8ee 100644 --- a/access-add-in/source/modules/modVbProject.bas +++ b/access-add-in/source/modules/modVbProject.bas @@ -21,7 +21,7 @@ Option Compare Text Option Explicit Option Private Module -#Const EARLYBINDING = 1 +#Const EARLYBINDING = 0 Private m_CurrentVbProject As Object @@ -76,7 +76,7 @@ Public Property Get CodeVBProject() As Object Set objCodeVbProject = VBE.ActiveVBProject 'Prüfen, ob das richtige VbProject gewählt wurde (muss das von CodeDb sein) - strCodeDbName = UncPath(CodeDb.Name) + strCodeDbName = FileTools.UncPath(CodeDb.Name) If objCodeVbProject.FileName <> strCodeDbName Then Set objCodeVbProject = Nothing For Each Proj In VBE.VBProjects