ZIP-архиватор на основе Zlib

*== Тестовый пример производит архивирование каталога %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

Автор публикации

не в сети 8 месяцев

admin

0
Комментарии: 0Публикации: 107Регистрация: 10-12-2000
0
Оставить комментарий
Авторизация
*
*
Генерация пароля