v1.8.3: New codemodules from CodeLib (#3)

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
 

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

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,23 +47,68 @@ 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
 
 '---------------------------------------------------------------------------------------
 ' Property: RevisionString
 '---------------------------------------------------------------------------------------
 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
 

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)

source/codelib/data/SqlTools.cls

@@ -10,6 +10,7 @@ Attribute VB_Exposed = False
 '---------------------------------------------------------------------------------------
 ' Class: data.sql.SqlTools
 '---------------------------------------------------------------------------------------
+'
 ' Functions to build sql strings
 '
 ' Author:

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