@@ -48,6 +48,8 @@ Private Const SEARCHSTRING_CODELIB_BEGIN As String = "<codelib>"
48
48
Private Const SEARCHSTRING_CODELIB_END As String = "</codelib>"
49
49
Private Const SEARCHSTRING_FILE_BEGIN As String = "<file>"
50
50
Private Const SEARCHSTRING_FILE_END As String = "</file>"
51
+ Private Const SEARCHSTRING_PACKAGE_BEGIN As String = "<package>"
52
+ Private Const SEARCHSTRING_PACKAGE_END As String = "</package>"
51
53
Private Const SEARCHSTRING_LICENSE_BEGIN As String = "<license>"
52
54
Private Const SEARCHSTRING_LICENSE_END As String = "</license>"
53
55
Private Const SEARCHSTRING_DESCRIPTION_BEGIN As String = "<description>"
@@ -79,9 +81,10 @@ Private Const SEARCHSTRING_REPORTIDENTIFER As String = "Begin Report"
79
81
80
82
Private Const MODULNAME_CONFIG_APPLICATION As String = "_config_Application"
81
83
82
- Private Const REPOSTITORY_ROOT_CODE_APPLICATIONROOT As String = "%AppFolder%"
83
84
Private Const REPOSTITORY_ROOT_CODE_WithoutCodeLibInfoExportFolder As String = "source"
85
+ Private Const REPOSTITORY_ROOT_CODE_APPLICATIONROOT As String = "%AppFolder%"
84
86
Private Const REPOSTITORY_ROOT_CODE_PRIVATEROOT As String = "%PrivateRoot%"
87
+ Private Const REPOSTITORY_ROOT_CODE_GITHUBROOT As String = "%GitHub%"
85
88
86
89
Private m_ImportFileCollection As Collection
87
90
Private m_ReplacedFilesCollection As Collection
@@ -184,11 +187,20 @@ End Sub
184
187
185
188
Private Sub Dispose ()
186
189
On Error Resume Next
190
+ RemoveTempFiles
187
191
Set m_ImportFileCollection = Nothing
188
192
Set m_FSO = Nothing
189
193
Set m_CurrentVbProject = Nothing
190
194
End Sub
191
195
196
+ Private Sub RemoveTempFiles ()
197
+
198
+ If FileTools.DirExists(GitHubTempRepositoryPath) Then
199
+ CreateObject("Scripting.FileSystemObject" ).DeleteFolder GitHubTempRepositoryPath, True
200
+ End If
201
+
202
+ End Sub
203
+
192
204
Public Property Let ExportAllToApplicationSourceFolder(ByVal NewValue As Boolean )
193
205
m_ExportAllToApplicationSourceFolder = NewValue
194
206
End Property
@@ -309,8 +321,6 @@ Public Sub ImportRepositoryFile(ByVal RepositoryPath As String, _
309
321
310
322
PathString = GetRepositoryFullPath(RepositoryPath)
311
323
312
-
313
-
314
324
Dim TempFile As Object
315
325
Set TempFile = fso.GetFile(PathString)
316
326
AddMissingFile TempFile, ImportMode
@@ -642,7 +652,21 @@ Public Function GetRepositoryFullPath(ByVal ReleativPath As String) As String
642
652
End If
643
653
ReleativPath = Mid$(ReleativPath, Len(REPOSTITORY_ROOT_CODE_PRIVATEROOT) + 1 )
644
654
655
+ ElseIf Left(ReleativPath, Len(REPOSTITORY_ROOT_CODE_GITHUBROOT)) = REPOSTITORY_ROOT_CODE_GITHUBROOT Then
656
+ ' %GITHUB%\owner\repo@branch\Path
657
+ ReleativPath = Replace(ReleativPath, "\" , "/" )
658
+ If Not DownLoadFromGitHub(ReleativPath, RepPath) Then
659
+ Err.Raise vbObjectError, "getRepositoryFullPath" , "Download aus GitHub ist fehlgeschlagen"
660
+ Exit Function
661
+ End If
662
+
663
+ If Len(RepPath) = 0 Then
664
+ Err.Raise vbObjectError, "getRepositoryFullPath" , "Wert für lokales GitHub-Temp-Verzeichnis fehlt."
665
+ Exit Function
666
+ End If
667
+
645
668
Else
669
+
646
670
If m_ExportAllToApplicationSourceFolder Then
647
671
RepPath = CurrentProject.Path & "\source\codelib\"
648
672
Else
@@ -654,7 +678,6 @@ Public Function GetRepositoryFullPath(ByVal ReleativPath As String) As String
654
678
Exit Function
655
679
End If
656
680
657
-
658
681
End If
659
682
660
683
Do While Left$(ReleativPath, 1 ) = "\"
@@ -671,6 +694,48 @@ Public Function GetRepositoryFullPath(ByVal ReleativPath As String) As String
671
694
672
695
End Function
673
696
697
+ Private Function DownLoadFromGitHub (ByRef ReleativPath As String , ByRef RepPath As String ) As Boolean
698
+ ' %GITHUB%/owner/repo@branch/Path
699
+
700
+ Dim FullFilePath As String
701
+ Dim GitHubDataCutPos As Long
702
+ Dim GitHubUrlDataString As String
703
+ Dim GitHubPath As String
704
+ Dim GitHubUrlData() As String
705
+ Dim RelativeFileUrl As String
706
+
707
+ '%GITHUB%/owner/repo@branch/Path
708
+ GitHubPath = Mid(Replace(ReleativPath, "\" , "/" ), Len(REPOSTITORY_ROOT_CODE_GITHUBROOT) + 2 )
709
+ GitHubDataCutPos = InStr(InStr(1 , GitHubPath, "@" ) + 1 , GitHubPath, "/" )
710
+ GitHubUrlDataString = Left(GitHubPath, GitHubDataCutPos - 1 )
711
+ RelativeFileUrl = Mid(GitHubPath, GitHubDataCutPos + 1 )
712
+ GitHubUrlDataString = Replace(GitHubUrlDataString, "@" , "/" )
713
+
714
+ GitHubUrlData = Split(GitHubUrlDataString, "/" )
715
+ RepPath = GitHubTempRepositoryPath & "\"
716
+ ReleativPath = Replace(RelativeFileUrl, "/" , "\" )
717
+ FullFilePath = RepPath & ReleativPath
718
+
719
+ If Not FileTools.FileExists(FullFilePath) Then
720
+
721
+ With New ACLibGitHubImporter
722
+ .RepositoryOwner = GitHubUrlData(0 )
723
+ .RepositoryName = GitHubUrlData(1 )
724
+ .BranchName = GitHubUrlData(2 )
725
+ CreateDirectoryIfMissing FileTools.PathFromFullFileName(FullFilePath)
726
+ .DownloadACLibFileFromWeb RelativeFileUrl, FullFilePath
727
+ End With
728
+
729
+ End If
730
+
731
+ DownLoadFromGitHub = True
732
+
733
+ End Function
734
+
735
+ Private Property Get GitHubTempRepositoryPath() As String
736
+ GitHubTempRepositoryPath = FileTools.TempPath & "ACLibTempRepo"
737
+ End Property
738
+
674
739
Private Sub ImportFile (ByRef ImportFile As Object , ByRef ImportMode As CodeLibImportMode , _
675
740
Optional ByVal ImportTestFiles As Boolean = False )
676
741
@@ -726,6 +791,8 @@ Private Sub ImportFile(ByRef ImportFile As Object, ByRef ImportMode As CodeLibIm
726
791
ImportAccessObject acForm, m_CLI, ImportFile, ImportMode
727
792
Case CodeLibElementType.clet_Report
728
793
ImportAccessObject acReport, m_CLI, ImportFile, ImportMode
794
+ Case CodeLibElementType.clet_Package
795
+ ' don't import package file
729
796
Case Else
730
797
' eventuell Fehler auslösen?
731
798
End Select
@@ -1325,8 +1392,11 @@ Private Sub GetCodeLibInfoFromFile(ByRef CodeLibInf As CodeLibInfo, ByVal InputF
1325
1392
'Read CODELIB block
1326
1393
CheckString = FindSubString(CheckString, SEARCHSTRING_CODELIB_BEGIN, SEARCHSTRING_CODELIB_END)
1327
1394
If Len(CheckString) > 0 Then
1328
- GetCodeLibInfoRepositoryFile CodeLibInf, CheckString
1329
- GetCodeLibInfoRepositoryFileReplacement CodeLibInf, CheckString
1395
+ GetCodeLibInfoPackage CodeLibInf, CheckString
1396
+ If CodeLibInf.Type <> clet_Package Then
1397
+ GetCodeLibInfoRepositoryFile CodeLibInf, CheckString
1398
+ GetCodeLibInfoRepositoryFileReplacement CodeLibInf, CheckString
1399
+ End If
1330
1400
GetCodeLibInfoLicenseFile CodeLibInf, CheckString
1331
1401
If FindDependency Then GetCodeLibInfoDependency CodeLibInf, CheckString
1332
1402
GetCodeLibInfoReferences CodeLibInf, CheckString
@@ -1337,6 +1407,15 @@ Private Sub GetCodeLibInfoFromFile(ByRef CodeLibInf As CodeLibInfo, ByVal InputF
1337
1407
1338
1408
End Sub
1339
1409
1410
+ Private Sub GetCodeLibInfoPackage (ByRef CodeLibInf As CodeLibInfo , ByRef SourceString As String )
1411
+ Dim PackageName As String
1412
+ PackageName = Trim(FindSubString(SourceString, SEARCHSTRING_PACKAGE_BEGIN, SEARCHSTRING_PACKAGE_END))
1413
+ If Len(PackageName) > 0 Then
1414
+ CodeLibInf.Name = PackageName
1415
+ CodeLibInf.Type = clet_Package
1416
+ End If
1417
+ End Sub
1418
+
1340
1419
Private Sub GetCodeLibInfoRepositoryFile (ByRef CodeLibInf As CodeLibInfo , ByRef SourceString As String )
1341
1420
CodeLibInf.RepositoryFile = Replace(FindSubString(SourceString, SEARCHSTRING_FILE_BEGIN, SEARCHSTRING_FILE_END), "\" , "/" )
1342
1421
End Sub
0 commit comments