 |
| |
|
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
|
|
|
|  |
|
Конференция
