Skip to content

Commit 10f6b06

Browse files
wqwetowqweto
committed
Report error source and last dll error number
1 parent ae2be49 commit 10f6b06

File tree

1 file changed

+21
-18
lines changed

1 file changed

+21
-18
lines changed

‎src/cZipArchive.cls‎

Lines changed: 21 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -221,6 +221,7 @@ Private Const LNG_ENC_HEADER_SIZE As Long = 12
221221
Private Const LNG_AES_AUTHCODE_SIZE As Long = 10
222222
Private Const LNG_AES_BLOCK_SIZE As Long = 16
223223
Private Const LNG_DEF_ENCR_STRENGTH As Long = 0
224+
Private Const LNG_PIPE_ENDED_ERROR As Long = 109
224225
Private Const ERR_USER_CANCEL As String = "User cancelled"
225226
Private Const ERR_INIT_COMPRESSOR As String = "Cannot init deflate compressor"
226227
Private Const ERR_COMPRESSING As String = "Error compressing"
@@ -427,7 +428,7 @@ End Type
427428
'=========================================================================
428429

429430
Property Get SemVersion() As String
430-
SemVersion = "0.2.2"
431+
SemVersion = "0.2.3"
431432
End Property
432433

433434
Property Get ThunkBuildDate() As String
@@ -511,7 +512,7 @@ QH:
511512
pvVfsClose uFile
512513
Exit Function
513514
EH:
514-
pvSetError MODULE_NAME & "." & FUNC_NAME, Err.Description
515+
pvSetError MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description
515516
Resume QH
516517
End Function
517518

