VPF::Склеивание файлов - Форум программистов

sani79

Дата 10.4.2006, 18:42 (ссылка)

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

Загрузка ...

Шустрый

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

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

Народ, подскажите плиз самый простой способ склеивания файлов. То есть нужно получить что то типа архива, только без компрессии, а потом снова разобрать на исходные файлы. Компоненты не подходят. Может есть у когонибудь код процедурки? Или может кто нибудь просто подскажет самый простой способ. Заранее спасибо.

SoWa

Дата 10.4.2006, 18:46 (ссылка)

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

Загрузка ...

Харекришна

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

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

Самый просто способ если не знаешь TFileStream- склеивать по байтам smile

Но лучше почитать про TFileStream и просто все сделать за пару строк. Не забудь в конце файла дописывать информацию о вклееных файлах.

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

Всем добра smile

sani79

Дата 10.4.2006, 18:49 (ссылка)

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

Загрузка ...

Шустрый

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

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

Хм.. Спасибо за идею... Так если в пару строк, может их опубликовать? Вдруг кому еще пригодится, да и разобраться проще будет....

Snowy

Дата 10.4.2006, 18:50 (ссылка)

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

Загрузка ...

Эксперт

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

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

http://forum.vingrad.ru/index.php?showtopi...st&p=313213

sani79

Дата 10.4.2006, 18:52 (ссылка)

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

Загрузка ...

Шустрый

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

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

Спасибо Snowy, это то что нужно. Щас буду пробовать.

Snowy

Дата 10.4.2006, 18:58 (ссылка)

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

Загрузка ...

Эксперт

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

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

Эта проблема поднимается уже в 99-й раз.
А у меня все руки не доходят мою утилиту дописать.
Все. Решительно берусь.
Пошел писать...

sani79

Дата 10.4.2006, 19:00 (ссылка)

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

Загрузка ...

Шустрый

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

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

Еще раз спасибо. Кстати на форуме не нашел (видно плохо искал). И в drkb. Пошел писать тоже smile

former

Дата 11.4.2006, 00:03 (ссылка)

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

Загрузка ...

MEMS Expert

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

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

Snowy, попробовал кад предложенный в тобой, только упаковывал файлы разных типов (txt, jpg, bmp).

А при попытки выполнить следующий код ничего не происходит: smile

Код


procedure TForm1.Button2Click(Sender: TObject);
var
 m: TMemoryStream;
begin
 m:=TMemoryStream.Create;
 Load('archiv.prt','pict.bmp',m);
 Image1.Picture.Bitmap.LoadFromStream(m);
 m.Free;
end;

Что не так?

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

Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.

sani79

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

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

Загрузка ...

Шустрый

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

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

хмм.. 1: ну во первых получил ошибку при компиляции в процедуре save:
[Error] Unit1.pas(142): Incompatible types: 'TPersistent' and 'file'
[Fatal Error] Project1.dpr(9): Could not compile used unit 'Unit1.pas'

проблема решилась заменой assign на assignfile. Запись прошла. Размер архива навскидку правильный. Все отлично.
2. Процедура load: во первых понятно что максимальное имя файла 8 символов (задается в типе TFileNfo), мне это не удобно, заменил на 100.
Ладно, но в итоге я получил файл размером в 5 байт (?), что естественно не является содержимым извлекаемого файла.

Сейчас продолжаю трассировать. Есть у кого нибудь коментарии? Snowy?

Snowy

Дата 11.4.2006, 09:53 (ссылка)

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

Загрузка ...

Эксперт

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

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

Комментарии отсутствуют. У меня все отлично работает.
Проверил - битмапа грузится без проблем.

Alexeis

Дата 11.4.2006, 10:09 (ссылка)

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

Загрузка ...

Амеба

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

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

sani79, у меня работает такой код

Код



procedure TForm1.Button1Click(Sender: TObject);
 var
  f1, f2, fr : TFileStream;
  d, l : Integer;
  s : AnsiString;

