MsAccessVCS integration (#54)

* New TestResultReporter for MsAccessVCS

Author: josef-poetzl

access-add-in/AccUnitLoader.accda

@@ -26,6 +26,7 @@ Begin Form
         0x212b6fd80e9ce340
     End
     Caption ="ACLib - AccUnit Loader"
+    OnOpen ="[Event Procedure]"
     DatasheetFontName ="Calibri"
     OnTimer ="[Event Procedure]"
     OnLoad ="[Event Procedure]"

access-add-in/source/forms/AccUnitLoaderForm.bas

@@ -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

access-add-in/source/forms/AccUnitLoaderForm.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,23 +214,23 @@ 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)
 
 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,26 +373,26 @@ 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"
    End If
    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)

access-add-in/source/modules/ACLibConfiguration.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,80 +34,13 @@ 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
    End If
    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