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. Сохраняются только имена файлов, а не полный путь.
Поэтому есть вероятность того, что в список попадут файлы с одинаковыми именами.
Запишутся они корректно и прочитаются тоже. Просто осторожней с сохранением на диск.

Alexeis

Дата 1.12.2006, 16:26 (ссылка)

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

Загрузка ...

Амеба

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

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

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

Код


function GetFileNames(SourceName : AnsiString) : TStringList;
 var
  f, fr : TFileStream;
  d, l : Cardinal;
  s : AnsiString;
begin
  Result := TStringList.Create;
  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);
    Result.add(s);
    fr.Seek(d, soFromCurrent);
    fr.ReadBuffer(d, 4);
  until d = $FFFF;
end;

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

Evghenusi

Дата 1.12.2006, 16:58 (ссылка)

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

Загрузка ...

майский жук

Профиль
Группа: Участник
Сообщений: 506
Регистрация: 3.8.2006
Где: Молдова, Кишинёв

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

alexeis1 если тебе не трудно напиши как можно из файла "Result.dat" вытащить
названия склеенных файлов в Listbox

я написал такой код, но чтото не получается:

Код


var
n:TStringList;
fr:TFileStream;
begin
fr:=TFileStream.Create(Form1.Edit1.text+Form1.Edit2.text, fmOpenRead);
n:=TStringList.Create;
n.LoadFromStream(fr);
ListBox1.Items.AddStrings(n);

Это сообщение отредактировал(а) Evghenusi - 1.12.2006, 21:26

Alexeis

Дата 1.12.2006, 17:43 (ссылка)

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

Загрузка ...

Амеба

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

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

Evghenusi, ага я чуть-чуть опредил, решение выше smile

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

Evghenusi

Дата 1.12.2006, 21:24 (ссылка)

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

Загрузка ...

майский жук

Профиль
Группа: Участник
Сообщений: 506
Регистрация: 3.8.2006
Где: Молдова, Кишинёв

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

alexeis1

покажи мне, пожалуйста, где указывается
адрес для распаковки файлов

Это сообщение отредактировал(а) Evghenusi - 1.12.2006, 21:26

Alexeis

Дата 1.12.2006, 23:06 (ссылка)

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

Загрузка ...

Амеба

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

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

Цитата(Evghenusi @ 1.12.2006, 21:24

)

покажи мне, пожалуйста, где указывается
адрес для распаковки файлов

А вот же

Цитата

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

путь идет тот который записан, т.е. то что в переменной s если охота то можно добавить к нему путь к нужной папке.

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

Evghenusi

Дата 2.12.2006, 00:08 (ссылка)

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

Загрузка ...

майский жук

Профиль
Группа: Участник
Сообщений: 506
Регистрация: 3.8.2006
Где: Молдова, Кишинёв

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

я тоже сначала подумал что "S" это путь к папке
но выходит ошибка.
скачай архив и посмотри рисунок!

Присоединённый файл ( Кол-во скачиваний: 6 )

Error.zip 7,56 Kb

Alexeis

Дата 2.12.2006, 02:09 (ссылка)

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

Загрузка ...

Амеба

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

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

Ничего удивительного я же не сказал туда писать директорию распаковки, а путь к файлу, т.е. это будет выглядеть так:
f := TFileStream.Create(DirPath + s, fmCreate);
где в DirPath - будет путь к папке для извлечения. При конкатинации мы получим полный путь к каждому из файлов для сохранения.
Похоже вы не поняли как работает этот код...

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

Evghenusi

Дата 2.12.2006, 10:27 (ссылка)

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

Загрузка ...

майский жук

Профиль
Группа: Участник
Сообщений: 506
Регистрация: 3.8.2006
Где: Молдова, Кишинёв

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

Цитата(alexeis1 @ 2.12.2006, 02:09)

Похоже вы не поняли как работает этот код...

да ты прав!
но я сделал как ты сказал, и выходит ошибка,
путь получается 'C:\temt\C:\files\'
путь куда я хочу извлечь и папка, откуда я брал файлы

Это сообщение отредактировал(а) Evghenusi - 2.12.2006, 11:22

Alexeis

Дата 2.12.2006, 16:10 (ссылка)

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

Загрузка ...

Амеба

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

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

Evghenusi, если вы не хотите разбираться в сути, то используйте класс написанный Snowy он по крайней мере полнофункциональный (законченый), я же просто привел принцип для примера, как это делается.

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

