Модераторы: 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   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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


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

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


 




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


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

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