@@ -821,10 +822,10 @@ QH:
821822
pvVfsClose uArchiveFile
822823
Exit Function
823824
EH:
824-
pvSetError MODULE_NAME & "." & FUNC_NAME, Err.Description
825+
pvSetError MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description
825826
Resume QH
826827
EH_Continue:
827-
If pvSetError(MODULE_NAME & "." & FUNC_NAME, Err.Description, CanContinue:=True) Then
828+
If pvSetError(MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description, CanContinue:=True) Then
828829
Resume QH
829830
Else
830831
Resume SkipFile
@@ -889,7 +890,7 @@ Public Function AddFromFolder( _
889890
QH:
890891
Exit Function
891892
EH:
892-
pvSetError MODULE_NAME & "." & FUNC_NAME, Err.Description
893+
pvSetError MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description
893894
Resume QH
894895
End Function
895896

@@ -905,7 +906,7 @@ Private Function pvEnumFiles(sFolder As String, sMask As String, ByVal eAttrib A
905906
If hFind = INVALID_HANDLE_VALUE Then
906907
If Err.LastDllError <> 2 Then
907908
On Error GoTo 0
908-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & sFile & ")"
909+
Err.Raise vbObjectError, "pvEnumFiles", GetSystemMessage(Err.LastDllError) & " (" & sFile & ")"
909910
End If
910911
Else
911912
Do
@@ -1154,7 +1155,7 @@ QH:
11541155
pvVfsClose uArchiveFile
11551156
Exit Function
11561157
EH:
1157-
pvSetError MODULE_NAME & "." & FUNC_NAME, Err.Description
1158+
pvSetError MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description
11581159
Resume QH
11591160
End Function
11601161

@@ -1445,10 +1446,10 @@ QH:
14451446
pvVfsClose uFile
14461447
Exit Function
14471448
EH:
1448-
pvSetError MODULE_NAME & "." & FUNC_NAME, Err.Description
1449+
pvSetError MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description
14491450
Resume QH
14501451
EH_Continue:
1451-
If pvSetError(MODULE_NAME & "." & FUNC_NAME, Err.Description, CanContinue:=True) Then
1452+
If pvSetError(MODULE_NAME & "." & FUNC_NAME & vbCrLf & Err.Source, Err.Description, CanContinue:=True) Then
14521453
Resume QH
14531454
Else
14541455
Resume SkipFile
@@ -1720,7 +1721,7 @@ Private Function pvVfsOpen(File As Variant) As UcsVfsFileType
17201721
If hFind <> INVALID_HANDLE_VALUE Then
17211722
Call FindClose(hFind)
17221723
Else
1723-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & File & ")"
1724+
Err.Raise vbObjectError, "pvVfsOpen", GetSystemMessage(Err.LastDllError) & " (" & File & ")"
17241725
End If
17251726
End If
17261727
End Function
@@ -1762,7 +1763,7 @@ Private Function pvVfsCreate(File As Variant) As UcsVfsFileType
17621763
If Right$(File, 1) <> "\" Then
17631764
pvVfsCreate.Handle = pvCreateFile(File, GENERIC_WRITE, FILE_SHARE_READ, 0, CREATE_ALWAYS, vbArchive, 0)
17641765
If pvVfsCreate.Handle = INVALID_HANDLE_VALUE Then
1765-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & File & ")"
1766+
Err.Raise vbObjectError, "pvVfsCreate", GetSystemMessage(Err.LastDllError) & " (" & File & ")"
17661767
End If
17671768
End If
17681769
End If
@@ -1796,11 +1797,13 @@ Private Function pvVfsRead(uFile As UcsVfsFileType, ByVal lPtr As Long, ByVal lS
17961797
If uFile.Handle = 0 Or uFile.Handle = INVALID_HANDLE_VALUE Then
17971798
uFile.Handle = pvCreateFile(uFile.FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
17981799
If uFile.Handle = INVALID_HANDLE_VALUE Then
1799-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1800+
Err.Raise vbObjectError, "pvVfsRead", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
18001801
End If
18011802
End If
18021803
If ReadFile(uFile.Handle, ByVal lPtr, lSize, pvVfsRead, 0) = 0 Then
1803-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1804+
If Err.LastDllError <> LNG_PIPE_ENDED_ERROR Then
1805+
Err.Raise vbObjectError, "pvVfsRead", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1806+
End If
18041807
End If
18051808
End If
18061809
End Function
@@ -1834,11 +1837,11 @@ Private Function pvVfsWrite(uFile As UcsVfsFileType, ByVal lPtr As Long, ByVal l
18341837
If uFile.Handle = 0 Or uFile.Handle = INVALID_HANDLE_VALUE Then
18351838
uFile.Handle = pvCreateFile(uFile.FileName, GENERIC_WRITE, FILE_SHARE_READ, 0, CREATE_ALWAYS, vbArchive, 0)
18361839
If uFile.Handle = INVALID_HANDLE_VALUE Then
1837-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1840+
Err.Raise vbObjectError, "pvVfsWrite", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
18381841
End If
18391842
End If
18401843
If WriteFile(uFile.Handle, ByVal lPtr, lSize, pvVfsWrite, 0) = 0 Then
1841-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1844+
Err.Raise vbObjectError, "pvVfsWrite", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
18421845
End If
18431846
End If
18441847
End Function
@@ -1863,7 +1866,7 @@ Private Function pvVfsSeek(uFile As UcsVfsFileType, ByVal lPosition As Long, ByV
18631866
End If
18641867
pvVfsSeek = SetFilePointer(uFile.Handle, lPosition, 0, lMoveMethod)
18651868
If pvVfsSeek = INVALID_SET_FILE_POINTER Then
1866-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1869+
Err.Raise vbObjectError, "pvVfsSeek", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
18671870
End If
18681871
End If
18691872
End Function
@@ -1884,7 +1887,7 @@ Private Sub pvVfsSetEof(uFile As UcsVfsFileType, sMetaData As String)
18841887
uFile.Stream.VfsSetEndOfFile sMetaData
18851888
ElseIf Right$(uFile.FileName, 1) <> ":" Then
18861889
If SetEndOfFile(uFile.Handle) = 0 Then
1887-
Err.Raise vbObjectError, , GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
1890+
Err.Raise vbObjectError, "pvVfsSetEof", GetSystemMessage(Err.LastDllError) & " (" & uFile.FileName & ")"
18881891
End If
18891892
End If
18901893
End Sub
@@ -2076,7 +2079,7 @@ Private Function GetSystemMessage(ByVal lLastDllError As Long) As String
20762079
lSize = lSize - 2
20772080
End If
20782081
End If
2079-
GetSystemMessage = Left$(GetSystemMessage, lSize)
2082+
GetSystemMessage = "[" & lLastDllError & "] " & Left$(GetSystemMessage, lSize)
20802083
End Function
20812084

20822085
Private Sub AssignVariant(vDest As Variant, vSrc As Variant)

0 commit comments

Comments
 (0)