Danя

Дата 14.5.2007, 19:10 (ссылка)

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

Загрузка ...

Новичок

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

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

Как добавить файлы в уже созданый архив (*.pak) smile

Snowy

Дата 15.5.2007, 13:37 (ссылка)

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

Загрузка ...

Эксперт

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

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

Модификация паков не предусмотрена.
Написать можно.
Но цель была - создать 2 отдельных класса.
1 - для подготовки данных, которые будут использоваться в программе.
2 - для получения этих данных.
В конечной программе подразумевалось использование только второго класса.
Если нужно оба + модификация, то нужно писать один единый класс.
Цель кода - не архиватор, а подготовка данных для использования в программе.
Если нужен архиватор, то для этого нужно использовать соответствующие компоненты, либо подождать, когда я допишу свою утилиту...

Danя

Дата 15.5.2007, 16:48 (ссылка)

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

Загрузка ...

Новичок

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

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

Ну может все таки можно как - то быстро добавить файлы в архив smile

Я быстренько написал програмку которая упоковывает 6 файлов в архив и распоковывает файлы из какого-либо архива.
Я делаю игру и мне нужно чтобы изображения (а возможно в дальнейшем и звуки) она [игра] брала из архива, который я сам создам, но так как изображений все больше и больше приходится каждый раз пересоздавать архив, а это очень нудно smile

Snowy

Дата 15.5.2007, 17:00 (ссылка)

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

Загрузка ...

Эксперт

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

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

Быстро добавить можно.
А вот быстро написать новый единый клас не получится - много переделывать.

Danя

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

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

Загрузка ...

Новичок

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

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

Тогда скажи как папку засунуть в архив (*.pak) smile

Snowy

Дата 15.5.2007, 17:35 (ссылка)

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

Загрузка ...

Эксперт

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

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

Пофайлово - сканишь файлы FindFirst/FindNext, добавляешь каждый по Add.

Danя

Дата 15.5.2007, 18:02 (ссылка)

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

Загрузка ...

Новичок

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

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

Snowy
Пожалуйста поподробнее, я почти новичок в DELPHI smile

lukas

Дата 15.5.2007, 18:44 (ссылка)

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

Загрузка ...

Опытный

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

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

Danя,

все же просто...

находишь один файл, загружаешь его в TMemoryStream, затем копируешь весь этот поток в конец главного потока например DirectStream (TMemoryStream) и так дальше, с каждым найденным файлом... ;) А потом DirectStream сохраняешь в файл. Для начала научись с потоками работать, а там и сам все поймешь...

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

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

Danя

Дата 15.5.2007, 19:05 (ссылка)

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

Загрузка ...

Новичок

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

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

lukas,
smile

Да.... за время которое я нахожусь на этом форуме я понял, что DELPHI вообще нифига не знаю smile

Пожалуйста можешь объяснить у меня очень мало времения!!!
Мне через неделю показывать игру(хоть в каком - то виде), а у меня нифига ни сделано

Это сообщение отредактировал(а) Danя - 15.5.2007, 19:21

Snowy

Дата 15.5.2007, 19:05 (ссылка)

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

Загрузка ...

Эксперт

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

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

lukas, человек спрашивал, как пользоваться FindFirst, а не теорию склеивания.
К тому же со склеиванием всё давно решено - код в топе.

Danя, видишь поле поиска вверху страницы? Введи туда FindFirst ;-)

Danя

Дата 15.5.2007, 19:21 (ссылка)

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

Загрузка ...

Новичок

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

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

Snowy,
Издеваешься да? smile

Но всёравно спасибо smile

Добавлено @ 19:25

Код


Procedure FindDirInDir(const indir:AnsiString;const wStringList: TStrings;const filemast:AnsiString='*.*');
var ssr : TSearchRec;
begin
  wStringList.Clear;
  if FindFirst(indir+filemast, faAnyFile, ssr)=0 then
    repeat
      if ((ssr.Attr and faDirectory)<>0) and (ssr.Name<>'..') and (ssr.Name<>'.') then
        wStringList.add(ssr.Name);
    until FindNext(ssr)<>0;
  SysUtils.FindClose(ssr);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FindDirInDir('C:\Program Files',Listbox1.Items,'*.*');
end;

Ну а как не папки а название файлов в Листбокс вывести??
Вы не думайте я не леньтяй просто архивация это второе дело (но не менее важное) главное саму игрушку дописать/написать

