Skip to content

Commit 3861f3c

Browse files
authored
fix GitHub download issues (#16)
1 parent 6904fe6 commit 3861f3c

File tree

5 files changed

+115
-10
lines changed

5 files changed

+115
-10
lines changed

source/forms/InstallAddInForm.cls

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@ Attribute VB_Exposed = False
1919
' <license>_codelib/license.bas</license>
2020
' <use>_codelib/addins/shared/AddInConfiguration.cls</use>
2121
' <use>_codelib/addins/shared/AddInInstaller.cls</use>
22+
' <use>base/modApplication.bas</use>
23+
' <use>base/modErrorHandler.bas</use>
2224
'</codelib>
2325
'---------------------------------------------------------------------------------------
2426
'

source/modules/ACLibFileManager.cls

Lines changed: 58 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1100,6 +1100,7 @@ Private Sub ImportVbComponent(ByRef CodeLibInf As CodeLibInfo, ByRef ImportFile
11001100
End If
11011101

11021102
If CodeModuleExists Then ' Change content via CodeModule so that MS add-in for source code management does not cause trouble
1103+
' TODO: check if invisible properties changed
11031104
Set cm = vbc.CodeModule
11041105
cm.DeleteLines 1, cm.CountOfLines
11051106
cm.AddFromFile ImportFile.Path
@@ -1117,7 +1118,7 @@ Private Sub ImportVbComponent(ByRef CodeLibInf As CodeLibInfo, ByRef ImportFile
11171118
Loop
11181119

11191120
Else
1120-
VbcCol.import ImportFile.Path
1121+
VbcCol.Import ImportFile.Path
11211122
End If
11221123

11231124
End Sub
@@ -1372,15 +1373,9 @@ Private Sub GetCodeLibInfoFromFile(ByRef CodeLibInf As CodeLibInfo, ByVal InputF
13721373
Dim CheckString As String
13731374
Dim TempString As String
13741375
Dim i As Long
1375-
Dim FileNumber As Long
13761376
Dim StringCutPos As Long
13771377

1378-
FileNumber = FreeFile
1379-
1380-
Open InputFile.Path For Binary Access Read As FileNumber
1381-
CheckString = String$(LOF(FileNumber), 0)
1382-
Get FileNumber, , CheckString
1383-
Close FileNumber
1378+
CheckString = ReadSourceFile(InputFile)
13841379

13851380
'Determine names
13861381
CodeLibInf.Name = FindSubString(CheckString, SEARCHSTRING_ATTRIBUTNAME_BEGIN, SEARCHSTRING_ATTRIBUTNAME_END, Pos)
@@ -1462,6 +1457,61 @@ Private Sub GetCodeLibInfoFromFile(ByRef CodeLibInf As CodeLibInfo, ByVal InputF
14621457

14631458
End Sub
14641459

1460+
Private Function ReadSourceFile(ByVal InputFile As Object) As String
1461+
1462+
Dim FileNumber As Long
1463+
Dim StringCutPos As Long
1464+
Dim CheckString As String
1465+
1466+
Dim CheckBytes(1 To 3) As Byte
1467+
Dim FileCharset As String
1468+
1469+
FileNumber = FreeFile
1470+
1471+
Open InputFile.Path For Binary Access Read As FileNumber
1472+
1473+
If LOF(FileNumber) >= 3 Then
1474+
1475+
Get #FileNumber, , CheckBytes
1476+
1477+
If CheckBytes(1) = &HEF And CheckBytes(2) = &HBB And CheckBytes(3) = &HBF Then
1478+
FileCharset = "utf-8"
1479+
ElseIf (CheckBytes(1) = &HFF And CheckBytes(2) = &HFE) Or (CheckBytes(1) = &HFE And CheckBytes(2) = &HFF) Then
1480+
FileCharset = "utf-16"
1481+
Else
1482+
Seek #FileNumber, 1
1483+
CheckString = String$(LOF(FileNumber), 0)
1484+
Get #FileNumber, , CheckString
1485+
End If
1486+
1487+
End If
1488+
1489+
Close FileNumber
1490+
1491+
If Len(FileCharset) > 0 Then
1492+
CheckString = ReadUtfFileToString(InputFile, FileCharset)
1493+
End If
1494+
1495+
ReadSourceFile = CheckString
1496+
1497+
End Function
1498+
1499+
Function ReadUtfFileToString(ByVal InputFile As Object, ByVal FileCharset As String) As String
1500+
1501+
Dim Stream As Object ' Late Binding für ADODB.Stream
1502+
Set Stream = CreateObject("ADODB.Stream")
1503+
1504+
With Stream
1505+
.Type = 2 ' Text
1506+
.Charset = FileCharset
1507+
.Open
1508+
.LoadFromFile InputFile.Path
1509+
ReadUtfFileToString = .ReadText
1510+
.Close
1511+
End With
1512+
1513+
End Function
1514+
14651515
Private Sub GetCodeLibInfoPackage(ByRef CodeLibInf As CodeLibInfo, ByRef SourceString As String)
14661516
Dim PackageName As String
14671517
PackageName = Trim(FindSubString(SourceString, SEARCHSTRING_PACKAGE_BEGIN, SEARCHSTRING_PACKAGE_END))

source/modules/ACLibGitHubImporter.cls

Lines changed: 53 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ Private m_BranchName As String
4040

4141
#If VBA7 Then
4242
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
43-
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
43+
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
4444
#Else
4545
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
4646
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
@@ -298,7 +298,59 @@ On Error GoTo 0
298298
End Sub
299299

300300
Private Sub DownloadFileFromWeb(ByVal Url As String, ByVal TargetPath As String)
301+
301302
If FileExists(TargetPath) Then Kill TargetPath
302303
DeleteUrlCacheEntry Url
303304
URLDownloadToFile 0, Url, TargetPath, 0, 0
305+
306+
If IsUTF16(TargetPath) Then 'Forms/Reports
307+
Exit Sub
308+
End If
309+
310+
NormalizeDownloadFile TargetPath ' fix issues with import as module instead of Class
311+
312+
End Sub
313+
314+
Function IsUTF16(ByVal InputFile As String) As Boolean
315+
316+
Dim FileNumber As Integer
317+
Dim CheckByte(1 To 2) As Byte
318+
FileNumber = FreeFile
319+
Open InputFile For Binary Access Read As #FileNumber
320+
If LOF(FileNumber) >= 2 Then
321+
Get #FileNumber, , CheckByte
322+
If (CheckByte(1) = &HFF And CheckByte(2) = &HFE) Or (CheckByte(1) = &HFE And CheckByte(2) = &HFF) Then
323+
IsUTF16 = True
324+
End If
325+
End If
326+
Close #FileNumber
327+
328+
End Function
329+
330+
Sub NormalizeDownloadFile(ByVal InputFile As String)
331+
332+
Dim TextStreamIn As Scripting.TextStream, TextStreamOut As Scripting.TextStream
333+
Dim TempFile As String
334+
Dim TextLine As String
335+
336+
TempFile = InputFile & ".temp"
337+
338+
With New Scripting.FileSystemObject
339+
340+
Set TextStreamIn = .OpenTextFile(InputFile, ForReading, False)
341+
Set TextStreamOut = .OpenTextFile(TempFile, ForWriting, True, TristateUseDefault)
342+
343+
Do While Not TextStreamIn.AtEndOfStream
344+
TextLine = TextStreamIn.ReadLine
345+
TextStreamOut.Write TextLine & vbCrLf
346+
Loop
347+
348+
TextStreamIn.Close
349+
TextStreamOut.Close
350+
351+
.DeleteFile InputFile
352+
.MoveFile TempFile, InputFile
353+
354+
End With
355+
304356
End Sub

source/modules/AddInInstaller.cls

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ Attribute VB_Exposed = False
2323
' <file>_codelib/addins/shared/AddInInstaller.cls</file>
2424
' <license>_codelib/license.bas</license>
2525
' <use>_codelib/addins/shared/AddInConfiguration.cls</use>
26+
' <use>file/FileTools.bas</use>
2627
' <ref><name>DAO</name><major>5</major><minor>0</minor><guid>{00025E01-0000-0000-C000-000000000046}</guid></ref>
2728
'</codelib>
2829
'---------------------------------------------------------------------------------------

source/nav-pane-groups.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
{
99
"Name": "Benutzerdefiniert",
1010
"Flags": 0,
11-
"Position": 3,
11+
"Position": 2,
1212
"Groups": [
1313
{
1414
"Name": "Benutzerdefinierte Gruppe 1",

0 commit comments

Comments
 (0)