Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,5 @@ Details: https://wiki.access-codelib.net/ACLib-Import-Wizard

#### Using the Import-Wizard:
[Video: create new Access application](https://access-codelib.net/videos/ACLib-Import-Wizard/neue-anwendung-erstellen/)

[Video: Import from GitHub repository](https://access-codelib.net/videos/ACLib-Import-Wizard/ACLib-Import-Wizard_ImportFromGitHub.mp4)
Binary file modified access-add-in/ACLibImportWizard.accda
Binary file not shown.
Binary file modified source/ACLibImportWizardForm.frm
Binary file not shown.
Binary file modified source/ACLibRepositoryTreeForm.frm
Binary file not shown.
34 changes: 9 additions & 25 deletions source/GitHubTreeNode.cls
Original file line number Diff line number Diff line change
Expand Up @@ -10,11 +10,10 @@ Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private Const GitHubApiTreesUrl As String = "https://api.github.com/repos/AccessCodeLib/AccessCodeLib/git/trees/{SHA}"
Private Const GitHubApiTreesUrl As String = "https://api.github.com/repos/{owner}/{repo}/git/trees/{SHA}"

Private m_Properties As Dictionary
Private m_Nodes As Dictionary
Private m_GitHubApiAuthToken As String

Private Sub Class_Initialize()
Set m_Properties = New Dictionary
Expand Down Expand Up @@ -56,25 +55,20 @@ Public Property Get Sha() As String
End Property

Public Sub BuildFromSHA(ByVal Sha As String, _
Optional ByVal ReadSubTreeLevel As Long = 0, _
Optional ByVal GitHubApiAuthToken As String = vbNullString)
Optional ByVal ReadSubTreeLevel As Long = 0)

Dim JsonString As String

With New ACLibGitHubImporter
If Len(GitHubApiAuthToken) > 0 Then
m_GitHubApiAuthToken = GitHubApiAuthToken
End If
If Len(m_GitHubApiAuthToken) > 0 Then
.GitHubApiAuthorizationToken = m_GitHubApiAuthToken
End If
With ACLibGitHubImporter

JsonString = .GetJsonString(Replace(GitHubApiTreesUrl, "{SHA}", Sha))

If JsonString Like "{""message"":*" Then
Err.Raise vbObjectError, "GitHubTreeNode.BuildFromSHA", BuildErrMsgFromGitHubApiMessage(JsonString)
End If

BuildFromJson JsonString, ReadSubTreeLevel

End With

End Sub
Expand Down Expand Up @@ -103,16 +97,11 @@ Friend Sub BuildFromJson(ByVal JsonString As String, Optional ByVal ReadSubTreeL

End Sub

Friend Sub InitFromJsonProperties(ByVal Props As JsonProperties, Optional ByVal ReadSubTreeLevel As Long = 0, _
Optional ByVal GitHubApiAuthToken As String = vbNullString)
Friend Sub InitFromJsonProperties(ByVal Props As JsonProperties, Optional ByVal ReadSubTreeLevel As Long = 0)

Dim Prop As JsonProperty
Dim i As Long

If Len(GitHubApiAuthToken) > 0 Then
m_GitHubApiAuthToken = GitHubApiAuthToken
End If

For i = 1 To Props.Count
Set Prop = Props.Item(i)
If Prop.Name = "Tree" Then
Expand Down Expand Up @@ -145,28 +134,23 @@ Private Function GetNodeFromNodeProps(ByVal NodeProps As JsonProperties) As GitH
Dim Node As GitHubTreeNode

Set Node = New GitHubTreeNode
Node.InitFromJsonProperties NodeProps, , m_GitHubApiAuthToken
Node.InitFromJsonProperties NodeProps

Set GetNodeFromNodeProps = Node

End Function

Friend Sub FillNextTreeLevel(Optional ByVal ReadSubTreeLevel As Long = 0, _
Optional ByVal GitHubApiAuthToken As String = vbNullString)
Friend Sub FillNextTreeLevel(Optional ByVal ReadSubTreeLevel As Long = 0)

Dim Node As GitHubTreeNode
Dim NodeKey As Variant

If Not IsFolder Then
Exit Sub
End If

If Len(GitHubApiAuthToken) > 0 Then
m_GitHubApiAuthToken = GitHubApiAuthToken
End If

If m_Nodes.Count = 0 Then
Me.BuildFromSHA Me.Sha, ReadSubTreeLevel, m_GitHubApiAuthToken
Me.BuildFromSHA Me.Sha, ReadSubTreeLevel
Exit Sub
End If

Expand Down
2 changes: 1 addition & 1 deletion source/_config_Application.bas
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ Option Compare Database
Option Explicit

'Versionsnummer
Private Const APPLICATION_VERSION As String = "1.3.0"
Private Const APPLICATION_VERSION As String = "1.3.1"

#Const USE_CLASS_ApplicationHandler_AppFile = 1
#Const USE_CLASS_ApplicationHandler_DirTextbox = 1
Expand Down
92 changes: 66 additions & 26 deletions source/codelib/_codelib/addins/shared/ACLibGitHubImporter.cls
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -28,12 +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
Expand All @@ -55,23 +58,57 @@ Public Property Let GitHubApiAuthorizationToken(ByVal NewValue As String)
End Property

'---------------------------------------------------------------------------------------
' Property: UseDraftBranch
' 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

Expand Down Expand Up @@ -129,20 +166,26 @@ End Sub
Friend Sub DownloadACLibFileFromWeb(ByVal ACLibPath As String, ByVal TargetFilePath As String)

Dim DownLoadUrl As String
Dim BranchName As String

If UseDraftBranch Then
BranchName = "draft"
Else
BranchName = "master"
End If
DownLoadUrl = Replace(GitHubContentBaseUrl, "{branch}", BranchName)
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
Expand All @@ -151,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
Expand All @@ -179,7 +217,9 @@ 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.XMLHTTP60
Dim xml As Object 'MSXML2.XMLHTTP6

ApiUrl = FillRepositoryData(ApiUrl)

ApiAuthToken = GitHubApiAuthorizationToken

Expand Down