Member ! Класс для создания Zlib архивов ! Коды завершения ZipFILETIME GROUP,TYPE dwLowDateTime ULONG dwHighDateTime ULONG END ZipWIN32_FIND_DATA GROUP,TYPE dwFileAttributes ULONG ftCreationTime GROUP(ZipFILETIME). ftLastAccessTime GROUP(ZipFILETIME). ftLastWriteTime GROUP(ZipFILETIME). nFileSizeHigh ULONG nFileSizeLow ULONG dwReserved0 ULONG dwReserved1 ULONG cFileName CSTRING( FILE:MaxFilePath ) cAlternateFileName CSTRING( 14 ) END ZipSYSTEMTIME GROUP,TYPE wYear USHORT wMonth USHORT wDayOfWeek USHORT wDay USHORT wHour USHORT wMinute USHORT wSecond USHORT wMilliseconds USHORT END uInt Equate(Unsigned) ZipFileInfo GROUP,TYPE !Evgeny Stefanenko заменил в группе USHORT на UNSIGNED даты и время внутри ZIP файла стали корректные tm_sec UInt ! /* seconds after the minute - [0,59] */ tm_min UInt ! /* minutes after the hour - [0,59] */ tm_hour UInt ! /* hours since midnight - [0,23] */ tm_mday UInt ! /* day of the month - [1,31] */ tm_mon UInt ! /* months since January - [0,11] */ tm_year UInt ! /* years - [1980..2044] */ ! dosDate ULONG ! /* if dos_date == 0, tmu_date is used */ Flag ULONG Internal_Fa ULONG ! internal_fa; /* internal file attributes 2 bytes */ External_Fa ULONG ! external_fa; /* external file attributes 4 bytes */ Reserv STRING(200) END ! Структура глобальных данных Zip-файла ! Данные Выводятся после каталога unz_global_info GROUP,TYPE number_entry ULONG ! Количество записей корневой директории size_comment UlONG ! Длина глобального комментария Reserv STRING(200) END !typedef struct unz_file_info_s !{ ! uLong version; /* version made by 2 bytes */ ! uLong version_needed; /* version needed to extract 2 bytes */ ! uLong flag; /* general purpose bit flag 2 bytes */ ! uLong compression_method; /* compression method 2 bytes */ ! uLong dosDate; /* last mod file date in Dos fmt 4 bytes */ ! uLong crc; /* crc-32 4 bytes */ ! uLong compressed_size; /* compressed size 4 bytes */ ! uLong uncompressed_size; /* uncompressed size 4 bytes */ ! uLong size_filename; /* filename length 2 bytes */ ! uLong size_file_extra; /* extra field length 2 bytes */ ! uLong size_file_comment; /* file comment length 2 bytes */ ! ! uLong disk_num_start; /* disk number start 2 bytes */ ! uLong internal_fa; /* internal file attributes 2 bytes */ ! uLong external_fa; /* external file attributes 4 bytes */ ! ! tm_unz tmu_date; !} unz_file_info; ! Структура записи информации о файле unz_file_info GROUP,TYPE Version ULONG ! Версия архиватора Version_Needed ULONG ! Версия распаковщика Flag ULONG ! Compression_method ULONG ! Метод сжатия DosDate ULONG ! Дата ДОС crc ULONG ! crc-32 compressed_size ULONG ! uncompressed_size ULONG ! size_filename ULONG ! Длина имени файла size_file_extra ULONG ! Длина доп.данных size_file_comment ULONG ! Длина примечаний disk_num_start ULONG ! Номер первого диска internal_fa ULONG ! internal file attributes external_fa ULONG ! external file attributes tm_sec UNSIGNED ! /* seconds after the minute - [0,59] */ tm_min UNSIGNED ! /* minutes after the hour - [0,59] */ tm_hour UNSIGNED ! /* hours since midnight - [0,23] */ tm_mday UNSIGNED ! /* day of the month - [1,31] */ tm_mon UNSIGNED ! /* months since January - [0,11] */ tm_year UNSIGNED ! /* years - [1980..2044] */ Reserv STRING(200) ! END Include('Zipclass.inc'),Once Map ExtractPath(String),String NormDir(String),String Module('C Library') ZipFnSplit(*cstring,*cstring,*cstring,*cstring,*cstring),signed,raw,name('_fnsplit') ZipFindFirstFile(*Cstring,*Group),Long,PASCAL,RAW,Name('FindFirstFileA') ZipLocalFileTimeToFileTime(*Group,*Group),BOOL,PASCAL,RAW,Name('LocalFileTimeToFileTime') ZipSystemTimeToFileTime(*Group,*Group),BOOL,PASCAL,RAW,Name('SystemTimeToFileTime') ZipSetFileTime(Long,Long,Long,Long),BOOL,PASCAL,RAW,Name('SetFileTime') ZipFindClose(Long),BOOL,PASCAL,Name('FindClose') ZipCreateFile(*Cstring,Ulong,Ulong,Ulong,Ulong,Ulong,Long),Long,PASCAL,RAW,Name('CreateFileA') ZipCloseHandle(Long),BOOL,PASCAL,Name('CloseHandle') ZipCreateDirectory(*CSTRING,Long),BOOL,PASCAL,RAW,Name('CreateDirectoryA') End MODULE('Zlib Library') ! Сжатие блока в памяти Compress(Long AddrDest,*ULong DestLen, Long AddrSrc, Ulong SrcLen),Short,Pascal,Name('compress'),DLL ! Распаковка блока в памяти UnCompress(Long AddrDest,*ULong DestLen, Long AddrSrc, Ulong SrcLen),Short,Pascal,Name('uncompress'),DLL ! Открытие архива zipOpen (*CString,Short append=0),Long,Pascal,Raw,Name('ZipOpen') ! Открытие файла на запись в Zip zipOpenNewFileInZip(Long file, | *CString Filename, | Имя файла в Zip *Group ZipInfo, | Cсылка на атрибуты файла Ulong extrafield_local, | Адрес доп информации лок uShort size_extrafield_local, | Длина доп информ Ulong extrafield_global, | Адрес доп информации глоб uShort size_extrafield_global, | Длина доп информ *CString comment, | примечание Short method=8, | метод упаковки (0 - без упак, 8 для сжатия) Short level=0 | уровень - 0 по умолчанию ),Short,Pascal,Raw,Name('ZipOpenNewFileInZip') ! Запись буфера в Zip zipWriteInFileInZip (Long file, | файл Ulong AddrBuf, | Адрес буфера Ulong Buflen | Длина буфера ), Short,Pascal,Name('ZipWriteInFileInZip') ! Завершение записи файла в Zip zipCloseFileInZip (Long file), Short,Pascal,Name('ZipCloseFileInZip') ! Закрытие Zip zipClose (Long file, *CString global_comment), Short,Pascal,Raw,Name('ZipClose') ! Сравнение имён двух файлов unzStringFileNameCompare (*Cstring fileName1, | *CString fileName2, | Short iCaseSensitivity),Short,Pascal,Raw,Name('UnzStringFileNameCompare') ! If iCaseSenisivity = 1, comparision is case sensitivity (like strcmp) ! If iCaseSenisivity = 2, comparision is not case sensitivity (like strcmpi ! or strcasecmp) !If iCaseSenisivity = 0, case sensitivity is defaut of your operating system ! Открытие на распаковку unzOpen (*Cstring path),Long,Pascal,Raw,Name('UnzOpen') ! Open a Zip file. path contain the full pathname ! If the zipfile cannot be opened (file don't exist or in not valid), the ! return value is NULL. !Else, the return value is a unzFile Handle, usable with other function !of this unzip package. ! Закрытие архива unzClose (Long file),Short,Pascal,Raw,Name('UnzClose') ! Close a ZipFile opened with unzipOpen. ! If there is files inside the .Zip opened with unzOpenCurrentFile (see later), ! these files MUST be closed with unzipCloseCurrentFile before call unzipClose. ! return UNZ_OK if there is no problem. ! Чтение глобальной информации unzGetGlobalInfo (Long file, *Group global_info),Short,Pascal,Raw,Name('UnzGetGlobalInfo') !Write info about the ZipFile in the *pglobal_info structure. ! return UNZ_OK if there is no problem. unzGetGlobalComment (Long file,*Cstring Comment, uLong uSizeBuf),Short ! Get the global comment string of the ZipFile, in the Comment buffer. ! uSizeBuf is the size of the Comment buffer. ! return the number of byte copied or an error code <0 !*************************************************************************! ! Unzip package allow you browse the directory of the zipfile ! !*************************************************************************! unzGoToFirstFile (Long file),Short,Pascal,Raw,Name('UnzGotoFirstFile') ! Set the current file of the zipfile to the first file. ! return UNZ_OK if there is no problem unzGoToNextFile (Long file),Short,Pascal,Raw,Name('UnzGotoNextFile') ! Set the current file of the zipfile to the next file. ! return UNZ_OK if there is no problem ! return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest. unzLocateFile (Long file, | *CString FileName, | Short iCaseSensitivity),Short,Pascal,Raw,Name('UnzLocateFile') ! Try locate the file szFileName in the zipfile. ! For the iCaseSensitivity signification, see unzStringFileNameCompare ! return value : ! UNZ_OK if the file is found. It becomes the current file. ! UNZ_END_OF_LIST_OF_FILE if the file is not found unzGetCurrentFileInfo (Long file, | *Group file_info, | *Cstring FileName, | uLong fileNameBufferSize, | ULong AddrextraField, | uLong extraFieldBufferSize, | *CString Comment, | uLong commentBufferSize),Short,Pascal,Raw,Name('UnzGetCurrentFileInfo') !Get Info about the current file !if file_info!=NULL, the *pfile_info structure will contain somes info about ! the current file !if FileName!=NULL, the filemane string will be copied in szFileName ! (fileNameBufferSize is the size of the buffer) !if extraField!=NULL, the extra field information will be copied in extraField ! (extraFieldBufferSize is the size of the buffer). ! This is the Central-header version of the extra field !if Comment!=NULL, the comment string of the file will be copied in szComment ! (commentBufferSize is the size of the buffer) !*************************************************************************** ! for reading the content of the current zipfile, you can open it, read data ! from it, and close it (you can close it before reading all the file) !************************************************************************* unzOpenCurrentFile (Long file),Short,Pascal,Raw,Name('UnzOpenCurrentFile') ! Open for reading data the current file in the zipfile. ! If there is no error, the return value is UNZ_OK. unzCloseCurrentFile (Long file),Short,Pascal,Raw,Name('UnzCloseCurrentFile') ! Close the file in zip opened with unzOpenCurrentFile ! Return UNZ_CRCERROR if all the file was read but the CRC is not good unzReadCurrentFile (Long file, ULong AddrBuf, unsigned len), | Short,Pascal,Raw,Name('UnzReadCurrentFile'); ! Read bytes from the current file (opened by unzOpenCurrentFile) ! Addrbuf contain Address of buffer where data must be copied ! len the size of buffer. ! return the number of byte copied if somes bytes are copied ! return 0 if the end of file was reached ! return <0 with error code if there is an error ! (UNZ_ERRNO for IO error, or zLib error for uncompress error) unztell (Long file),ULong,Pascal,Raw,Name('Unztell') ! Give the current position in uncompressed data unzeof (Long file),Short,Pascal,Raw,Name('Unzeof') ! return 1 if the end of file was reached, 0 elsewhere unzGetLocalExtrafield (Long file,Ulong Addrbuf,unsigned len), | Short,Pascal,Raw,Name('UnzGetLocalExtraField') ! Read extra field from the current file (opened by unzOpenCurrentFile) ! This is the local-header version of the extra field (sometimes, there is ! more info in the local-header version than in the central-header) ! if Addrbuf==NULL, it return the size of the local extra field ! if Addrbuf!=NULL, len is the size of the buffer, the extra header is copied in ! buf. ! the return value is the number of bytes copied in buf, or (if <0) ! the error code END ! Module End ! Map ExtractPath PROCEDURE(STRING Inp:Path) ! Обрезает Path. Написана Е.Стефаненко LOC:Path CSTRING(256) LOC:Drive CSTRING(256) LOC:Dir CSTRING(256) LOC:File CSTRING(256) LOC:Ext CSTRING(256) CODE LOC:Path = INP:Path IF INSTRING(UPPER(PATH()), UPPER(INP:Path), 1, 1) = 1 LOC:Path = SUB(INP:Path, LEN(PATH())+1, 256) END IF INSTRING(UPPER(LONGPATH()), UPPER(INP:Path), 1, 1) = 1 LOC:Path = SUB(INP:Path, LEN(LONGPATH())+1, 256) END IF ZipFnSplit(LOC:Path,LOC:Drive,LOC:Dir,LOC:File,LOC:Ext) END IF SUB(LOC:Dir,1,2) = '.\' RETURN(NormDir(CLIP(SUB(LOC:Dir,3,256)))) END IF LOC:Dir[1,1] = '\' RETURN(NormDir(CLIP(SUB(LOC:Dir,2,256)))) END RETURN(NormDir(CLIP(LOC:Dir))) NormDir PROCEDURE(STRING InPath) CODE IF CLIP(InPath) = '' THEN RETURN ('') END IF SUB(CLIP(InPath),-1,1) = '\' RETURN(InPath) ELSE RETURN(CLIP(InPath)&'\') END ! --------------------- Конструктор ------------------ ZipClass.Construct Procedure() Code Self.ZipFile=-1 Self.ZipDirectory &= New(File:Queue) Return ! --------------------- Деструктор ------------------ ZipClass.Destruct Procedure() Code If Self.Mode<>'' Then Self.ZipClose(). Free(Self.ZipDirectory) Dispose(Self.ZipDirectory) Return ! --------------------- Открыть архив на запись ------------------ ZipClass.ZipCreate Procedure(String FileName_IN,Long AppendMode, *String FilenameZip_Created) Loc:ZipFileName CString(256) CODE ! Создать Zip-файл loc:ZipFileName=Clip(FileName_IN) If ~Instring('.',Loc:ZipFileName,1,1) Loc:ZipFileName=Clip(Loc:ZipFileName) & '.zip' End Self.Mode='W' Self.ZipFile=zipOpen(Loc:ZipFileName,AppendMode) If Self.ZipFile<>0 Self.Mode='W' ! Режим записи Self.Throw('Создаётся архив ' & Loc:ZipFileName ,0 ) ! loc:ZipFileName после zipOpen(Loc:ZipFileName,AppendMode) FilenameZip_Created = clip(Loc:ZipFileName) ! &'.zip' ! Self.Throw('Created выходной файл ' & Loc:ZipFileName ,1) ! Self.Throw('Created выходной файл ' & FilenameZip_Created ,1) Return(0) ! успешно создан ! это фактическое имя zip файла. оно могло обрЕзаться при выполнении zipOpen Else FilenameZip_Created = '' Self.Throw('Не удалось создать выходной файл ' & Loc:ZipFileName ) Return(1) End ! -------------------- Открыть архив на чтение ------------------- ZipClass.ZipOpen Procedure(String FileName) ! Открыть файл на чтение Loc:FN CString(260) FinFo Group(unz_file_Info),Pre(Fi) End Loc:Comment Cstring(500) Code Self.Mode='R' Loc:FN=Clip(FileName) If ~Instring('.',Loc:FN,1,1) Loc:FN=Clip(Loc:FN) & '.zip' End Self.ZipFile=unzOpen(Loc:FN) If Self.Zipfile<0 Self.ErrorCode=Self.ZipFile Self.Throw(Self.Error) Return(1) End ! Cчитываем содержимое архива Self.ErrorCode=UnzGoToFirstFile(Self.ZipFile) If Self.ErrorCode Self.Throw(Self.Error) Return(Self.ErrorCode) End Free(Self.ZipDirectory) ! unzGetCurrentFileInfo (Long file, | ! *Group file_info, | ! *Cstring FileName, | ! uLong fileNameBufferSize, | ! ULong AddrextraField, | ! uLong extraFieldBufferSize, | ! *CString Comment, | ! uLong commentBufferSize),Short,Pascal,Raw,Name('UnzGetCurrentFileInfo') Loop If unzGetCurrentFileInfo (Self.ZipFile,FinFo,Loc:FN,Size(Loc:FN),0,0,Loc:Comment,Size(Loc:Comment)). Clear(Self.ZipDirectory) CONVERTOEMTOANSI(Loc:FN) ! Имя файла в ANSI... Self.ZipDirectory.Name=Loc:FN Self.ZipDirectory.Date=Date(Fi:Tm_mon+1,Fi:Tm_mDay,Fi:tm_Year) Self.ZipDirectory.Time=(((Fi:tm_hour)*60+Fi:tm_min)*60+Fi:tm_sec)*100 Self.ZipDirectory.Size=Fi:uncompressed_Size Add(Self.ZipDirectory,+Self.ZipDirectory.Name) If unzGoToNextFile(Self.ZipFile) Break End End Self.Throw('Открыт архив:' & FileName & '. Файлов:' & Records(Self.ZipDirectory),0) Return(0) ZipClass.ZipDirectory Procedure(File:Queue FQ) Code Free(FQ) SaveDir#=Pointer(Self.ZipDirectory) Loop Dir#=1 to Records(Self.ZipDirectory) Get(Self.ZipDirectory,Dir#) FQ=Self.ZipDirectory Add(FQ) End Get(Self.ZipDirectory,SaveDir#) Return ! ------------------- Распаковать из архива --------------------- ZipClass.ZipUnpack Procedure(String FileName) ! Распаковать файл(ы) в указанный каталог GENERIC_ALL EQUATE(10000000H) FILE_SHARE_READ EQUATE(00000001H) OPEN_EXISTING EQUATE(3) FILE_ATTRIBUTE_NORMAL EQUATE(00000080H) Loc:Template Cstring(256) Loc:FileName CString(260),Static Loc:FileNameOEM CString(260) BufSize Equate(32767) Tmp File,Driver('DOS'),Name(Loc:FileName),Pre(Tmp),Create Record Record S String(BufSize) End End FinFo Group(unz_file_Info),Pre(Fi) End FileHandle Long FileFindGroup GROUP(ZipWIN32_FIND_DATA) End FindFile CSTRING(260) TempFileTime GROUP(ZipFILETIME) End TempLocalFileTime GROUP(ZipFILETIME) End TempSystemTime Group(ZipSystemTime) End Loc:Res Long Loc:Res2 Long Loc:Comment CString(256) Loc:Dir Cstring(260) Code If FileName='' Loc:Template='*.*' Else Loc:Template=FileName End Loop Dir#=1 to Records(Self.ZipDirectory) Get(Self.ZipDirectory,Dir#) If Self.ZipValidateRecord(Clip(Self.ZipDirectory.Name)) Cycle End If Match(Upper(Self.ZipDirectory.Name),Upper(Loc:Template),Match:Wild) ! Имя файла подходящее... Loc:FileName=Clip(Self.ZipDirectory.Name) Loc:FileNameOEM=Loc:FileName CONVERTANSITOOEM(Loc:FileNameOEM) ! Имя файла в ANSI If Exists(Loc:FileName) Remove(Loc:FileName) End ! Проверим, есть ли каталог Loop Pos#=Len(Loc:FileName) to 1 By -1 If Loc:FileName[Pos#]='\' Loc:Dir=Loc:FileName[1:Pos#-1] If ~Exists(Loc:Dir) If ZipCreateDirectory(Loc:Dir,0). If ~Exists(Loc:Dir) Self.Throw('Не удалось создать каталог ' & Loc:Dir) Return(1) End End End End Create(Tmp) Open(Tmp) If ErrorCode() Self.Throw('Невозможно создать файл ' & Loc:FileName,1) Self.ZipClose() Return(1) End ! Распаковываем файл Self.ErrorCode=unzLocateFile(Self.ZipFile,Loc:FileNameOEM,0) If Self.ErrorCode Self.Throw('Файл ' & Loc:FileName & ' не найден в архиве!',1) Cycle End ! ! Считываем данные о файле ! unzGetCurrentFileInfo (Long file, | ! *Group file_info, | ! *Cstring FileName, | ! uLong fileNameBufferSize, | ! ULong AddrextraField, | ! uLong extraFieldBufferSize, | ! *CString Comment, | ! uLong commentBufferSize),Short,Pascal,Raw,Name('UnzGetCurrentFileInfo') If unzGetCurrentFileInfo (Self.ZipFile,FinFo,Loc:FileNameOEM,Size(Loc:FileNameOEM),0,0,Loc:Comment,Size(Loc:Comment)). Self.ErrorCode=UnzOpenCurrentFile(Self.ZipFile) If Self.ErrorCode Self.Throw('Файл ' & Loc:FileName & ' не удаётся прочитать из архива:' & Self.ZipError() ,1) Cycle End ! Файл должен быть ваще-то Set(Tmp) Loop Pos#=1 To Fi:Uncompressed_Size By BufSize Loc:Res2=unzReadCurrentFile(Self.ZipFile, Address(Tmp:S), BufSize) If Loc:Res2>0 Add(Tmp,Loc:Res2) If ErrorCode() Self.Throw('Ошибка записи в файл ' & Loc:FileName & ' ' & Error(),1) If UnzCloseCurrentFile(Self.ZipFile). Return(1) End Elsif Loc:Res2<=0 Break End End If UnzCloseCurrentFile(Self.ZipFile). Close(Tmp) Self.Throw('Распакован файл:' & Loc:FileName,0) FileHandle = ZipCreateFile(Loc:FileName, Generic_All, File_Share_Read, 0, Open_Existing, FILE_ATTRIBUTE_NORMAL,0) Clear(TempSystemTime) TempSystemTime.wYear=Fi:tm_year TempSystemTime.wMonth=Fi:tm_mon+1 ! Месяцы нумеруются с 0... TempSystemtime.wDay=Fi:tm_mday !TempSystemtime.wDayofweek=Date(Fi:tm_mon,FI:tm_mday,FI:tm_year) % 7 TempSystemTime.wHour=Fi:tm_Hour TempSystemTime.wMinute=Fi:tm_min TempSystemTime.wSecond=Fi:tm_sec If ZipSystemtimeToFileTime(TempSystemTime,TempLocalFileTime). If ZipLocalFiletimeToFileTime(TempLocalFileTime,TempFileTime). If ZipSetFileTime(FileHandle,0,0,Address(TempFileTime)). If ZipCloseHandle(FileHandle). End ! If Match End ! Loop Return(0) ZipClass.Throw Procedure(String S,Long Level) ! Выдача сообщений об ошибке. Code ! Виртуальный метод может перехватить If Level>0 Message(S,'Ошибка!',Icon:Asterisk) ! и выводить в зависимости от... End Return(Level) ZipClass.ZipValidateRecord Procedure(String S) ! Проверка необходимости упаковки файла Code Return(0) ZipClass.ZipClose Procedure() Loc:Comment CString('') Code Case Self.Mode Of 'W' Self.ErrorCode=zipClose(Self.ZipFile,Loc:Comment) If Self.ErrorCode Self.Throw(Self.Error,1) Else Self.Throw('Упаковка завершена',0) End Of 'R' Self.ErrorCode=UnzClose(Self.ZipFile) If Self.ErrorCode Self.Throw(Self.Error,1) Else Self.Throw('Распаковка завершена',0) End End Self.Mode='' Self.ZipFile=-1 Return ZipClass.ZipErrorCode Procedure() Code Return(Self.ErrorCode) ZipClass.ZipError Procedure() ZIP_OK EQUATE(0) ZIP_ERRNO EQUATE(-1) ZIP_PARAMERROR EQUATE(-102) ZIP_INTERNALERROR EQUATE(-104) UNZ_OK EQUATE(0) UNZ_END_OF_LIST_OF_FILE Equate (-100) UNZ_ERRNO EQUATE(-1) UNZ_EOF EQUATE(0) UNZ_PARAMERROR EQUATE(-102) UNZ_BADZIPFILE EQUATE(-103) UNZ_INTERNALERROR EQUATE(-104) UNZ_CRCERROR EQUATE(-105) Message CString(100) Code Case Self.ErrorCode Of Zip_OK Orof Unz_OK Of Zip_InternalError If Self.Mode='W' Message='Внутренняя ошибка упаковки' Else Message='Внутренняя ошибка распаковки' End Of Unz_BadZipFile Message='Плохой архив' Of Unz_CRCError Message='Неверная контрольная сумма' End Return(Message) !---------------------------- Добавление файлов в архив ------------------------ ZipClass.ZipAddFile Procedure(String FileName,Long Dummy) ! Добавление файла в архив FQ Queue(File:Queue),Pre(FQ) End Zinfo Group(ZipFileInfo),Pre(Zinfo) End FDate String(@D12) FTime String(@T5) Loc:Comment CString('') Loc:Dir Cstring(260) Loc:SavePath Cstring(260) Loc:FileName_For_Zip CString(256),Static ! имя файла для упаковки Loc:FileName_In_Zip CString(256),Static ! имя файла в архиве после упаковки. На случай если будем паковать обрезая путь. Loc:Template Cstring(256) BufSize Equate(65536) Tmp File,Driver('DOS'),Name(Loc:FileName_For_Zip),Pre(Tmp) Record Record S String(BufSize) End End Code If ~Self.ZipFile Self.Throw('Архив не открыт на запись') Return(1) End ! ищем \ If ~Dummy Loc:Template=FileName Loop Pos#=Len(FileName) to 1 By -1 If FileName[Pos#]='\' Loc:Dir=FileName[1 : Pos#-1] Loc:Template=FileName [Pos#+1 : Len(FileName)] Break End End Loc:Savepath=LongPath() If Loc:Dir SetPath(Loc:Dir) If ErrorCode() Self.Throw('Не найден каталог:' & Loc:Dir) Return(1) End End ! Составляем список файлов Directory(Fq,Loc:Template,0) SetPath(Loc:SavePath) ! Читаем файлы If ~Records(FQ) And ~Instring('*', Loc:FileName_For_Zip , 1,1) Self.Throw('Не найден файл ' & FileName ) Return(1) End Else ! Фиктивный файл FQ:Date=Today() Fq:Time=Clock() Fq:Name=FileName Add(FQ) End Loop FQ#=1 To Records(FQ) Get(FQ,FQ#) FDate=Fq:Date FTime=Fq:Time Loc:FileName_For_Zip=Clip(Fq:Name) If Self.ZipValidateRecord(Loc:FileName_For_Zip) ! проверка необходимости упаковки файла. всегда=0 Cycle End ! Составляем FileInfo Clear(ZInfo) Zinfo.tm_Sec=Ftime[5:6] Zinfo.tm_min=Ftime[3:4] Zinfo.tm_hour=Ftime[1:2] Zinfo.tm_year=Fdate[1:4] Zinfo.tm_mon=Fdate[5:6]-1 Zinfo.tm_mday=Fdate[7:8] If Loc:Dir Loc:FileName_For_Zip = Loc:Dir & '\' & Loc:FileName_For_Zip End CONVERTANSITOOEM(Loc:FileName_For_Zip) Self.ErrorCode=zipOpenNewFileInZip(Self.zipFile, Loc:FileName_For_Zip, Zinfo, 0, 0, 0, 0, Loc:Comment, 8, 9) CONVERTOEMTOANSI(Loc:FileName_For_Zip) If Self.ErrorCode<>0 Self.Throw(Self.ZipError()) Break End If ~Dummy ! Если файл настоящий Open(Tmp,0) ! Только на чтение If ErrorCode() Self.Throw(' Невозможно открыть файл ' & Loc:FileName_For_Zip & ' ' & Error() ) Break End Set(Tmp) FileSize#=Bytes(Tmp) Loop Pos#=1 To FileSize# By BufSize Next(Tmp) BlkSize#=Bytes(tmp) Self.ErrorCode=zipWriteInFileInZip (Self.Zipfile, Address(Tmp:S), BlkSize#) If Res#<>0 Self.Throw(Self.ZipError()) Break End End Close(Tmp) End Res#=zipCloseFileInZip(Self.ZipFile) If Res#<>0 Self.Throw(Self.ZipError(),1) Break Else Self.Throw('В архив добавлен файл:' & Loc:FileName_For_Zip,0) End End Return(Self.ErrorCode) ZipClass.ZipAddDirectory Procedure(String Dir,String FileNames) Savepath Cstring(260) Code SavePath=LongPath() SetPath(Dir) Err#=Self.ZipAddFile(FileNames) SetPath(SavePath) Return(Err#) ZipClass.ZipBlobPack Procedure(*Blob Loc:Blob,Long Loc:BufSize) MinSize Equate(256) ZTag Equate('ZlPk') ! Тег упакованного ZHdr Group,Pre(ZH) ! Заголовок упакованного файла Tag String(4) ! Индюкатор упакованности SrcLen Long ! Длина распак DstLen Long ! Длина упак End InBuf &String OutBuf &String DLen Ulong SLen Ulong BufSize ULong OutSize ULong OK ULong BufNo Long ! Количество буферов BufLen Long ! Номинальная длина буфера Q Queue,Pre(Q) ! Список упакованных фрагментов Zhdr Like(Zhdr) PBuf &String ! Указатель на буфер End CODE ! Имеет ли смысл паковать? Если длина меньше MinSize, нет смысла... If Loc:Blob{Prop:Size}<=MinSize Return(0) End ! Может быть, Blob уже упакован? Zhdr=Loc:Blob[0:Size(Zhdr)] If Zh:Tag=ZTag Return(0) End Lth#=Loc:Blob{Prop:Size} BufSize=Loc:BufSize*1024 If BufSize=0 BufSize=Lth# End ! Определяем количество блоков R#=Int(Lth#/BufSize) If R#*BufSizeLth#-1 Max#=Lth#-1 End ! Вырезаем кусок и кладём в InBuf Inbuf=Loc:Blob[Min#:Max#] ! Входная длина SLen=Max#-Min#+1 ! Выходная длина DLen=Len(OutBuf) Code#=Compress(Address(OutBuf), DLen, Address(InBuf), SLen) ! Получилось... If ~Code# Q.Zhdr.Tag=Ztag Q.Zhdr.DstLen=Dlen Q.Zhdr.SrcLen=Slen Q.PBuf &= New String(Dlen) Q.Pbuf=OutBuf Add(Q) OutSize+=Size(Zhdr)+Dlen Else Ok=0 End End IF Ok Loc:Blob{Prop:Size}=0 Loc:Blob{Prop:Size}=OutSize End ! Копируем данные в выходной буфер Pos#=0 Loop Q#=1 to Records(Q) Get(Q,Q#) If Ok Loc:Blob[Pos#:Pos#+Size(Zhdr)-1]=Q.Zhdr Pos#+=Size(Zhdr) Loc:Blob[Pos#:Pos#+Q.Zhdr.DstLen]=Q.Pbuf Pos#+=Q.Zhdr.DstLen End Dispose(Q.Pbuf) End Free(Q) Dispose(InBuf) Dispose(OutBuf) Return(0) ZipClass.ZipBlobUnPack Procedure(*Blob Loc:Blob) MinSize Equate(256) ZTag Equate('ZlPk') ! Тег упакованного ZHdr Group,Pre(ZH) ! Заголовок упакованного файла Tag String(4) ! Индюкатор упакованности SrcLen Long ! Длина распак DstLen Long ! Длина упак End InBuf &String OutBuf &String BBuf &String DLen Ulong SLen Ulong OutSize Ulong Ok Long Q Queue,Pre(Q) ! Список упакованных фрагментов Zhdr Like(Zhdr) PBuf &String ! Указатель на буфер End Code If Loc:Blob{Prop:Size}<=Size(Zhdr) Return(0) End Zhdr=Loc:Blob[0:Size(Zhdr)] If Zh:Tag<>ZTag Return(0) End Lth#=Loc:Blob{Prop:Size} Ok=1 OutSize=0 Pos#=0 ! Входная позиция OutPos#=0 ! Выходная позиция ! Цикл по фрагментам Loop If Pos#>=Lth#-1 Then Break. ! Blob исчерпан... Q.Zhdr=Loc:Blob[Pos# : Pos#+Size(Zhdr)-1] ! Прочитали заголовок OutSize+=Q.Zhdr.SrcLen Pos#+=Size(Zhdr) ! Сдвинулись вперёд ! Создаём входной буфер InBuf &= New(String(Q.Zhdr.DstLen)) ! Coздаём выходной буфер Q.Pbuf &= New(String(Q.Zhdr.SrcLen)) ! Копируем Blob InBuf = Loc:Blob [Pos# : Pos#+Q.Zhdr.DstLen-1] Pos#+=Q.Zhdr.DstLen !Stop('OutSize=' & OutSize & ' Pos=' & Pos# & ' Src=' & Q.Zhdr.SrcLen & ' Dst=' & Q.Zhdr.DstLen ) ! Входная длина SLen=Q.Zhdr.DstLen ! Выходная длина DLen=Q.Zhdr.SrcLen Code#=UnCompress(Address(Q.Pbuf), DLen, Address(InBuf), SLen) ! Получилось... If Code# Self.Throw('Ошибка распаковки Blob' ,1 ) Ok=0 Break Else Add(Q) !Stop('Buf=' & Q.Pbuf) End Dispose(Inbuf) End ! Создаём выходной Blob If Ok Loc:Blob{Prop:Size}=OutSize ! Складываем распакованные данные End Pos#=0 Loop Q#=1 to Records(Q) Get(Q,Q#) If Ok Loc:Blob[Pos#: Pos#+Q.Zhdr.SrcLen-1]=Q.Pbuf End Pos#+=Q.Zhdr.SrcLen Dispose(Q.Pbuf) End Free(Q) Return(1-OK)