VPF::Создание архива (ручками) - Форум программистов

Marlin

Дата 22.2.2006, 09:24 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Мне необходимо запоковать каталог с файлами и подкаталогами програмным способом. Я для этого использовал компонент FlexCompress for Delphi, мне он вполне подошел. Но возникло две проблемы

1) FlexCompress for Delphi - это триал версия и как его зарегестрировать понятия не имею. Он он выводит надоедливое сообщение при запуске моей программы.

2) Т.к. работа уходит на олимпиаду, мне сказали, что сторонними компонентами пользоваться нельзя. smile вот тут я попал smile

Ребята помогите пожалуйста, времени остается в обрез, я не успею написать встроенный архиватор. И весь мой 2-х месячный труд уйдет коту под хвост.
Дело в том, что я хочу использовать алгоритм Халффмана для этого. Я понял суть, но не могу применить на практике. Небольшая путаница с бинарными деревьями. Но самое главное это как в архив запихать весь каталог, который нужно запаковать с его файлами и подкаталогами. Один файл то можно, а вот каталог целый smile

Может кто уже делал что-то подобное? помогите если кто, что знает? smile

--------------------

Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.

Guedda

Дата 22.2.2006, 09:26 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

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

1) Берешь, идешь на официальный сайт, там платишь денешку, и тебе дают ключ. Ты его устанавливаешь, и все прекрасно.

А что, нельзя обойти как-нить судей и подкрепить WinRar, и с ключами его фиксить?

--------------------

Ll 2

Marlin

Дата 22.2.2006, 09:33 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Ты имеешь ввиду, взять dll и в модуле подгружать от туда функции и процедуры.

Если так, я также должен предоставить и исходник DLL. Как быть?

--------------------

Guedda

Дата 22.2.2006, 09:40 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

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

Тогда ищи материал по сжатию данных, и пиши свой компонент для сжатия.

--------------------

Ll 2

Marlin

Дата 22.2.2006, 09:43 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Если бы был такой нормальный материал, я бы вопрос в форуме не стал поднимать. Есть немного материала, но объяснение только в теории, много непонятного, что связано с кодингом
Добавлено @ 09:45
Граждане программеры, помогите собрату, может кто, где, хоть как-то сталкивался. Очень бы хотелось посмотреть исходник

--------------------

Romikgy

Дата 22.2.2006, 10:17 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

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

Цитата(Marlin @ 22.2.2006, 08:24

)

FlexCompress

не знаю что это за компонент, но чего не воспользоватся компонентами на основе Zip?

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Snowy

Дата 22.2.2006, 10:28 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Если не использовать сторонние компоненты, то тебе прямая дорога к ZLib.
http://forum.vingrad.ru/index.php?showtopi...st&p=620614
или посиск: http://forum.vingrad.ru/index.php?act=Sear...ib&skipped=

Girder

Дата 22.2.2006, 10:56 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

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

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

Не по сабжу:

Цитата(Marlin @ 22.2.2006, 06:19

)

Во первых я извеняюсь за то, что опублековал этот вопрос в разделе сети, но по непонятным причинам я не могу попасть в раздел "Общие вопросы" мне предлагается скачатьего, а в разделе API при создание новой темы мне вежливо отвечают, что у вас нет прав. Может администратор посмотрит, что там да как.

Куда жмеш при заходе в Delphi: Общие? И какой браузер?

M
Girder

По сабжу "1": Обсуждение взлома запрещено на форуме!

PS: http://algolist.manual.ru/compress/standard/huffman.pas

--------------------

Как слышим, так и пишим.
Истина где-то там...

Marlin

Дата 22.2.2006, 11:29 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Куда жмеш при заходе в Delphi: Общие? И какой браузер?

Это у меня прокси сервер неправильно работал, там стоял слишком большой кэш. Но даже при установке кэше в 1 мб при переходе на винград в форум "общие вопросы" он почему-то хочет закачать эту ссылку, а браузер у меня MOZILA Firefox

--------------------

Snowy

Дата 22.2.2006, 11:33 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Цитата(Marlin @ 22.2.2006, 09:24

)

Один файл то можно, а вот каталог целый

Давай определимся с функционалом.
Итак. Тебе нужно запаковать каталог с файлами и подкаталогами. Без использования сторонних компонентов.
Хорошо. Это легко. Только нужно определиться с распаковкой.
Нужно распаковывать:
восстановить оригинал - распаковать все файлы, восстановить каталоги.
или иметь возможность распаковки каждого отдельного файла?
Требуется ли возможность получения списка файлов архива?
Можно довольно быстро нарисовать быстрый и легкий архиватор.
Если нужна только первая возможность, то уровень компрессии будет на 5-10% лучше ZIP.
Если хочешь больше, то уровень будет на уровне ZIP. Можно увеличить, но за счет времени распаковки.
Добавлено @ 11:35
Если только первый вариант - могу набросать код за полчаса.

