FoxPro Club Главная

Конференция Решения Фотоальбом Сайт М.Дроздова Статьи Файловый архив Книга Visual FoxPro 9.0 Русский Help для Visual FoxPro
Пользователей: 9210
Вход
ZIP-архиватор на основе Zlib

Полное архивирование директории с подкаталогами


 
Прислал: Дмитрий Аглямов   Категория: Система


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
 
Сделайте оценку этого решения Плохо Удовлетворительно Так себе Хорошо Отлично Текущая оценка: (4.519) Вложение [26.03]kb
Дополнения пользователей
ZIP-архиватор на основе Zlib
[+][?]
[Дополнить]



© 2000-2017 Fox Club 
При размещении любых материалов с сайта на других ресурсах- прямая ссылка на www.foxclub.ru обязательна
Яндекс.Метрика