Skip to content

Commit 4a8e6d0

Browse files
josef-poetzljosef-poetzl
authored
v1.8.3: New codemodules from CodeLib (#3)
1 parent 9a4c848 commit 4a8e6d0

8 files changed

+127
-53
lines changed

‎access-add-in/ACLibFilterFormWizard.accda

-4 KB
Binary file not shown.

‎source/FilterStringBuilderCodeBuilder.cls

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -104,8 +104,8 @@ Private Function GetRemoveFilterCode(ByVal ApplyFilterCtlName As String, ByVal F
104104

105105
Code = "Private Sub RemoveFilter()" & vbNewLine & _
106106
" RemoveFilterValues" & vbNewLine & _
107-
"' ApplyFilter ""0=1"" ' " & L10n.Text("Anzeige leeren, keine Datensätze anzeigen") & vbNewLine & _
108-
" ApplyFilter vbNullString ' " & L10n.Text("Alle Datensätze anzeigen") & vbNewLine
107+
"' ApplyFilter ""0=1"" ' " & L10n.Text("Don't show records") & vbNewLine & _
108+
" ApplyFilter vbNullString ' " & L10n.Text("Show all records") & vbNewLine
109109

110110
If Len(ApplyFilterCtlName) > 0 Then
111111
Code = Code & _
@@ -145,7 +145,7 @@ Private Function GetGetFilterControlsCode(ByVal FilterControlNames As StringColl
145145
Code = "Private Function GetFilterControls() As Collection" & vbNewLine & _
146146
" Dim fctlCol As Collection" & vbNewLine & vbNewLine & _
147147
" Set fctlCol = New Collection" & vbNewLine & _
148-
" '" & L10n.Text("Filter-Steuerelemente anfügen:") & vbNewLine
148+
" '" & L10n.Text("Add filter controls") & ":" & vbNewLine
149149

150150
Code = Code & FilterControlNames.ToString(vbNewLine, " fctlCol.Add Me.", , True) & vbNewLine
151151

‎source/_config_Application.bas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ Option Explicit
3131
Option Private Module
3232

3333
'Version
34-
Private Const APPLICATION_VERSION As String = "1.8.2" '2023-10
34+
Private Const APPLICATION_VERSION As String = "1.8.3" '2024-01
3535

3636
#Const USE_CLASS_APPLICATIONHANDLER_APPFILE = 1
3737
#Const USE_CLASS_APPLICATIONHANDLER_VERSION = 1

‎source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls

Lines changed: 112 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ END
55
Attribute VB_Name = "ACLibGitHubImporter"
66
Attribute VB_GlobalNameSpace = False
77
Attribute VB_Creatable = False
8-
Attribute VB_PredeclaredId = False
8+
Attribute VB_PredeclaredId = True
99
Attribute VB_Exposed = False
1010
'---------------------------------------------------------------------------------------
1111
' Class: _codelib.addins.shared.ACLibGitHubImporter
@@ -28,11 +28,15 @@ Attribute VB_Exposed = False
2828
Option Compare Database
2929
Option Explicit
3030

31-
Private Const GitHubContentBaseUrl As String = "https://raw.githubusercontent.com/AccessCodeLib/AccessCodeLib/{branch}/{path}"
32-
Private Const GitHubApiBaseUrl As String = "https://api.github.com/repos/AccessCodeLib/AccessCodeLib/"
31+
Private Const GitHubContentBaseUrl As String = "https://raw.githubusercontent.com/{owner}/{repo}/{branch}/{path}"
32+
Private Const GitHubApiBaseUrl As String = "https://api.github.com/repos/{owner}/{repo}/"
3333

34+
Private m_GitHubApiAuthorizationToken As String
3435
Private m_LastCommit As Date
35-
Private m_UseDraftBranch As Boolean
36+
37+
Private m_RepositoryOwner As String
38+
Private m_RepositoryName As String
39+
Private m_BranchName As String
3640

3741
#If VBA7 Then
3842
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
4347
#End If
4448

4549
'---------------------------------------------------------------------------------------
46-
' Property: UseDraftBranch
50+
' Property: GitHubAuthorizationubAuthToken
51+
'---------------------------------------------------------------------------------------
52+
Public Property Get GitHubApiAuthorizationToken() As String
53+
GitHubApiAuthorizationToken = m_GitHubApiAuthorizationToken
54+
End Property
55+
56+
Public Property Let GitHubApiAuthorizationToken(ByVal NewValue As String)
57+
m_GitHubApiAuthorizationToken = NewValue
58+
End Property
59+
60+
'---------------------------------------------------------------------------------------
61+
' Property: RepositoryOwner
4762
'---------------------------------------------------------------------------------------
48-
Public Property Get UseDraftBranch() As Boolean
49-
UseDraftBranch = m_UseDraftBranch
63+
Public Property Get RepositoryOwner() As String
64+
If Len(m_RepositoryOwner) > 0 Then
65+
RepositoryOwner = m_RepositoryOwner
66+
Else ' Default: AccessCodeLib
67+
RepositoryOwner = "AccessCodeLib"
68+
End If
5069
End Property
5170

52-
Public Property Let UseDraftBranch(ByVal NewValue As Boolean)
53-
m_UseDraftBranch = NewValue
71+
Public Property Let RepositoryOwner(ByVal NewValue As String)
72+
m_RepositoryOwner = NewValue
73+
End Property
74+
75+
'---------------------------------------------------------------------------------------
76+
' Property: RepositoryName
77+
'---------------------------------------------------------------------------------------
78+
Public Property Get RepositoryName() As String
79+
If Len(m_RepositoryName) > 0 Then
80+
RepositoryName = m_RepositoryName
81+
Else ' Default: AccessCodeLib
82+
RepositoryName = "AccessCodeLib"
83+
End If
84+
End Property
85+
86+
Public Property Let RepositoryName(ByVal NewValue As String)
87+
m_RepositoryName = NewValue
88+
End Property
89+
90+
'---------------------------------------------------------------------------------------
91+
' Property: BranchName
92+
'---------------------------------------------------------------------------------------
93+
Public Property Get BranchName() As String
94+
If Len(m_BranchName) > 0 Then
95+
BranchName = m_BranchName
96+
Else ' Default: master
97+
BranchName = "master"
98+
End If
99+
End Property
100+
101+
Public Property Let BranchName(ByVal NewValue As String)
102+
m_BranchName = NewValue
54103
End Property
55104

56105
'---------------------------------------------------------------------------------------
57106
' Property: RevisionString
58107
'---------------------------------------------------------------------------------------
59108
Public Property Get RevisionString(Optional ByVal Requery As Boolean = False) As String
60109
RevisionString = Format(LastCommit, "yyyymmddhhnnss")
61-
If UseDraftBranch Then
62-
RevisionString = RevisionString & "-draft"
110+
If BranchName <> "master" Then
111+
RevisionString = RevisionString & "-" & BranchName
63112
End If
64113
End Property
65114

@@ -104,25 +153,39 @@ End Sub
104153
Private Sub UpdateCodeModuleInTable(ByVal ModuleName As String, ByVal ACLibPath As String, Optional ByVal Requery As Boolean = False)
105154

106155
Dim TempFile As String
107-
Dim DownLoadUrl As String
108-
Dim BranchName As String
109156

110-
TempFile = FileTools.TempPath & ModuleName & FileTools.GetFileExtension(ACLibPath, True)
111157

112-
If UseDraftBranch Then
113-
BranchName = "draft"
114-
Else
115-
BranchName = "master"
116-
End If
117-
DownLoadUrl = Replace(GitHubContentBaseUrl, "{branch}", BranchName)
118-
DownLoadUrl = Replace(DownLoadUrl, "{path}", ACLibPath)
158+
TempFile = FileTools.TempPath & ModuleName & FileTools.GetFileExtension(ACLibPath, True)
159+
DownloadACLibFileFromWeb ACLibPath, TempFile
119160

120-
DownloadFileFromWeb DownLoadUrl, TempFile
121161
CurrentApplication.SaveAppFile ModuleName, TempFile, False, "SccRev", Me.RevisionString(Requery)
122162
Kill TempFile
123163

124164
End Sub
125165

166+
Friend Sub DownloadACLibFileFromWeb(ByVal ACLibPath As String, ByVal TargetFilePath As String)
167+
168+
Dim DownLoadUrl As String
169+
170+
DownLoadUrl = FillRepositoryData(GitHubContentBaseUrl)
171+
DownLoadUrl = Replace(DownLoadUrl, "{path}", ACLibPath)
172+
173+
DownloadFileFromWeb DownLoadUrl, TargetFilePath
174+
175+
End Sub
176+
177+
Private Function FillRepositoryData(ByVal StringWithPlaceHolder As String) As String
178+
179+
Dim TempValue As String
180+
181+
TempValue = Replace(StringWithPlaceHolder, "{owner}", RepositoryOwner)
182+
TempValue = Replace(TempValue, "{repo}", RepositoryName)
183+
TempValue = Replace(TempValue, "{branch}", BranchName)
184+
185+
FillRepositoryData = TempValue
186+
187+
End Function
188+
126189
Private Function GetLastCommitFromWeb() As Date
127190

128191
'alternative: git rev-list HEAD --count
@@ -131,14 +194,9 @@ Private Function GetLastCommitFromWeb() As Date
131194

132195
Dim CommitUrl As String
133196
Dim LastCommitInfo As String
134-
CommitUrl = GitHubApiBaseUrl & "commits/"
135-
136-
If UseDraftBranch Then
137-
CommitUrl = CommitUrl & "draft"
138-
Else
139-
CommitUrl = CommitUrl & "master"
140-
End If
141197

198+
CommitUrl = FillRepositoryData(GitHubApiBaseUrl) & "commits/" & BranchName
199+
142200
Const RevisionTag As String = "Revision "
143201

144202
Dim JsonString As String
@@ -154,23 +212,31 @@ Private Function GetLastCommitFromWeb() As Date
154212

155213
End Function
156214

157-
Private Function GetJsonString(ByVal ApiUrl As String) As String
158-
159-
Dim ApiResponse As String
160-
Dim json As Object
161-
162-
Dim xml As Object ' MSXML2.XMLHTTP60
163-
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
164-
165-
xml.Open "GET", ApiUrl, False
166-
xml.setRequestHeader "Content-type", "application/json"
167-
xml.send
168-
While xml.ReadyState <> 4
169-
DoEvents
170-
Wend
171-
ApiResponse = xml.responseText
172-
173-
GetJsonString = ApiResponse
215+
Friend Function GetJsonString(ByVal ApiUrl As String) As String
216+
217+
Dim ApiResponse As String
218+
Dim ApiAuthToken As String
219+
Dim json As Object
220+
Dim xml As Object 'MSXML2.XMLHTTP6
221+
222+
ApiUrl = FillRepositoryData(ApiUrl)
223+
224+
ApiAuthToken = GitHubApiAuthorizationToken
225+
226+
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
227+
228+
xml.Open "GET", ApiUrl, False
229+
If Len(ApiAuthToken) > 0 Then
230+
xml.setRequestHeader "Authorization", ApiAuthToken
231+
End If
232+
xml.setRequestHeader "Content-type", "application/json"
233+
xml.send
234+
While xml.ReadyState <> 4
235+
DoEvents
236+
Wend
237+
ApiResponse = xml.responseText
238+
239+
GetJsonString = ApiResponse
174240

175241
End Function
176242

‎source/codelib/base/ApplicationHandler_AppFile.cls

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -134,13 +134,20 @@ End Property
134134
' Boolean
135135
'
136136
'---------------------------------------------------------------------------------------
137-
Public Function CreateAppFile(ByVal FileID As String, ByVal FileName As String) As Boolean
137+
Public Function CreateAppFile(ByVal FileID As String, ByVal FileName As String, _
138+
Optional ByVal ExtFilterFieldName As String, Optional ExtFilterValue As Variant) As Boolean
138139

139140
Dim Binfile() As Byte
140141
Dim FieldSize As Long
141142
Dim fld As DAO.Field
143+
Dim SelectSql As String
144+
145+
SelectSql = "select " & TABLE_FIELD_FILE & " from " & TABLE_APPFILES & " where " & TABLE_FIELD_ID & "='" & Replace(FileID, "'", "''") & "'"
146+
If Len(ExtFilterFieldName) > 0 Then
147+
SelectSql = SelectSql & " and " & ExtFilterFieldName & " = '" & Replace(ExtFilterValue, "'", "''") & "'"
148+
End If
142149

143-
With CodeDb.OpenRecordset("select " & TABLE_FIELD_FILE & " from " & TABLE_APPFILES & " where " & TABLE_FIELD_ID & "='" & Replace(FileID, "'", "''") & "'")
150+
With CodeDb.OpenRecordset(SelectSql)
144151
If Not .EOF Then
145152

146153
Set fld = .Fields(0)

‎source/codelib/data/SqlTools.cls

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ Attribute VB_Exposed = False
1010
'---------------------------------------------------------------------------------------
1111
' Class: data.sql.SqlTools
1212
'---------------------------------------------------------------------------------------
13+
'
1314
' Functions to build sql strings
1415
'
1516
' Author:

‎source/codelib/text/StringCollection.cls

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ Attribute VB_Exposed = False
1111
' Class: text.StringCollection
1212
'---------------------------------------------------------------------------------------
1313
'
14-
' Collection-Funktionen für Strings
14+
' Collection functions for strings
1515
'
1616
' Author:
1717
' Josef Poetzl

‎source/frmFilterFormWizard.frm

-574 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)