1	#Region "Microsoft.VisualBasic::1d531d05aafd7ea58451795acc1a03ad, Microsoft.VisualBasic.Core\ApplicationServices\ZipLib.vb"
2
3	' Author:
4	'
5	'       asuka (amethyst.asuka@gcmodeller.org)
6	'       xie (genetics@smrucc.org)
7	'       xieguigang (xie.guigang@live.com)
8	'
9	' Copyright (c) 2018 GPL3 Licensed
10	'
11	'
12	' GNU GENERAL PUBLIC LICENSE (GPL3)
13	'
14	'
15	' This program is free software: you can redistribute it and/or modify
16	' it under the terms of the GNU General Public License as published by
17	' the Free Software Foundation, either version 3 of the License, or
18	' (at your option) any later version.
19	'
20	' This program is distributed in the hope that it will be useful,
21	' but WITHOUT ANY WARRANTY; without even the implied warranty of
22	' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23	' GNU General Public License for more details.
24	'
25	' You should have received a copy of the GNU General Public License
26	' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30	' /********************************************************************************/
31
32	' Summaries:
33
34	'     Module ZipLib
35	'
36	'
37	'         Enum Overwrite
38	'
39	'             Always, IfNewer, Never
40	'
41	'
42	'
43	'         Enum ArchiveAction
44	'
45	'             [Error], Ignore, Merge, Replace
46	'
47	'
48	'
49	'
50	'
51	'
52	'
53	'     Function: ExtractToSelfDirectory, IsADirectoryEntry, IsSourceFolderZip
54	'
55	'     Sub: AddToArchive, DirectoryArchive, ExtractToFileInternal, FileArchive, ImprovedExtractToDirectory
56	'          ImprovedExtractToFile
57	'
58	'
59	' /********************************************************************************/
60
61	#End Region
62
63	Imports System.IO
64	Imports System.IO.Compression
65	Imports System.Runtime.CompilerServices
66	Imports Microsoft.VisualBasic.ApplicationServices
67	Imports Microsoft.VisualBasic.CommandLine.Reflection
68	Imports Microsoft.VisualBasic.Language
69	Imports Microsoft.VisualBasic.Language.UnixBash
70	Imports Microsoft.VisualBasic.Scripting.MetaData
71
72	Namespace ApplicationServices
73
74	#If NET_40 = 0 Then
75
76	''' <summary>
77	''' Creating Zip Files Easily in .NET 4.5
78	''' Tim Corey, 11 May 2012
79	'''
80	''' http://www.codeproject.com/Articles/381661/Creating-Zip-Files-Easily-in-NET
81	''' </summary>
82	''' <remarks></remarks>
83	'''
84	<Package("IO.ZIP", Description:="Creating Zip Files Easily in .NET 4.6",
85	Publisher:="Tim Corey",
86	Url:="http://www.codeproject.com/Articles/381661/Creating-Zip-Files-Easily-in-NET")>
87	Public Module ZipLib
88
89	''' <summary>
90	''' Used to specify what our overwrite policy
91	''' is for files we are extracting.
92	''' </summary>
93	Public Enum Overwrite
94	Always
95	IfNewer
96	Never
97	End Enum
98
99	''' <summary>
100	''' Used to identify what we will do if we are
101	''' trying to create a zip file and it already
102	''' exists.
103	''' </summary>
104	Public Enum ArchiveAction
105	Merge
106	Replace
107	[Error]
108	Ignore
109	End Enum
110
111	''' <summary>
112	''' Unzips the specified file to the given folder in a safe
113	''' manner.  This plans for missing paths and existing files
114	''' and handles them gracefully.
115	''' </summary>
116	''' <param name="sourceArchiveFileName">
117	''' The name of the zip file to be extracted
118	''' </param>
119	''' <param name="destinationDirectoryName">
120	''' The directory to extract the zip file to
121	''' </param>
122	''' <param name="overwriteMethod">
123	''' Specifies how we are going to handle an existing file.
124	''' The default is IfNewer.
125	''' </param>
126	'''
127	<ExportAPI("ExtractToDir", Info:="Unzips the specified file to the given folder in a safe manner. This plans for missing paths and existing files and handles them gracefully.")>
128	Public Sub ImprovedExtractToDirectory(<Parameter("Zip", "The name of the zip file to be extracted")> sourceArchiveFileName$,
129	<Parameter("Dir", "The directory to extract the zip file to")> destinationDirectoryName$,
130	<Parameter("Overwrite.HowTo", "Specifies how we are going to handle an existing file. The default is IfNewer.")>
131	Optional overwriteMethod As Overwrite = Overwrite.IfNewer,
132	Optional extractToFlat As Boolean = False)
133
134	' Opens the zip file up to be read
135	Using archive As ZipArchive = ZipFile.OpenRead(sourceArchiveFileName)
136
137	Dim rootDir$ = Nothing
138	Dim isFolderArchive = sourceArchiveFileName.IsSourceFolderZip(folder:=rootDir)
139	Dim fullName$
140
141	' Loops through each file in the zip file
142	For Each file As ZipArchiveEntry In archive.Entries
143	If extractToFlat AndAlso isFolderArchive Then
144	fullName = file.FullName.Replace(rootDir, "")
145	Else
146	fullName = file.FullName
147	End If
148
149	If file.IsADirectoryEntry Then
150	Call Path _
151	.Combine(destinationDirectoryName, fullName) _
152	.MkDIR
153	Else
154	Call file.ExtractToFileInternal(
155	destinationPath:=destinationDirectoryName,
156	overwriteMethod:=overwriteMethod,
157	overridesFullName:=fullName
158	)
159	End If
160	Next
161	End Using
162	End Sub
163
164	''' <summary>
165	''' 判断目标zip文件是否是直接将文件夹进行压缩的
166	''' 如果是直接将文件夹压缩的，那么肯定会在每一个entry的起始存在一个共同的文件夹名
167	''' 例如：
168	'''
169	''' ```
170	''' 95-1.D/
171	''' 95-1.D/AcqData/
172	''' 95-1.D/AcqData/Contents.xml
173	''' 95-1.D/AcqData/Devices.xml
174	''' ```
175	''' </summary>
176	''' <param name="zip"></param>
177	''' <returns></returns>
178	<Extension>
179	Public Function IsSourceFolderZip(zip$, Optional ByRef folder$ = Nothing) As Boolean
180	Using archive As ZipArchive = ZipFile.OpenRead(zip)
181	Dim fileNames = archive.Entries _
182	.Where(Function(e) Not e.IsADirectoryEntry) _
183	.Select(Function(file) file.FullName) _
184	.ToArray
185	Dim rootDir = archive.Entries _
186	.Where(Function(e) e.IsADirectoryEntry) _
187	.Select(Function(d) d.FullName) _
188	.OrderBy(Function(d) d.Length) _
189	.FirstOrDefault
190
191	If rootDir.StringEmpty OrElse rootDir = "/" OrElse rootDir = "\" Then
192	' 没有root文件夹，说明不是
193	Return False
194	End If
195
196	If fileNames.All(Function(path) path.StartsWith(rootDir)) Then
197	folder = rootDir
198	Else
199	folder = Nothing
200	End If
201
202	Return Not folder Is Nothing
203	End Using
204	End Function
205
206	Public Function ExtractToSelfDirectory(zip$, Optional overwriteMethod As Overwrite = Overwrite.IfNewer) As String
207	Dim Dir As String = FileIO.FileSystem.GetParentPath(zip)
208	Dim Name As String = BaseName(zip)
209	Dir = Dir & "/" & Name
210	Call ImprovedExtractToDirectory(zip, Dir, overwriteMethod)
211
212	Return Dir
213	End Function
214
215	<MethodImpl(MethodImplOptions.AggressiveInlining)>
216	<Extension>
217	Public Function IsADirectoryEntry(file As ZipArchiveEntry) As Boolean
218	Return file.FullName.Last = "/"c OrElse file.FullName.Last = "\"c
219	End Function
220
221	<Extension> Private Sub ExtractToFileInternal(file As ZipArchiveEntry, destinationPath$, overwriteMethod As Overwrite, overridesFullName$)
222	' Gets the complete path for the destination file, including any
223	' relative paths that were in the zip file
224	Dim destinationFileName As String = Path.Combine(destinationPath, overridesFullName Or file.FullName.AsDefault)
225
226	' Gets just the new path, minus the file name so we can create the
227	' directory if it does not exist
228	Dim destinationFilePath As String = Path.GetDirectoryName(destinationFileName)
229
230	' Creates the directory (if it doesn't exist) for the new path
231	' 2018-2-2 在原先的代码之中直接使用CreateDirectory，如果目标文件夹存在的话会报错
232	' 在这里使用安全一点的mkdir函数
233	Call destinationFilePath.MkDIR(throwEx:=False)
234
235	' Determines what to do with the file based upon the
236	' method of overwriting chosen
237	Select Case overwriteMethod
238	Case Overwrite.Always
239
240	' Just put the file in and overwrite anything that is found
241	file.ExtractToFile(destinationFileName, True)
242
243	Case Overwrite.IfNewer
244	' Checks to see if the file exists, and if so, if it should
245	' be overwritten
246	If Not IO.File.Exists(destinationFileName) OrElse IO.File.GetLastWriteTime(destinationFileName) < file.LastWriteTime Then
247	' Either the file didn't exist or this file is newer, so
248	' we will extract it and overwrite any existing file
249	file.ExtractToFile(destinationFileName, True)
250	End If
251
252	Case Overwrite.Never
253	' Put the file in if it is new but ignores the
254	' file if it already exists
255	If Not IO.File.Exists(destinationFileName) Then
256	file.ExtractToFile(destinationFileName)
257	End If
258
259	Case Else
260	End Select
261	End Sub
262
263	''' <summary>
264	''' Safely extracts a single file from a zip file
265	''' </summary>
266	''' <param name="file">
267	''' The zip entry we are pulling the file from
268	''' </param>
269	''' <param name="destinationPath">
270	''' The root of where the file is going
271	''' </param>
272	''' <param name="overwriteMethod">
273	''' Specifies how we are going to handle an existing file.
274	''' The default is Overwrite.IfNewer.
275	''' </param>
276	'''
277	<ExportAPI("Extract", Info:="Safely extracts a single file from a zip file.")>
278	<MethodImpl(MethodImplOptions.AggressiveInlining)>
279	<Extension> Public Sub ImprovedExtractToFile(<Parameter("Zip.Entry", "The zip entry we are pulling the file from")>
280	file As ZipArchiveEntry,
281	destinationPath$,
282	Optional overwriteMethod As Overwrite = Overwrite.IfNewer)
283	Call file.ExtractToFileInternal(destinationPath, overwriteMethod, Nothing)
284	End Sub
285
286	<ExportAPI("File.Zip")>
287	Public Sub FileArchive(file$, SaveZip$,
288	Optional action As ArchiveAction = ArchiveAction.Replace,
289	Optional fileOverwrite As Overwrite = Overwrite.IfNewer,
290	Optional compression As CompressionLevel = CompressionLevel.Optimal)
291
292	Call SaveZip.ParentPath.MkDIR
293	Call {file}.AddToArchive(SaveZip, action, fileOverwrite, compression)
294	End Sub
295
296	''' <summary>
297	'''
298	''' </summary>
299	''' <param name="DIR$"></param>
300	''' <param name="saveZip$"></param>
301	''' <param name="action"></param>
302	''' <param name="fileOverwrite"></param>
303	''' <param name="compression"></param>
304	''' <param name="flatDirectory">
305	''' 当这个参数为FALSE的时候，zip文件之中会保留有原来的文件夹的树形结构，
306	''' 反之，则zip文件之中不会存在任何文件夹结构，所有的文件都会被保存在zip文件里面的根目录之中
307	'''
308	''' 这个参数默认为False，即保留有原来的文件夹树形结构
309	''' </param>
310	<ExportAPI("DIR.Zip")>
311	Public Sub DirectoryArchive(DIR$, saveZip$,
312	Optional action As ArchiveAction = ArchiveAction.Replace,
313	Optional fileOverwrite As Overwrite = Overwrite.IfNewer,
314	Optional compression As CompressionLevel = CompressionLevel.Optimal,
315	Optional flatDirectory As Boolean = False)
316
317	' 2018-7-28 如果rel是空字符串
318	' 那么再压缩函数之中只会将文件名作为entry，即实现无文件树的效果
319	' 反之会使用相对路径生成文件树，即树状的非flat结构
320	Dim rel$ = DIR Or "".When(flatDirectory)
321
322	If Not rel.StringEmpty Then
323	rel = rel.GetDirectoryFullPath
324	End If
325
326	Call saveZip.ParentPath.MkDIR
327	Call (ls - l - r - "*.*" <= DIR) _
328	.AddToArchive(
329	archiveFullName:=saveZip,
330	action:=action,
331	fileOverwrite:=fileOverwrite,
332	compression:=compression,
333	relativeDIR:=rel.Replace("/"c, "\"c).Trim("\"c)
334	)
335	End Sub
336
337	''' <summary>
338	''' Allows you to add files to an archive, whether the archive
339	''' already exists or not
340	''' </summary>
341	''' <param name="archiveFullName">
342	''' The name of the archive to you want to add your files to
343	''' </param>
344	''' <param name="files">
345	''' A set of file names that are to be added
346	''' </param>
347	''' <param name="action">
348	''' Specifies how we are going to handle an existing archive
349	''' </param>
350	''' <param name="compression">
351	''' Specifies what type of compression to use - defaults to Optimal
352	''' </param>
353	'''
354	<ExportAPI("Zip.Add.Files", Info:="Allows you to add files to an archive, whether the archive already exists or not")>
355	<Extension>
356	Public Sub AddToArchive(<Parameter("files", "A set of file names that are to be added")> files As IEnumerable(Of String),
357	<Parameter("Zip", "The name of the archive to you want to add your files to")> archiveFullName$,
358	Optional action As ArchiveAction = ArchiveAction.Replace,
359	Optional fileOverwrite As Overwrite = Overwrite.IfNewer,
360	Optional compression As CompressionLevel = CompressionLevel.Optimal,
361	Optional relativeDIR$ = Nothing)
362
363	'Identifies the mode we will be using - the default is Create
364	Dim mode As ZipArchiveMode = ZipArchiveMode.Create
365
366	'Determines if the zip file even exists
367	Dim archiveExists As Boolean = IO.File.Exists(archiveFullName)
368
369	'Figures out what to do based upon our specified overwrite method
370	Select Case action
371	Case ArchiveAction.Merge
372	'Sets the mode to update if the file exists, otherwise
373	'the default of Create is fine
374	If archiveExists Then
375	mode = ZipArchiveMode.Update
376	End If
377
378	Case ArchiveAction.Replace
379	'Deletes the file if it exists.  Either way, the default
380	'mode of Create is fine
381	If archiveExists Then
382	IO.File.Delete(archiveFullName)
383	End If
384
385	Case ArchiveAction.[Error]
386	'Throws an error if the file exists
387	If archiveExists Then
388	Throw New IOException($"The zip file {archiveFullName.ToFileURL.CLIPath} already exists.")
389	End If
390
391	Case ArchiveAction.Ignore
392	'Closes the method silently and does nothing
393	If archiveExists Then
394	Return
395	End If
396
397	Case Else
398
399	End Select
400
401	'Opens the zip file in the mode we specified
402	Using zipFile As ZipArchive = IO.Compression.ZipFile.Open(archiveFullName, mode)
403
404	'This is a bit of a hack and should be refactored - I am
405	'doing a similar foreach loop for both modes, but for Create
406	'I am doing very little work while Update gets a lot of
407	'code.  This also does not handle any other mode (of
408	'which there currently wouldn't be one since we don't
409	'use Read here).
410
411	If mode = ZipArchiveMode.Create Then
412	Dim entryName$
413
414	For Each path As String In files
415	' Adds the file to the archive
416	If relativeDIR.StringEmpty Then
417	entryName = IO.Path.GetFileName(path)
418	Else
419	entryName = RelativePath(relativeDIR, path, appendParent:=False, fixZipPath:=True)
420	End If
421
422	Call zipFile.CreateEntryFromFile(path, entryName, compression)
423	Next
424	Else
425	For Each path As String In files
426	Dim fileInZip = (From f In zipFile.Entries Where f.Name = IO.Path.GetFileName(path)).FirstOrDefault()
427
428	Select Case fileOverwrite
429	Case Overwrite.Always
430
431	'Deletes the file if it is found
432	If fileInZip IsNot Nothing Then
433	fileInZip.Delete()
434	End If
435
436	'Adds the file to the archive
437	zipFile.CreateEntryFromFile(path, IO.Path.GetFileName(path), compression)
438
439	Case Overwrite.IfNewer
440
441	'This is a bit trickier - we only delete the file if it is
442	'newer, but if it is newer or if the file isn't already in
443	'the zip file, we will write it to the zip file
444
445	If fileInZip IsNot Nothing Then
446
447	'Deletes the file only if it is older than our file.
448	'Note that the file will be ignored if the existing file
449	'in the archive is newer.
450	If fileInZip.LastWriteTime < IO.File.GetLastWriteTime(path) Then
451	fileInZip.Delete()
452
453	'Adds the file to the archive
454	zipFile.CreateEntryFromFile(path, IO.Path.GetFileName(path), compression)
455	End If
456	Else
457	'The file wasn't already in the zip file so add it to the archive
458	zipFile.CreateEntryFromFile(path, IO.Path.GetFileName(path), compression)
459	End If
460
461	Case Overwrite.Never
462
463	'Don't do anything - this is a decision that you need to
464	'consider, however, since this will mean that no file will
465	'be writte.  You could write a second copy to the zip with
466	'the same name (not sure that is wise, however).
467
468	Case Else
469
470	End Select
471	Next
472	End If
473	End Using
474	End Sub
475	End Module
476	#End If
477	End Namespace