Это сообщение отредактировал(а) Danя - 15.5.2007, 19:26

Danя

Дата 15.5.2007, 20:25 (ссылка)

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

Загрузка ...

Новичок

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

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

Все ДОШЛО!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! smile

УРЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯЯ smile

ВСЕМ ОГРОМНОЕ СПАСИБО

ПРОСТИТЕ, ЧТО ТУПИЛ

_KLAUS_

Дата 7.8.2007, 18:20 (ссылка)

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

Загрузка ...

Новичок

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

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

Snowy,
Что делаю не так??
Три кнопки, нажимаю на первую создаётся "file.pak"
На вторую создаётся папка "UnPack" - Но она пустая .....
На третью пишет "Bitmap is not avalid"..что не так-то??
Delphi 6

_KLAUS_

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

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

Загрузка ...

Новичок

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

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

Ошибка

Код


Image1.Picture.Bitmap.LoadFromStream(ms);

Я так понял, мы все нужные файлы в картинку пихаем, а как извлекать??

Snowy

Дата 7.8.2007, 20:01 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(_KLAUS_ @ 7.8.2007, 18:20

)

Что делаю не так??
Три кнопки, нажимаю на первую создаётся "file.pak"
На вторую создаётся папка "UnPack" - Но она пустая .....
На третью пишет "Bitmap is not avalid"..что не так-то??

Неверно указал пути к файлам при упаковке.
Посмотри размер pak - он небось байта 4.
Значит ничего не запаковал. А значит и распаковывать нечего smile

Цитата(Snowy @ 11.4.2006, 11:24

)

    Add('C:\*.bmp'); // добавляем в список файлы
    Add('C:\*.mp3');
    Add('C:\*.rar');

Видишь что пакует?
У тебя в корне диска C: есть bmp, mp3 или rar?
Нет? Вот потому ничего и не упаковал.

Цитата(_KLAUS_ @ 7.8.2007, 18:46

)

Я так понял, мы все нужные файлы в картинку пихаем, а как извлекать??

Нет. Нужные файлы мы никуда не пихаем.
Они так и лежат в файле.
Просто мы можем достать оттуда любой из файлов в стрим.
В примере с картинкой мы вытаскиваем из пака первый файл в TMemoryStream, а потом этот стрим грузим в битмап.
Почему первый? Да потому что при добавлении мы сначала добавляли bmp.
Можно указывать не по звёздочке, а конкретный файл. Но это детали.
Файлы сами по себе не достаются. Их нужно доставать через GetFile.
GetFile найдёт в паке выбранный файл (если он там есть) и прочитает его в стрим.
А дальше что хошь с ним, то и делай.

_KLAUS_

Дата 8.8.2007, 06:32 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Snowy @ 7.8.2007, 20:01)

Неверно указал пути к файлам при упаковке.
Посмотри размер pak - он небось байта 4.
Значит ничего не запаковал. А значит и распаковывать нечего

Да не, всё нормально, я правда только свои форматы запихал, а так они в корневом каталоге C:\ лежат , и *.pak получился нормального размера! Но папка UnPack всё равно пустая.
И вот тут если я меняю значения на >0 , то файлы извлекаются но с нулевым размером!!

Код


 if FileList.IndexOf(FileName) < 0 then Exit;

Добавлено через 3 минуты и 43 секунды
Извлечение что-то не получается!!

lukas

Дата 14.9.2007, 18:35 (ссылка)

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

Загрузка ...

Опытный

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

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

Откопал похожий компонент...

TStreamDirector, может добавлять Файлы, Потоки, Списки... вообще тоже очень удобно...

Присоединённый файл ( Кол-во скачиваний: 21 )

StreamDirector.pas 7,95 Kb

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

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

lukas

Дата 14.9.2007, 18:37 (ссылка)

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

Загрузка ...

Опытный

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

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

и вот еще один похожий...

http://www.torry.net/vcl/vcltools/streams/hkstrm.zip

Это сообщение отредактировал(а) lukas - 14.9.2007, 18:38

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

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

Apls

Дата 6.11.2007, 23:11 (ссылка)

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

Загрузка ...

Новичок

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

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

Snowy, соглашусь с _KLAUS_. Сейчас разбираюсь с твоим исходником, тоже самое.
Создается папка UnPack, но файло в ней нет, если в процедуре TFilesLoader.SaveFile поменять знак на ">", то файлы извлекаются, но с нулевым размером. Что делать?

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