diff --git a/access-add-in/ACLibFilterFormWizard.accda b/access-add-in/ACLibFilterFormWizard.accda index 707ab62..aa0a39b 100644 Binary files a/access-add-in/ACLibFilterFormWizard.accda and b/access-add-in/ACLibFilterFormWizard.accda differ diff --git a/source/FilterStringBuilderCodeBuilder.cls b/source/FilterStringBuilderCodeBuilder.cls index 6336cd4..94b0e3a 100644 --- a/source/FilterStringBuilderCodeBuilder.cls +++ b/source/FilterStringBuilderCodeBuilder.cls @@ -104,8 +104,8 @@ Private Function GetRemoveFilterCode(ByVal ApplyFilterCtlName As String, ByVal F Code = "Private Sub RemoveFilter()" & vbNewLine & _ " RemoveFilterValues" & vbNewLine & _ - "' ApplyFilter ""0=1"" ' " & L10n.Text("Anzeige leeren, keine Datensätze anzeigen") & vbNewLine & _ - " ApplyFilter vbNullString ' " & L10n.Text("Alle Datensätze anzeigen") & vbNewLine + "' ApplyFilter ""0=1"" ' " & L10n.Text("Don't show records") & vbNewLine & _ + " ApplyFilter vbNullString ' " & L10n.Text("Show all records") & vbNewLine If Len(ApplyFilterCtlName) > 0 Then Code = Code & _ @@ -145,7 +145,7 @@ Private Function GetGetFilterControlsCode(ByVal FilterControlNames As StringColl Code = "Private Function GetFilterControls() As Collection" & vbNewLine & _ " Dim fctlCol As Collection" & vbNewLine & vbNewLine & _ " Set fctlCol = New Collection" & vbNewLine & _ - " '" & L10n.Text("Filter-Steuerelemente anfügen:") & vbNewLine + " '" & L10n.Text("Add filter controls") & ":" & vbNewLine Code = Code & FilterControlNames.ToString(vbNewLine, " fctlCol.Add Me.", , True) & vbNewLine diff --git a/source/_config_Application.bas b/source/_config_Application.bas index cc12fd6..5137fa6 100644 --- a/source/_config_Application.bas +++ b/source/_config_Application.bas @@ -31,7 +31,7 @@ Option Explicit Option Private Module 'Version -Private Const APPLICATION_VERSION As String = "1.8.2" '2023-10 +Private Const APPLICATION_VERSION As String = "1.8.3" '2024-01 #Const USE_CLASS_APPLICATIONHANDLER_APPFILE = 1 #Const USE_CLASS_APPLICATIONHANDLER_VERSION = 1 diff --git a/source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls b/source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls index 97ff63d..61acbc9 100644 --- a/source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls +++ b/source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls @@ -5,7 +5,7 @@ END Attribute VB_Name = "ACLibGitHubImporter" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False +Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '--------------------------------------------------------------------------------------- ' Class: _codelib.addins.shared.ACLibGitHubImporter @@ -28,11 +28,15 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit -Private Const GitHubContentBaseUrl As String = "https://raw.githubusercontent.com/AccessCodeLib/AccessCodeLib/{branch}/{path}" -Private Const GitHubApiBaseUrl As String = "https://api.github.com/repos/AccessCodeLib/AccessCodeLib/" +Private Const GitHubContentBaseUrl As String = "https://raw.githubusercontent.com/{owner}/{repo}/{branch}/{path}" +Private Const GitHubApiBaseUrl As String = "https://api.github.com/repos/{owner}/{repo}/" +Private m_GitHubApiAuthorizationToken As String Private m_LastCommit As Date -Private m_UseDraftBranch As Boolean + +Private m_RepositoryOwner As String +Private m_RepositoryName As String +Private m_BranchName As String #If VBA7 Then Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long @@ -43,14 +47,59 @@ Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFile #End If '--------------------------------------------------------------------------------------- -' Property: UseDraftBranch +' Property: GitHubAuthorizationubAuthToken +'--------------------------------------------------------------------------------------- +Public Property Get GitHubApiAuthorizationToken() As String + GitHubApiAuthorizationToken = m_GitHubApiAuthorizationToken +End Property + +Public Property Let GitHubApiAuthorizationToken(ByVal NewValue As String) + m_GitHubApiAuthorizationToken = NewValue +End Property + +'--------------------------------------------------------------------------------------- +' Property: RepositoryOwner '--------------------------------------------------------------------------------------- -Public Property Get UseDraftBranch() As Boolean - UseDraftBranch = m_UseDraftBranch +Public Property Get RepositoryOwner() As String + If Len(m_RepositoryOwner) > 0 Then + RepositoryOwner = m_RepositoryOwner + Else ' Default: AccessCodeLib + RepositoryOwner = "AccessCodeLib" + End If End Property -Public Property Let UseDraftBranch(ByVal NewValue As Boolean) - m_UseDraftBranch = NewValue +Public Property Let RepositoryOwner(ByVal NewValue As String) + m_RepositoryOwner = NewValue +End Property + +'--------------------------------------------------------------------------------------- +' Property: RepositoryName +'--------------------------------------------------------------------------------------- +Public Property Get RepositoryName() As String + If Len(m_RepositoryName) > 0 Then + RepositoryName = m_RepositoryName + Else ' Default: AccessCodeLib + RepositoryName = "AccessCodeLib" + End If +End Property + +Public Property Let RepositoryName(ByVal NewValue As String) + m_RepositoryName = NewValue +End Property + +'--------------------------------------------------------------------------------------- +' Property: BranchName +'--------------------------------------------------------------------------------------- +Public Property Get BranchName() As String + If Len(m_BranchName) > 0 Then + BranchName = m_BranchName + Else ' Default: master + BranchName = "master" + End If +End Property + +Public Property Let BranchName(ByVal NewValue As String) + m_BranchName = NewValue End Property '--------------------------------------------------------------------------------------- @@ -58,8 +107,8 @@ End Property '--------------------------------------------------------------------------------------- Public Property Get RevisionString(Optional ByVal Requery As Boolean = False) As String RevisionString = Format(LastCommit, "yyyymmddhhnnss") - If UseDraftBranch Then - RevisionString = RevisionString & "-draft" + If BranchName <> "master" Then + RevisionString = RevisionString & "-" & BranchName End If End Property @@ -104,25 +153,39 @@ End Sub Private Sub UpdateCodeModuleInTable(ByVal ModuleName As String, ByVal ACLibPath As String, Optional ByVal Requery As Boolean = False) Dim TempFile As String - Dim DownLoadUrl As String - Dim BranchName As String - TempFile = FileTools.TempPath & ModuleName & FileTools.GetFileExtension(ACLibPath, True) - If UseDraftBranch Then - BranchName = "draft" - Else - BranchName = "master" - End If - DownLoadUrl = Replace(GitHubContentBaseUrl, "{branch}", BranchName) - DownLoadUrl = Replace(DownLoadUrl, "{path}", ACLibPath) + TempFile = FileTools.TempPath & ModuleName & FileTools.GetFileExtension(ACLibPath, True) + DownloadACLibFileFromWeb ACLibPath, TempFile - DownloadFileFromWeb DownLoadUrl, TempFile CurrentApplication.SaveAppFile ModuleName, TempFile, False, "SccRev", Me.RevisionString(Requery) Kill TempFile End Sub +Friend Sub DownloadACLibFileFromWeb(ByVal ACLibPath As String, ByVal TargetFilePath As String) + + Dim DownLoadUrl As String + + DownLoadUrl = FillRepositoryData(GitHubContentBaseUrl) + DownLoadUrl = Replace(DownLoadUrl, "{path}", ACLibPath) + + DownloadFileFromWeb DownLoadUrl, TargetFilePath + +End Sub + +Private Function FillRepositoryData(ByVal StringWithPlaceHolder As String) As String + + Dim TempValue As String + + TempValue = Replace(StringWithPlaceHolder, "{owner}", RepositoryOwner) + TempValue = Replace(TempValue, "{repo}", RepositoryName) + TempValue = Replace(TempValue, "{branch}", BranchName) + + FillRepositoryData = TempValue + +End Function + Private Function GetLastCommitFromWeb() As Date 'alternative: git rev-list HEAD --count @@ -131,14 +194,9 @@ Private Function GetLastCommitFromWeb() As Date Dim CommitUrl As String Dim LastCommitInfo As String - CommitUrl = GitHubApiBaseUrl & "commits/" - - If UseDraftBranch Then - CommitUrl = CommitUrl & "draft" - Else - CommitUrl = CommitUrl & "master" - End If + CommitUrl = FillRepositoryData(GitHubApiBaseUrl) & "commits/" & BranchName + Const RevisionTag As String = "Revision " Dim JsonString As String @@ -154,23 +212,31 @@ Private Function GetLastCommitFromWeb() As Date End Function -Private Function GetJsonString(ByVal ApiUrl As String) As String - - Dim ApiResponse As String - Dim json As Object - - Dim xml As Object ' MSXML2.XMLHTTP60 - Set xml = CreateObject("MSXML2.XMLHTTP.6.0") - - xml.Open "GET", ApiUrl, False - xml.setRequestHeader "Content-type", "application/json" - xml.send - While xml.ReadyState <> 4 - DoEvents - Wend - ApiResponse = xml.responseText - - GetJsonString = ApiResponse +Friend Function GetJsonString(ByVal ApiUrl As String) As String + + Dim ApiResponse As String + Dim ApiAuthToken As String + Dim json As Object + Dim xml As Object 'MSXML2.XMLHTTP6 + + ApiUrl = FillRepositoryData(ApiUrl) + + ApiAuthToken = GitHubApiAuthorizationToken + + Set xml = CreateObject("MSXML2.XMLHTTP.6.0") + + xml.Open "GET", ApiUrl, False + If Len(ApiAuthToken) > 0 Then + xml.setRequestHeader "Authorization", ApiAuthToken + End If + xml.setRequestHeader "Content-type", "application/json" + xml.send + While xml.ReadyState <> 4 + DoEvents + Wend + ApiResponse = xml.responseText + + GetJsonString = ApiResponse End Function diff --git a/source/codelib/base/ApplicationHandler_AppFile.cls b/source/codelib/base/ApplicationHandler_AppFile.cls index f4c3baf..c6cdddf 100644 --- a/source/codelib/base/ApplicationHandler_AppFile.cls +++ b/source/codelib/base/ApplicationHandler_AppFile.cls @@ -134,13 +134,20 @@ End Property ' Boolean ' '--------------------------------------------------------------------------------------- -Public Function CreateAppFile(ByVal FileID As String, ByVal FileName As String) As Boolean +Public Function CreateAppFile(ByVal FileID As String, ByVal FileName As String, _ + Optional ByVal ExtFilterFieldName As String, Optional ExtFilterValue As Variant) As Boolean Dim Binfile() As Byte Dim FieldSize As Long Dim fld As DAO.Field + Dim SelectSql As String + + SelectSql = "select " & TABLE_FIELD_FILE & " from " & TABLE_APPFILES & " where " & TABLE_FIELD_ID & "='" & Replace(FileID, "'", "''") & "'" + If Len(ExtFilterFieldName) > 0 Then + SelectSql = SelectSql & " and " & ExtFilterFieldName & " = '" & Replace(ExtFilterValue, "'", "''") & "'" + End If - With CodeDb.OpenRecordset("select " & TABLE_FIELD_FILE & " from " & TABLE_APPFILES & " where " & TABLE_FIELD_ID & "='" & Replace(FileID, "'", "''") & "'") + With CodeDb.OpenRecordset(SelectSql) If Not .EOF Then Set fld = .Fields(0) diff --git a/source/codelib/data/SqlTools.cls b/source/codelib/data/SqlTools.cls index 14fb6ac..e29c4cf 100644 --- a/source/codelib/data/SqlTools.cls +++ b/source/codelib/data/SqlTools.cls @@ -10,6 +10,7 @@ Attribute VB_Exposed = False '--------------------------------------------------------------------------------------- ' Class: data.sql.SqlTools '--------------------------------------------------------------------------------------- +' ' Functions to build sql strings ' ' Author: diff --git a/source/codelib/text/StringCollection.cls b/source/codelib/text/StringCollection.cls index dda2bef..83b8d10 100644 --- a/source/codelib/text/StringCollection.cls +++ b/source/codelib/text/StringCollection.cls @@ -11,7 +11,7 @@ Attribute VB_Exposed = False ' Class: text.StringCollection '--------------------------------------------------------------------------------------- ' -' Collection-Funktionen für Strings +' Collection functions for strings ' ' Author: ' Josef Poetzl diff --git a/source/frmFilterFormWizard.frm b/source/frmFilterFormWizard.frm index 28d330d..f6a049e 100644 Binary files a/source/frmFilterFormWizard.frm and b/source/frmFilterFormWizard.frm differ