Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Упаковка/распаковка файлов и папок, Посоветуйте компонент или алг. сжатия 
:(
    Опции темы
ЧеловекБорща
  Дата 4.10.2010, 23:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 94
Регистрация: 5.6.2010

Репутация: нет
Всего: нет



Доброе время суток! 

Посоветуйте пожалуйста хороший алгоритм сжатия в архив  папок и файлов. 

пробовал Jb Zip не устроил тем что неможет ужимать файлы в папках и подпапках. 

Может есть ещё что-нибуть ?

Хочу использовать в потоке tthread для распаковки архива с обновлением для программы.



PM MAIL   Вверх
Xenag
Дата 5.10.2010, 01:57 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 51
Регистрация: 6.3.2010

Репутация: нет
Всего: нет



Стандартный ZIP: VCLZip
LZMA (RAR, 7Zip)
Ну или стандартный ZLib
PM   Вверх
Akella
Дата 5.10.2010, 22:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329



я бы взял RAR или 7Zip
PM MAIL   Вверх
ЧеловекБорща
Дата 5.10.2010, 23:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 94
Регистрация: 5.6.2010

Репутация: нет
Всего: нет



Спасибо! меня интересует именно упаковка файлов и подпапков с файлами. В предоставленом модуле только упаковка папок с файлами.
Код

unit vgzipper;

interface

uses SysUtils, Classes, ZLib;

const
  ERR_OK         = 0;
  ERR_FILES      = 1;
  ERR_NO_FILES   = 2;
  ERR_CREATE_ARC = 3;
  ERR_NO_ARCHIVE = 4;
  ERR_BAD_ARCHIVE= 5;
  ERR_BAD_DATA   = 6;

function PackDir(ArcName, Path: string; OnWork: TNotifyEvent = nil): byte;
{* запаковать каталог со всеми подкаталогами.
   На входе имя создаваемого архива и путь к каталогу.
   OnWork - необязателен. Выполняется в процессе запаковки. }
function UnPackDir(ArcName, Path: string; OnWork: TNotifyEvent = nil): byte;
{* Распаковать каталог.
   На входе ипя архива и путь к каталогу, куда распаковать файлы.
   OnWork - необязателен. Выполняется в процессе распаковки. }
function ArcErrorText(code: byte): string;
{* Возвращает текст ошибки }

implementation

const signature = 'VGZ'; // сигнатура. Типа VingradGZip.

function ArcErrorText(code: byte): string;
begin
  case code of
    ERR_OK:          result := 'Готово';
    ERR_FILES:       result := 'Не все файлы запакованы';
    ERR_NO_FILES:    result := 'Нет файлов для запаковки';
    ERR_CREATE_ARC:  result := 'Ошибка создания файла архива';
    ERR_NO_ARCHIVE:  result := 'Архив не найден или недоступен';
    ERR_BAD_ARCHIVE: result := 'Файл не является архивом';
    ERR_BAD_DATA:    result := 'Архив поврежден';
    else result := '';
  end;
end;

function PackDir(ArcName, Path: string; OnWork: TNotifyEvent = nil): byte;
var
  fs: TFileStream;
  cs: TCompressionStream;

function FilesScan(Dir: string): byte;
var
  sr: TSearchRec;
  s:  string;
  ln: byte;
  sz: int64;
  fs: TFileStream;
begin
  result := ERR_OK;
  if FindFirst(Dir + '*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if sr.Name[1] <> '.' then begin
        if sr.Attr and faDirectory = faDirectory then
        begin
          ln := FilesScan(Dir + sr.Name + '\');
          if result = ERR_OK then result := ln;
        end else
        if (sr.Attr and faArchive) = faArchive then
        begin
          s := Dir + sr.Name;
          try
            fs := TFileStream.Create(s, fmOpenRead or fmShareDenyWrite);
            s := copy(s, Length(path)+1, Length(s));
            ln := Length(s);
            cs.Write(ln, 1);
            cs.Write(s[1], ln);
            sz := fs.Size;
            cs.Write(sz, SizeOf(sz));
            cs.CopyFrom(fs, sz);
            fs.Free;
          except
            result := ERR_FILES;
          end;
        end;
      end;
      until FindNext(sr) <> 0;
    FindClose(sr);
  end else result := ERR_NO_FILES;
end;

begin
  if Path[Length(Path)] <> '\' then Path := Path + '\';
  try
    fs := TFileStream.Create(ArcName, fmCreate or fmShareDenyWrite);
    fs.Write(signature[1], Length(signature));
  except
    result := ERR_CREATE_ARC;
    Exit;
  end;
  cs := TCompressionStream.Create(clMax, fs);
  if Assigned(OnWork) then cs.OnProgress := OnWork;
  result := FilesScan(Path);
  cs.Free; fs.Free;
end;


function UnPackDir(ArcName, Path: string; OnWork: TNotifyEvent = nil): byte;
var
  fs,ts: TFileStream;
  ds:    TDecompressionStream;
  s:     string;
  ln:    byte;
  sz:    int64;
begin
  if Path[Length(Path)]<>'\' then Path := Path + '\';
  result := ERR_OK;
  try
    fs := TFileStream.Create(ArcName, fmOpenRead or fmShareDenyWrite);
  except
    result := ERR_NO_ARCHIVE;
    Exit;
  end;
  SetLength(s, Length(signature));
  fs.Read(s[1], Length(signature));
  ds := TDecompressionStream.Create(fs);
  if Assigned(OnWork) then ds.OnProgress := OnWork;
  if s <> signature then result := ERR_BAD_ARCHIVE
  else while (fs.Position<fs.Size) and (result=ERR_OK) do
  begin
    ds.Read(ln, SizeOf(ln));
    SetLength(s, ln);
    ds.Read(s[1], ln);
    s := Path + s;
    try
      ForceDirectories(ExtractFilePath(s));
      ts := TFileStream.Create(s, fmCreate or fmShareDenyWrite);
      ds.Read(sz, SizeOf(sz));
      ts.CopyFrom(ds, sz);
      ts.Free;
    except
      result := ERR_BAD_DATA;
    end;
  end;
  fs.Free;
end;

end.


как это исправить?  smile 

Это сообщение отредактировал(а) ЧеловекБорща - 6.10.2010, 00:00
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0585 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.