begin
  f1 := TFileStream.Create(ExtractFilePath(application.exename)+'1.txt', fmOpenRead);
  f2 := TFileStream.Create(ExtractFilePath(application.exename)+'2.wav', fmOpenRead);
  fr := TFileStream.Create(ExtractFilePath(application.exename)+'Result.dat', fmCreate);
  f1.Seek(0, soFromBeginning);
  f2.Seek(0, soFromBeginning);
  fr.Seek(0, soFromBeginning);

  d := f1.Size;
  s := '1.txt';
  l := length(s);

  fr.WriteBuffer(d, 4);
  fr.WriteBuffer(l, 4);
  fr.WriteBuffer(s[1], l);

  fr.CopyFrom(f1, f1.Size);

  d := f2.Size;
  s := '2.wav';
  l := length(s);

  fr.WriteBuffer(d, 4);
  fr.WriteBuffer(l, 4);
  fr.WriteBuffer(s[1], l);

  fr.CopyFrom(f2, f2.Size);
  f1.Free;
  f2.Free;
  fr.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
 var
  f1, fr : TFileStream;
  d, l : Integer;
  s : AnsiString;

begin
  fr := TFileStream.Create(ExtractFilePath(application.exename)+'Result.dat', fmOpenRead);
  fr.Seek(0, soFromBeginning);

  fr.ReadBuffer(d, 4);
  fr.ReadBuffer(l, 4);
  SetLength(s, l);
  fr.ReadBuffer(s[1], l);

  f1 := TFileStream.Create(ExtractFilePath(application.exename)+s, fmCreate);
  f1.Seek(0, soFromBeginning);
  f1.CopyFrom(fr, d);
  f1.Free;

  fr.ReadBuffer(d, 4);
  fr.ReadBuffer(l, 4);
  SetLength(s, l);
  fr.ReadBuffer(s[1], l);

  f1 := TFileStream.Create(ExtractFilePath(application.exename)+s, fmCreate);
  f1.Seek(0, soFromBeginning);
  f1.CopyFrom(fr, d);
  f1.Free;
end;

Добавлено @ 10:15
Файлы последовательно будут записываться button1, а затем последовательно извлекатся button2(в том порядке в котором были записаны). Число файлов естественно не ограничивается двумя.

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

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

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

гениальность идеи состоит в том, что ее невозможно придумать

sani79

Дата 11.4.2006, 10:24 (ссылка)

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

Загрузка ...

Шустрый

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

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

alexeis1, Спасибо, этот код у меня отработал как нужно. Все получилось. Странно что не работает вышеописанный код от Snowy, я уверен что он должен работать тоже. Попытаюсь все таки разобраться. Ради спортивного интереса. Всем спасибо!

Alexeis

Дата 11.4.2006, 10:43 (ссылка)

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

Загрузка ...

Амеба

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

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

sani79, Я переделал код поприличней на много файлов
вот привожу

Код


procedure SaveFiles(files : TStringList;ResutName : AnsiString);
 var
  f, fr : TFileStream;
  d, l, i : Cardinal;
  s : AnsiString;

begin
  fr := TFileStream.Create(ResutName, fmCreate);
  fr.Seek(0, soFromBeginning);
 
  For i := 0 to files.Count - 1
  do
    Begin
      s := Files.Strings[i];
      f := TFileStream.Create(s, fmOpenRead);
      f.Seek(0, soFromBeginning);

      d := f.Size;
      l := length(s);

      fr.WriteBuffer(d, 4);
      fr.WriteBuffer(l, 4);
      fr.WriteBuffer(s[1], l);

      fr.CopyFrom(f, f.Size);

      d := $AAAA;
      fr.WriteBuffer(d, 4);

      f.Free;
    end;

  fr.Seek(-4, soFromCurrent);
  d := $FFFF;
  fr.WriteBuffer(d, 4);
  
  fr.Free;
end;

procedure ExtractFiles(SourceName : AnsiString);
 var
  f, fr : TFileStream;
  d, l : Cardinal;
  s : AnsiString;

