Работа с архивами ZIP средствами windows
Пример ниже показывает некоторые функции для работы с ZIP. Функции не объеденяются общим интерфейсом, то есть каждая из них самодостаточна и автономна. Есть возможность создать архив, распаковать, добавить файл в архив и вывести некоторые данные об файле\ах в архиве.
Платформа: Windows XP и выше
Компилятор: тестировалось на версии
1.03
#INCLUDE Once "windows.bi" #INCLUDE Once "win/shldisp.bi" #INCLUDE Once "win/shlwapi.bi" #INCLUDE Once "win/ole2.bi" '****************************************************************************************************************** ' Function: ExtractZip * ' Description: * ' Extract archive * ' Parameters: * ' szPathZip - the path to the ZIP file * ' szPathOutputFolder - the full path where you want to unpack * ' iOption - options,may be: * ' 0 default * ' 4 Do not display a progress dialog box. * ' 8 Give the file being operated on a new name in a move, copy, * ' or rename operation if a file with the target name already exists. * ' 16 Respond with "Yes to All" for any dialog box that is displayed. * ' 64 Preserve undo information, if possible. * ' 128 Perform the operation on files only if a wildcard file name (*.*) is specified. * ' 256 Display a progress dialog box but do not show the file names. * ' 512 Do not confirm the creation of a new directory if the operation requires one to be created. * ' 1024 Do not display a user interface if an error occurs. * ' 2048 Version 4.71. Do not copy the security attributes of the file. * ' 4096 Only operate in the local directory. Don't operate recursively into subdirectories. * ' 9182 Version 5.0. Do not copy connected files as a group. Only copy the specified files. * ' Examples: * ' All extract: * ' ExtractZip("C:\test.zip\*.*","C:\Test") * ' Extract one file: * ' ExtractZip("C:\test.zip\test.txt","C:\Test") * ' * '****************************************************************************************************************** Function ExtractZip(szPathZip As Zstring Ptr , szPathOutputFolder As Zstring Ptr , iOption As Integer = 0) As Integer Dim As Integer nLen Dim As BSTR bstrZip , bstrFol Dim As HRESULT hres Dim As IShellDispatch Ptr pSD Dim As Folder Ptr pOutFolder If PathIsDirectory(szPathOutputFolder) = 0 Then MessageBox(0,"Destination Folder does not exist!","Error",MB_ICONERROR) Return 0 Endif hres = CoCreateInstance(@CLSID_Shell, NULL, CLSCTX_SERVER ,@IID_IShellDispatch, @pSD) If SUCCEEDED(hres) And pSD <> 0 Then Dim As VARIANT vZipDir,vOutDir,vOptions VariantInit(@vZipDir) vZipDir.vt = VT_BSTR nLen = (lstrlen(szPathZip) + 1) * Sizeof(Wstring) bstrZip = SysAllocStringByteLen(NULL,nLen) MultiByteToWideChar(CP_ACP,0,szPathZip,-1,bstrZip,nLen) vZipDir.bstrVal = bstrZip VariantInit(@vOutDir) vOutDir.vt = VT_BSTR nLen = (lstrlen(szPathOutputFolder) + 1) * Sizeof(Wstring) bstrFol = SysAllocStringByteLen(NULL, nLen) MultiByteToWideChar(CP_ACP,0,szPathOutputFolder,-1,bstrFol,nLen) vOutDir.bstrVal = bstrFol If SUCCEEDED(pSD->lpVtbl->Namespace(pSD,vOutDir,@pOutFolder)) And pOutFolder <> 0 Then VariantInit(@vOptions) vOptions.vt=VT_I4 vOptions.lVal = iOption If SUCCEEDED(pOutFolder->lpVtbl->CopyHere(pOutFolder,vZipDir,vOptions)) Then Function = 1 Endif If pOutFolder Then pOutFolder->lpVtbl->Release(pOutFolder) VariantClear(@vOptions) Endif If pSD Then pSD->lpVtbl->Release(pSD) VariantClear(@vZipDir) VariantClear(@vOutDir) Endif End Function '*************************************************** ' Function: CreateEmptyZip * ' Description: * ' Create new empty archive * ' Parameters: * ' szPathZip - the name new ZIP file * ' Examples: * ' CreateEmptyZip("Test.zip") * ' * '*************************************************** Function CreateEmptyZip(szPathZip As Zstring Ptr) As Integer Dim As Handle hFile hFile = CreateFile(szPathZip,GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE,0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0) If hFile = INVALID_HANDLE_VALUE Then Return 0 Else Dim As Byte bArray(...) = {80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} Dim iBuf As Integer If WriteFile(hFile,Cast(LPCVOID,@bArray(0)),Ubound(bArray)+1,@iBuf,0) Then Function = 1 CloseHandle(hFile) Endif End Function '*************************************************************************************************************** ' Function: CopyFileInZip * ' Description: * ' Copy file in the archive * ' Parameters: * ' szPathZip - the path to the ZIP file * ' szPathFile - the full path to the file for archiving * ' iOption - options,may be: * ' 0 default * ' 4 Do not display a progress dialog box. * ' 8 Give the file being operated on a new name in a move, copy, * ' or rename operation if a file with the target name already exists. * ' 16 Respond with "Yes to All" for any dialog box that is displayed. * ' 64 Preserve undo information, if possible. * ' 128 Perform the operation on files only if a wildcard file name (*.*) is specified. * ' 256 Display a progress dialog box but do not show the file names. * ' 512 Do not confirm the creation of a new directory if the operation requires one to be created. * ' 1024 Do not display a user interface if an error occurs. * ' 2048 Version 4.71. Do not copy the security attributes of the file. * ' 4096 Only operate in the local directory. Don't operate recursively into subdirectories. * ' 9182 Version 5.0. Do not copy connected files as a group. Only copy the specified files. * ' Examples: * ' CopyFileInZip("C:\test.zip","C:\Test.txt") * ' or * ' CopyFileInZip("C:\test.zip\folder\","C:\Test.txt") * ' * '*************************************************************************************************************** Function CopyFileInZip(szPathZip As Zstring Ptr, szPathFile As Zstring Ptr, iOption As Integer = 0) As Integer Dim As Integer nLen Dim As BSTR bstrZip , bstrFol Dim As HRESULT hres Dim As Integer iCount, iTempCount Dim As IShellDispatch Ptr pSD Dim As Folder Ptr pOutFolder Dim As FolderItems Ptr pFolderItems If PathFileExists(szPathFile) = 0 Then MessageBox(0,"File does not exist!","Error",MB_ICONERROR) Return 0 Endif hres = CoCreateInstance(@CLSID_Shell, NULL, CLSCTX_SERVER ,@IID_IShellDispatch, @pSD) If SUCCEEDED(hres) And pSD <> 0 Then Dim As VARIANT vZipDir,vFile,vOptions VariantInit(@vZipDir) vZipDir.vt = VT_BSTR nLen = (lstrlen(szPathZip) + 1) * Sizeof(Wstring) bstrZip = SysAllocStringByteLen(NULL,nLen) MultiByteToWideChar(CP_ACP,0,szPathZip,-1,bstrZip,nLen) vZipDir.bstrVal = bstrZip VariantInit(@vFile) vFile.vt = VT_BSTR nLen = (lstrlen(szPathFile) + 1) * Sizeof(Wstring) bstrFol = SysAllocStringByteLen(NULL, nLen) MultiByteToWideChar(CP_ACP,0,szPathFile,-1,bstrFol,nLen) vFile.bstrVal = bstrFol If SUCCEEDED(pSD->lpVtbl->Namespace(pSD,vZipDir,@pOutFolder)) And pOutFolder <> 0 Then If SUCCEEDED(pOutFolder->lpVtbl->Items(pOutFolder,@pFolderItems)) And pFolderItems <> 0 Then If SUCCEEDED(pFolderItems->lpVtbl->get_Count(pFolderItems,@iCount)) Then iTempCount = iCount Endif Endif VariantInit(@vOptions) vOptions.vt=VT_I4 vOptions.lVal = iOption If SUCCEEDED(pOutFolder->lpVtbl->CopyHere(pOutFolder,vFile,vOptions)) Then Do Until iTempCount + 1 = iCount If SUCCEEDED(pOutFolder->lpVtbl->Items(pOutFolder,@pFolderItems)) And pFolderItems <> 0 Then If SUCCEEDED(pFolderItems->lpVtbl->get_Count(pFolderItems,@iCount)) Then Else Exit Do Endif Else Exit Do Endif Sleep(10) Loop Function = 1 Endif If pOutFolder Then pOutFolder->lpVtbl->Release(pOutFolder) If pFolderItems Then pFolderItems->lpVtbl->Release(pFolderItems) VariantClear(@vOptions) Endif If pSD Then pSD->lpVtbl->Release(pSD) VariantClear(@vZipDir) VariantClear(@vFile) Endif End Function '****************************************************************** ' Function: DisplayNameZip * ' Description: * ' Print the name and size of each file in a single folder * ' Parameters: * ' szPathZip - the path to the ZIP file * ' Examples: * ' DisplayNameZip("C:\test.zip") * ' or * ' DisplayNameZip("C:\test.zip\Folder") * ' * '****************************************************************** Function DisplayNameZip(szPathZip As Zstring Ptr) As Integer Dim As Integer nLen Dim As BSTR bstrZip , bstrName Dim As HRESULT hres Dim As Integer iCount, iInfoSize Dim As IShellDispatch Ptr pSD Dim As Folder Ptr pOutFolder Dim As FolderItems Ptr pFolderItems Dim As FolderItem Ptr pItem hres = CoCreateInstance(@CLSID_Shell, NULL, CLSCTX_SERVER ,@IID_IShellDispatch, @pSD) If SUCCEEDED(hres) And pSD <> 0 Then Dim As VARIANT vZipDir,vOptions VariantInit(@vZipDir) vZipDir.vt = VT_BSTR nLen = (lstrlen(szPathZip) + 1) * Sizeof(Wstring) bstrZip = SysAllocStringByteLen(NULL,nLen) MultiByteToWideChar(CP_ACP,0,szPathZip,-1,bstrZip,nLen) vZipDir.bstrVal = bstrZip If SUCCEEDED(pSD->lpVtbl->Namespace(pSD,vZipDir,@pOutFolder)) And pOutFolder <> 0 Then If SUCCEEDED(pOutFolder->lpVtbl->Items(pOutFolder,@pFolderItems)) And pFolderItems <> 0 Then If SUCCEEDED(pFolderItems->lpVtbl->get_Count(pFolderItems,@iCount)) Then If iCount > 0 Then For i As Integer = 0 To iCount-1 VariantInit(@vOptions) vOptions.vt=VT_I4 vOptions.lVal = i If SUCCEEDED(pFolderItems->lpVtbl->Item(pFolderItems,vOptions,@pItem)) And pItem <> 0 Then If SUCCEEDED(pItem->lpVtbl->get_Name(pItem,@bstrName)) And _ _ SUCCEEDED(pItem->lpVtbl->get_Size(pItem,@iInfoSize)) And _ _ bstrName <> 0 Then Print *bstrName , iInfoSize ' Print the name and size of each file Function = 1 Endif Endif Next Endif Endif Endif If pOutFolder Then pOutFolder->lpVtbl->Release(pOutFolder) If pFolderItems Then pFolderItems->lpVtbl->Release(pFolderItems) If pItem Then pItem->lpVtbl->Release(pItem) Endif If pSD Then pSD->lpVtbl->Release(pSD) VariantClear(@vZipDir) Endif End Function '*************************************************************************************** ' TEST * ' 1) Create empty ZIP archive * ' 1) Create file TXT * ' 3) Copy file TXT in the archive * ' 4) Display name and size file in the archive * ' 5) Create new folder "ExtractZipFile" * ' 6) Extract ZIP in the folder "ExtractZipFile" * ' * '*************************************************************************************** OleInitialize(NULL) If CreateEmptyZip("Test.zip") Then If CreateEmptyZip("test.txt") Then If CopyFileInZip("Test.zip","test.txt") Then DisplayNameZip("Test.zip") If CreateDirectory(Strptr("ExtractZipFile"),0) Then If ExtractZip("Test.zip\*.*",Exepath & "\ExtractZipFile") = 0 Then MessageBox(0,"Error extract!","Error",MB_ICONERROR) Endif Else MessageBox(0,"Error create folder!","Error",MB_ICONERROR) Endif Else MessageBox(0,"Error copy file in the archive!","Error",MB_ICONERROR) Endif Else MessageBox(0,"Error creating TXT file!","Error",MB_ICONERROR) Endif Else MessageBox(0,"Error creating archive!","Error",MB_ICONERROR) Endif Print "Press any key!" Sleep OleUninitialize()