Marlin

Дата 22.2.2006, 11:41 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Snowy спасибо за подсказку.

Я сам только, что набрел на такую библиотеку. Прочитал поверхностно т.к. на работе некогда, но везде описан пример с одним файлом, может ты подскажешь как можно послать в упаковку весь каталог с его вложенными файлами и подкаталогами и все это упаковать в один.

И соответственно наоборот. Это возможно?

А то с одним файлом я бы и метод Халффмана применил. Вот проблема!
Добавлено @ 11:48

Давай определимся с функционалом.
Итак. Тебе нужно запаковать каталог с файлами и подкаталогами. Без использования сторонних компонентов. - именно так
Хорошо. Это легко. Только нужно определиться с распаковкой.
Нужно распаковывать:
восстановить оригинал - распаковать все файлы, восстановить каталоги. - Именно больше ничего и не надо
или иметь возможность распаковки каждого отдельного файла? - нет кучу запоковал, кучу распоковал
Требуется ли возможность получения списка файлов архива? - нет не требуется
Можно довольно быстро нарисовать быстрый и легкий архиватор. - Это было бы просто супер
Если нужна только первая возможность, то уровень компрессии будет на 5-10% лучше ZIP.
Если хочешь больше, то уровень будет на уровне ZIP. Можно увеличить, но за счет времени распаковки.
Добавлено @ 11:35
Если только первый вариант - могу набросать код за полчаса. - Значит ты будешь лучшим, кого я только знал в этой среде программирования

Кстати ты сколько уже в делфи и вообще в программировании

--------------------

Snowy

Дата 22.2.2006, 13:41 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Готово. Держи:

Код

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.

Пример использования:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  code: byte;
begin
  code := PackDir('C:\arc.vgz', 'C:\Temp\MyDir');
  ShowMessage(ArcErrorText(code));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  code: byte;
begin
  code := UnPackDir('C:\arc.vgz', 'C:\Temp\Unpack');
  ShowMessage(ArcErrorText(code));
end;

Добавлено @ 13:48
Для анализа зажал каталог с exe, bpl, dcu, bmp общим весом 8.5Mb.
Результаты компрессии:
ZIP: 3430Kb
VGZ: 3337Kb
В принципе немного - всего 3% выигрыш.
Зато минимум кода - минимум размера. Скорость высокая.
Добавлено @ 13:50

Цитата(Marlin @ 22.2.2006, 11:41

)

Кстати ты сколько уже в делфи и вообще в программировании

Лет 15.

Marlin

Дата 22.2.2006, 14:07 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

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

Ребята спасибо вам огромное!

Snowy ну ты ас. Я еще в дет сад ходил, когда ты в делфи начал разбирать

--------------------

Snowy

Дата 22.2.2006, 14:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Цитата(Marlin @ 22.2.2006, 14:07

)

Snowy ну ты ас. Я еще в дет сад ходил, когда ты в делфи начал разбирать

Нет, с дельфи я начал работать где-то в 98-м. С 3-й версии.
До этого Pascal, Asm. А до этого Basic, C++.

Цитата(Marlin @ 22.2.2006, 14:07

)

Ребята спасибо вам огромное!

Всегда пожалуйста. Заходи еще.

Snowy

Дата 22.2.2006, 14:33 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Чуть доработал модуль. Теперь можно паковать без ступора программы и сделать визуализацию.
Пример с визуализацией вот: (на форме 2 кнопки и TAnimate с Visible = false).

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, vgzipper, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Animate1: TAnimate;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure OnArcWork(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnArcWork(Sender: TObject);
begin
  Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  code: byte;
begin
  Button1.Enabled := false; Button2.Enabled := false;
  Animate1.CommonAVI := aviCopyFiles;
  Animate1.Visible := true;  Animate1.Play(1, 0, 0);
  code := PackDir('C:\arc.vgz', 'C:\bin', OnArcWork);
  Animate1.Stop;
  ShowMessage(ArcErrorText(code));
  Animate1.Visible := false;
  Button1.Enabled := true; Button2.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  code: byte;
begin
  Button1.Enabled := false; Button2.Enabled := false;
  Animate1.CommonAVI := aviCopyFiles;
  Animate1.Visible := true;  Animate1.Play(1, 0, 0);
  code := UnPackDir('C:\arc.vgz', 'C:\Temp\Unpack', OnArcWork);
  Animate1.Stop;
  ShowMessage(ArcErrorText(code));
  Animate1.Visible := false;
  Button1.Enabled := true; Button2.Enabled := true;
end;

end.

Сам модуль повторно не выкладываю - исправил оригинальном посте.

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