begin
  fr := TFileStream.Create(ExtractFilePath(application.exename)+'Result.dat', fmOpenRead);
  fr.Seek(0, soFromBeginning);

  Repeat
    fr.ReadBuffer(d, 4);
    fr.ReadBuffer(l, 4);
    SetLength(s, l);
    fr.ReadBuffer(s[1], l);

    f := TFileStream.Create(s, fmCreate);
    f.Seek(0, soFromBeginning);
    f.CopyFrom(fr, d);
    f.Free;

    fr.ReadBuffer(d, 4);

  until d = $FFFF;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var
  n : TStringList;

begin
  n := TStringList.Create;
  if opendialog1.Execute
  then
    Begin
      n.AddStrings(opendialog1.Files);
      SaveFiles(n, ExtractFilePath(application.ExeName) + 'Result.dat');
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ExtractFiles(ExtractFilePath(application.ExeName) + 'Result.dat');
end;

Добавлено @ 10:44
Кстати побайтовое сравнение распакованных и исходных показало полное совпадение

Это сообщение отредактировал(а) alexeis1 - 11.4.2006, 10:47

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

sani79

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

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

Загрузка ...

Шустрый

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

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

Да все работает на отлично. Я проверял dbfами. Никаких потерь.

Snowy

Дата 11.4.2006, 11:24 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

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

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

Долго пишу. Вот собрал 2 класса:
* TFilesSaver - сохраняет кучу файлов в один
* TFilesLoader - загружает файлы из пака

Код

unit FilesWork;
{* Модуль для сохранения множества файлов в один и обратного извлечения }

interface

uses Windows, SysUtils, Classes;

type
  TFilesSaver = class
  {* класс - сохраняет файлы в пак }
  private
    FFile:  string;
  public
    FileList: TStringList;
    {* здесь список файлов с полными путями }
    function Add(FileName: string): integer;
    {*  добавляет файл в список. Допустимы маски *.* f???.bmp т.п.}
    procedure Save;
    {* Собственно сохраняет все файлы }
    constructor Create(FileName: string);
    {* конструктор. При создании задаем имя итогового файла }
    destructor Destroy; override;
    {* деструктор }
  end;

  TFilesLoader = class
  {* класс - читает файлы из пака }
  private
    FFile: string;
  public
    FileList: TStringList;
    {* список файлов в паке. }
    constructor Create(FileName: string);
    {* конструктор. При создании задаем имя файла-пака. Заполняет FileList }
    destructor  Destroy; override;
    {* Деструктор }
    procedure GetFile(FileName: string; st: TStream); overload;
    {* Взять файл из пака. На входе имя файла и любой потомок TStream }
    procedure GetFile(Index: integer; st: TStream); overload;
    {* Перегруженная GetFile, для обращения по индексу, а не имени }
    procedure SaveFile(FileName, DestFile: string);
    {* Пример использования GetFile на основе TFileStream.
       Сохраняет файл FileName из пака в файл с именем DestFile }
  end;

implementation

// TFilesSaver

constructor TFilesSaver.Create(FileName: string);
begin
  inherited Create;
  FileList := TStringList.Create;
  FFile := FileName;
end;

destructor TFilesSaver.Destroy;
begin
  inherited;
  FileList.Free;
end;

function TFilesSaver.Add(FileName: string): integer;
var
  sr: TSearchRec;
begin
  result := 0;
  if FindFirst(FileName, $20, sr) = 0 then
  begin
    repeat
      if (sr.Attr and $20) = $20 then
      begin
        FileList.Add(ExtractFilePath(FileName) + sr.Name);
        inc(result);
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

procedure TFilesSaver.Save;
var
  fa, fc: TFileStream;
  ms:     TMemoryStream;
  i, d:   dword;
  b:      byte;
  s:      string;
