*== Тестовый пример производит архивирование каталога %WinDir%system32 в файл C:TestZip.zip * * Пути можете подправить по собственному усмотрению. * Библиотека в приложении oTest = CREATEOBJECT("clsTest") oTest.SHOW(1) *===== Тестовый класс =====: DEFINE CLASS clsTest AS FORM CAPTION = "Тест архивирования" ADD OBJECT btnOk AS CommandButton WITH ; LEFT = 10, ; TOP = 10, ; WIDTH = 50, ; HEIGHT = 25, ; CAPTION = "Start" *===== Тестовое архивирование =====: PROC btnOk.CLICK LOCAL lcWinDir lcWinDir = ADDBS(GETENV("windir")) + "System32" IF !PEMSTATUS(THISFORM, "test", 5) THISFORM.AddObject("test", "clsZip", 5, THISFORM.HEIGHT-25, THISFORM.WIDTH-10, 20) ENDIF THISFORM.test.Zip(lcWinDir + "*.*", "C:TestZip", "r") ENDPROC && btnOk.CLICK ENDDEFINE && clsTest ************************************************************** * СОЗДАНИЕ ZIP-АРХИВА * * (c) Copyright 2004 by Dmitry Aglyamov * * РЕСУРСЫ: * Библиотека ZLib.dll * MS ProgressBar * * ИСПОЛЬЗОВАНИЕ: * 1. Создаем в форме контрол на основе класса clsZip * 2. Вызываем метод Zip(tcSourceFiles, tcZipFile, tcOptions) * При архивировании каталога обязательно указывать шаблон * архивируемых файлов, как при вызове ADIR() * ************************************************************** DEFINE CLASS clsZip AS Control SPECIALEFFECT = 0 BORDERWIDTH = 0 ADD OBJECT oleProcess AS OleControl WITH ; OLECLASS = 'MSComctlLib.ProgCtrl.2' *===== Инициализация =====: PROC INIT (tnLt, tnTp, tnWt, tnHt) THIS.LEFT = tnLt THIS.TOP = tnTp THIS.WIDTH = tnWt THIS.HEIGHT = tnHt THIS.oleProcess.SCROLLING = 1 THIS.VISIBLE = .T. ENDPROC && INIT *===== СОЗДАНИЕ ZIP-АРХИВА ===== : PROC Zip (tcFiles, tcZip, tcStat) * tcFiles - Путь архивируемого каталога / файла * tcZip - Файл ZIP-архива * tcStat - r включать подкаталоги LOCAL lHndlZip, ; lcAtr,lcPathSave tcStat = IIF(VARTYPE(tcStat) = "C", tcStat, "") tcFiles = ALLTRIM(tcFiles) lcAtr = "ASHR" + IIF("r" $ tcStat, "D", "") tcZip = ALLTRIM(tcZip) IF UPPER(RIGHT(tcZip, 4)) # ".ZIP" tcZip = tcZip + ".ZIP" ENDIF THIS.oleProcess.VALUE = 0 *=== Чтобы не писать полные пути в архиве переходим в нужный каталог : lcPathSave = SYS(5)+SYS(2003) IF OCCURS("", tcFiles) > 1 SET DEFAULT TO LEFT(tcFiles, RAT("", tcFiles)) tcFiles = LEFT(tcFiles, AT("", tcFiles)-1) + "*.*" ENDIF *=== Определяем размер архивируемых файлов (для скроллера) : THIS.oleProcess.MAX = THIS.GetSizeDir(tcFiles, lcAtr) *=== Инициализация библиотеки Zip-архиватора : DECLARE INTEGER zipOpen IN ZLib STRING cPath, INTEGER cMode DECLARE INTEGER zipOpenNewFileInZip IN ZLib ; INTEGER IdFile, STRING NameFile, STRING InfoFile, STRING ExtLocal, ; INTEGER SizeExtLocal, STRING ExtGlobal, INTEGER SizeExtGlobal, ; STRING Comment, INTEGER Method, INTEGER Level DECLARE INTEGER zipWriteInFileInZip IN ZLib INTEGER IdFile, STRING @Buf, LONG LenBuf DECLARE INTEGER zipCloseFileInZip IN ZLib INTEGER IdFile DECLARE INTEGER zipClose IN ZLib INTEGER IdFile, STRING Comment lHndlZip = ZipOpen(tcZip, 0) THIS.pZipFiles(lHndlZip, tcFiles, lcAtr) ZipClose(lHndlZip, "") THIS.oleProcess.VALUE = 0 CLEAR DLLS zipOpen, zipOpenNewFileInZip, zipWriteInFileInZip, zipCloseFileInZip, zipClose SET DEFAULT TO (lcPathSave) ENDPROC && Zip *===== Архивация файлов каталога =====: PROC pZipFiles (tHndlZip, tcFiles, tcAtr) * tHndlZip - Хендл Zip-файла * tcFiles - Полный путь каталога с шаблоном выбираемых файлов * tcAtr - Атрибуты выбираемых файлов LOCAL laFiles[1,1], ; lHndlFile,i, ; lcZipFileInfo,lcPath,lcBuff lnAllFiles = ADIR(laFiles, tcFiles, tcAtr, 1) FOR i=1 TO lnAllFiles IF INLIST(laFiles[i, 1], ".", "..") LOOP ENDIF lcPath = IIF("" $ tcFiles, LEFT(tcFiles, RAT("", tcFiles)), "") lcZipFileInfo = THIS.fGetZipFileInfo(DTOC(laFiles[i, 3]),laFiles[i, 4],laFiles[i, 5]) ZipOpenNewFileInZip(tHndlZip, CPCONVERT(1251, 866, lcPath+laFiles[i, 1]), ; @lcZipFileInfo, 0, 0, 0, 0, "", 8,-1) lHndlFile = FOPEN(lcPath + laFiles[i, 1]) DO WHILE !FEOF(lHndlFile) lcBuff = FREAD(lHndlFile, 65536) ZipWriteInFileInZip(tHndlZip, @lcBuff, LEN(lcBuff)) THIS.oleProcess.VALUE = THIS.oleProcess.VALUE + LEN(lcBuff) ENDDO FCLOSE(lHndlFile) ZipCloseFileInZip(tHndlZip) IF CHRSAW() AND INKEY() = 27 RETURN .F. ENDIF IF "D" $ laFiles[i, 5] AND "D" $ tcAtr IF !THIS.pZipFiles(tHndlZip, lcPath + laFiles[i, 1] + "*.*", tcAtr) RETURN .F. ENDIF ENDIF ENDFOR ENDPROC && pZipFiles *===== Формирование структуры информации файла, записываемого в Zip-архив =====: PROC fGetZipFileInfo (tcDate, tcTime, tcAttrib) * tcDate - дата создания файла * tcTime - время создания файла * tcAttrib - атрибут файла * typedef struct * { * tm_zip tmz_date; /* date in understandable format */ * uLong dosDate; /* if dos_date == 0, tmu_date is used */ * uLong internal_fa; /* internal file attributes 2 bytes */ * uLong external_fa; /* external file attributes 4 bytes */ * } zip_fileinfo; * typedef struct tm_zip_s * { * uInt tm_sec; /* seconds after the minute - [0,59] */ * uInt tm_min; /* minutes after the hour - [0,59] */ * uInt tm_hour; /* hours since midnight - [0,23] */ * uInt tm_mday; /* day of the month - [1,31] */ * uInt tm_mon; /* months since January - [0,11] */ * uInt tm_year; /* years - [1980..2044] */ * } tm_zip LOCAL lnAttrib,i, ; lcZipFileInfo lcZipFileInfo = "" FOR i=3 TO 1 STEP -1 lcZipFileInfo = lcZipFileInfo + ; THIS.DigitAsString(VAL(STREXTRACT(":"+tcTime+":", ":", ":", i))) ENDFOR FOR i=1 TO 3 lcZipFileInfo = lcZipFileInfo + ; THIS.DigitAsString(VAL(STREXTRACT("/"+tcDate+"/", "/", "/", i)) - ; IIF(i = 2, 1, 0)) ENDFOR lcZipFileInfo = lcZipFileInfo + THIS.DigitAsString(0) lcZipFileInfo = lcZipFileInfo + THIS.DigitAsString(0) lnAttrib = 0 FOR i=1 TO 6 IF SUBSTR("RHSVDA", i, 1) $ UPPER(tcAttrib) lnAttrib = BITSET(lnAttrib, i-1) ENDIF ENDFOR lcZipFileInfo = lcZipFileInfo + THIS.DigitAsString(lnAttrib) RETURN lcZipFileInfo ENDPROC && fGetZipFileInfo *===== ОПРЕДЕЛЕНИЕ РАЗМЕРА КАТАЛОГА (в байтах) =====: PROC GetSizeDir (tcFiles, tcAtr) * tcFiles - Полный путь каталога с шаблоном выбираемых файлов * tcAtr - Атрибуты выбираемых файлов LOCAL laFiles[1,1], ; lnAllBytes,i, ; lcPath lnAllBytes = 0 FOR i=1 TO ADIR(laFiles, tcFiles, tcAtr, 1) IF INLIST(laFiles[i, 1], ".", "..") LOOP ENDIF IF "D" $ laFiles[i, 5] AND "D" $ tcAtr lcPath = IIF("" $ tcFiles, LEFT(tcFiles, RAT("", tcFiles)), "") lnAllBytes = lnAllBytes + THIS.GetSizeDir(lcPath + laFiles[i, 1] + "*.*", tcAtr) ELSE lnAllBytes = lnAllBytes + laFiles[i, 2] ENDIF ENDFOR RETURN lnAllBytes ENDPROC && GetSizeDir *===== Возвращает число в виде строки чисел типа DWORD =====: PROC DigitAsString (tnInteger) RETURN CHR(BITAND(tnInteger, 255)) + CHR(BITAND(BITRSHIFT(tnInteger, 8), 255)) + ; CHR(BITAND(BITRSHIFT(tnInteger, 16), 255)) + CHR(BITAND(BITRSHIFT(tnInteger, 24), 255)) ENDPROC && DigitAsString *===== Ширина контрола =====: PROC WIDTH_ASSIGN (tnVal) STORE tnVal TO THIS.WIDTH, THIS.oleProcess.WIDTH ENDPROC && WIDTH_ASSIGN *===== Высота контрола =====: PROC HEIGHT_ASSIGN (tnVal) STORE tnVal TO THIS.HEIGHT, THIS.oleProcess.HEIGHT ENDPROC && HEIGHT_ASSIGN ENDDEFINE && clsZip
Автор: Dmitry Aglyamov