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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Проблема с архивированием, Не все каталоги и папки сохраняет 
:(
    Опции темы
Marlin
Дата 17.4.2006, 07:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
этот исходник я взял на этом форуме, но вот возникла неожиданно проблема.

Когда упаковываю, то каталоги, где слишком маленькие файлы просто не сохраняются в архив. Я сохраняю базы 1с так вот каталоги пользователей usr1 usr2 и т.д. просто при распоковки проподают, помогите в чем проблема.


Код архиватора:
Код

function PackDir(ArcName, Path: string; OnWork: TNotifyEvent = nil): byte;
{ArcName - êóäà Patch - îòêóäà}
var
  fs: TFileStream;
  cs: TCompressionStream;

function FilesScan(Dir: string{Patch}): 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

            main.GoProgress;  
            main.StateFileDir(s);  
            fs := TFileStream.Create(s, fmOpenRead or fmShareCompat);
            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
  SendMessage(HWND_BROADCAST,WM_ShowApplication,0,0);
  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;
  Main.FreePositionPrgressBar(); 
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));
    main.ProgressBar1.Max:=fs.Size;
    main.ProgressBar1.Position:=fs.Position;
    main.StateFileDir('Unpack file: '+ArcName);
    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;
  main.FreePositionPrgressBar();
end;


И еще проблема, когда распакуешь архивный файл и начинаешь подгружать базу из 1с, программа выдает не могу прочесть значение из  памяти ......., пока не закроешь архиватор, базу подгрузить не возможно  

Это сообщение отредактировал(а) Marlin - 17.4.2006, 07:02
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 17.4.2006, 09:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
1. Ты проверяешь код ошибки, который возвращют функции?
Если что-то не так. Должен быть код ошибки. Какой?

2. fs := TFileStream.Create(s, fmOpenRead or fmShareCompat);
Замени fmShareCompat на fmShareDenyWrite. Или на худой конец вообще на fmShareDenyNone.
Я так подозреваю, что ты жмешь одинэсовские файлы, не закрывая сам 1С...
Если так, то ничего удивительного в том, что некоторые файлы заблокированы и не пакуются.
В этом случае, возвращаемая ошибка, будет ERR_FILES. 
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 10:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
нет 1с я закрываю.

Попробывал зажать 7 файлов doc, а при распаковки получилось три.

Зжимает без ошибок и главное показывает в строке состояния, что сжимает все файлы.

fs := TFileStream.Create(s, fmOpenRead or fmShareCompat);
 сейчас заменю 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 10:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Заменил, но все то же самое.
Не могу понять где ошибка 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 17.4.2006, 11:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
А ты этот: http://forum.vingrad.ru/index.php?showtopi...st&p=652493 пример пробовал применить без изменений? 
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 11:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
я его и использую, только свои строки в коде добавил для програсса

Добавлено @ 11:10 
Может дело в функции разархивирования.  
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Alexeis
Дата 17.4.2006, 11:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459
Marlin, проверь по размеру результирующего файла, все ли записалось. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Snowy
Дата 17.4.2006, 11:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
При распаковке, исправь строчку 36 на
Код
      if sz > 0 then ts.CopyFrom(ds, sz);
 
И что говорит ShowMessage(ArcErrorText(UnPackDir('....', '....'))); ?   
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 11:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Архив вроде формирует нормальный. А когда распаковывает фигня какя-то

Добавлено @ 11:21 
щас попробую

Добавлено @ 11:25 
говорит готово. У меня программа на следующий этап не переходит без этого 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 12:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
if sz > 0 then ts.CopyFrom(ds, sz); - ничего не дало 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 17.4.2006, 12:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
Цитата(Marlin @  17.4.2006,  11:19 Найти цитируемый пост)
говорит готово.
А упаковка тоже говорит "Готово"?
Я проверил данный код - работает нормально.
Так что проблема скорее всего не в коде, а в каких-то внешних факторах. 
PM MAIL   Вверх
Marlin
Дата 17.4.2006, 13:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
спасибо. Буду смотреть 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 07:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Я накидал только несколько функций для архивирования в новом модуле. Посмотрите пож-та нужно протестить. У меня никак не может устраниться эта проблема.

При упаковке показывает, что файлы все упаковываются, а при распаковке часть файлов пропадает и в конце выдает ошибку. 

Этот код нужен позарез. 

Файл прикрепил
 

Присоединённый файл ( Кол-во скачиваний: 6 )
Присоединённый файл  arhiv.rar 12,45 Kb
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 07:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Ошибка возникает только тогда, когда запуск программы осуществляется из делфи, когда запускаешь exe-ник все нормально, только файлы не все распаковываются  
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 08:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Попробуйте запаковать маленькие и большие файлы, обычно маленькие файлы пропадают 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 18.4.2006, 11:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
Нашёл.
3 глюки:
1. Из-за кэширования файла декомпрессором выход из цикла происходил раньше времени. Для больших файлов эта ошибка не возникает - только для мелких, которые легко глотаются кэшем декомпрессора.
2. Не все файлы имеют аттрибут Archive.
3. Файлы нулевой длины не создаются.
Также не создаются каталоги в которых нет файлов. Но это не было предусмотрено задачей.
Итак:
В компрессоре изменяем строку 
Код
        if (sr.Attr and faArchive) = faArchive then
на
Код
        if (sr.Attr and faDirectory) <> faDirectory then

Декомпрессор правим цикл:
Код
  else while (result=ERR_OK) do
  begin
    ln := 0; ds.Read(ln, SizeOf(ln));
    if ln = 0 then Break;
    SetLength(s, ln);
    ds.Read(s[1], ln);
    s := Path + s;
    memo1.Lines.Add('Распаковка: '+s);
    try
      ForceDirectories(ExtractFilePath(s));
      ts := TFileStream.Create(s, fmCreate or fmShareDenyWrite);
      ds.Read(sz, SizeOf(sz));
      if sz > 0 then ts.CopyFrom(ds, sz);
      ts.Free;
    except
      result := ERR_BAD_DATA;
    end;
  end;
 
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 11:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
Snowy - ты просто супер!!!!

надеюсь я когда-нибудь дорасту до твоего уровня!!!

Добавлено @ 11:57 
Никогда бы не подумал про этот кэш!

Спасибо тебе большое.

И еще хочу спросить 

вот строка в комперессоре 
Код


 if sr.Name[1] <> '.' then begin



зачем нужна эта точка. Это ведь аттрибут "faHidden" т.е. скрытый файл, но все равно все файлы туда попадают - вот это мне не ясно 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 18.4.2006, 12:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
Просто при переборе FindFirst-FindNext в список попадают каталоги '.' и '..' - корень диска и каталог выше.
Мы же не хотим компресить весь диск smile Вот и отфильтровываем их.
 
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 12:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 1
а это типа как в старые добрые времена в досе!! 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Snowy
Дата 18.4.2006, 12:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 192
Всего: 484
Ну так винда это и есть DOS. Только версия сильно подросла. 
PM MAIL   Вверх
Marlin
Дата 18.4.2006, 12:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

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

 
--------------------
Программист решает проблемы, о которых пользователь даже не задумывается,способами, о котороых он даже не подозревает.
PM MAIL   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




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


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

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