begin
  try fa := TFileStream.Create(FFile, fmCreate or fmShareDenyWrite);
  except Exit; end;
  ms := TMemoryStream.Create;
  d := 0; fa.Write(d, SizeOf(d));
  for i := 0 to FileList.Count - 1 do
  try
    fc := TFileStream.Create(FileList[i], fmOpenRead or fmShareDenyWrite);
    try
      s := ExtractFileName(FileList[i]);
      b := Length(s); ms.Write(b, 1); ms.Write(s[1], b);
      d := fa.Position; ms.Write(d, SizeOf(d));
      d := fc.Size; ms.Write(d, SizeOf(d));
      fa.CopyFrom(fc, fc.Size);
    finally fc.Free; end;
  except end;
  d := fa.Position;
  ms.Position := 0; fa.CopyFrom(ms, ms.Size);
  fa.Position := 0; fa.Write(d, SizeOf(d));
  ms.Free; fa.Free;
end;


// TFilesLoader

constructor TFilesLoader.Create(FileName: string);
var
  fs: TFileStream;
  d:  dword;
  b:  byte;
  s:  string;
begin
  inherited Create;
  FileList := TStringList.Create;
  FFile := FileName;
  try fs := TFileStream.Create(FFile, fmOpenRead or fmShareDenyWrite);
    try
      fs.Read(d, SizeOf(d)); fs.Position := d;
      repeat
        fs.Read(b, SizeOf(b)); SetLength(s, b);
        fs.Read(s[1], b); d := fs.Position;
        FileList.AddObject(s, pointer(d));
        fs.Read(d, SizeOf(d)); fs.Read(d, SizeOf(d));
      until fs.Position >= fs.Size;
    finally fs.Free; end;
  except end;
end;

destructor TFilesLoader.Destroy;
begin
  FileList.Free;
  inherited;
end;

procedure TFilesLoader.GetFile(Index: integer; st: TStream);
var
  fs:  TFileStream;
  d,o: dword;
begin
  fs := TFileStream.Create(FFile, fmOpenRead or fmShareDenyWrite);
  try
    fs.Position := dword(FileList.Objects[Index]);
    fs.Read(o, SizeOf(o)); fs.Read(d, SizeOf(d));
    fs.Position := o; st.CopyFrom(fs, d);
  finally fs.Free; end;
  st.Position := 0;
end;

procedure TFilesLoader.GetFile(FileName: string; st: TStream);
var i: integer;
begin
  i := FileList.IndexOf(FileName);
  if i >= 0 then GetFile(i, st);
end;

procedure TFilesLoader.SaveFile(FileName, DestFile: string);
var
  fs: TFileStream;
begin
  if FileList.IndexOf(FileName) < 0 then Exit;
  try fs := TFileStream.Create(DestFile, fmCreate or fmShareDenyWrite);
    GetFile(FileName, fs);
    fs.Free;
  except end;
end;

end.

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

Код


// Кнопка1 - сохраняет кучу файлов в пак
procedure TForm1.Button1Click(Sender: TObject); // создаем пак
begin
  with TFilesSaver.Create('C:\file.pak') do
  begin
    Add('C:\*.bmp'); // добавляем в список файлы
    Add('C:\*.mp3');
    Add('C:\*.rar');
    Save; Free;     // сохраняем пак, уничтожаем класс
  end;
end;

// Кнопка2 - распаковать файлы на диск
procedure TForm1.Button2Click(Sender: TObject);
const path := 'C:\UnPack\';
var i: integer;
begin
  ForceDirectories(path); // создаем каталог для распаковки
  with TFilesLoader.Create('C:\file.pak') do // читаем пак
  begin
    for i := 0 to FileList.Count - 1 do // идем по списку файлов
      SaveFile(i, path + FileList[i]); // сохраняем файл
    Free; // убиваем распаковщик
  end;
end;

// Кнопка3 - читает первый файл из пака, загружает его в Image1
procedure TForm1.Button3Click(Sender: TObject);
var ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  with TFilesLoader.Create('C:\file.pak') do // читаем пак
  begin
    GetFile(FileList[0], ms); // берем первый файл в MemoryStream
    Free;
  end;
  Image1.Picture.Bitmap.LoadFromStream(ms); // грузим из стрима в картинку
  ms.Free;
end;

P.S. Сохраняются только имена файлов, а не полный путь.
Поэтому есть вероятность того, что в список попадут файлы с одинаковыми именами.
Запишутся они корректно и прочитаются тоже. Просто осторожней с сохранением на диск.

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