Skip to content

Commit

Permalink
MsAccessVCS integration (#54)
Browse files Browse the repository at this point in the history
* New TestResultReporter for MsAccessVCS
  • Loading branch information
josef-poetzl authored Mar 26, 2024
1 parent ee4f0dd commit bc37507
Show file tree
Hide file tree
Showing 13 changed files with 296 additions and 168 deletions.
Binary file modified access-add-in/AccUnitLoader.accda
Binary file not shown.
1 change: 1 addition & 0 deletions access-add-in/source/forms/AccUnitLoaderForm.bas
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ Begin Form
0x212b6fd80e9ce340
End
Caption ="ACLib - AccUnit Loader"
OnOpen ="[Event Procedure]"
DatasheetFontName ="Calibri"
OnTimer ="[Event Procedure]"
OnLoad ="[Event Procedure]"
Expand Down
19 changes: 12 additions & 7 deletions access-add-in/source/forms/AccUnitLoaderForm.cls
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
54 changes: 27 additions & 27 deletions access-add-in/source/modules/ACLibConfiguration.cls
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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

Expand All @@ -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)
Expand Down
69 changes: 0 additions & 69 deletions access-add-in/source/modules/AccUnitConfiguration.cls
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down
Loading

0 comments on commit bc37507

Please sign in to comment.