Архивирование файлов

[Altera]

Привет всем!
Я вот тут фигнёй маюсь, решил несколько файлов в один напихать. Ну и распаковать соответственно.
Ну вроде что-то получилось,
Вот два алгоритма, полный код во вложении

procedure Tmain_form.Button1Click(Sender: TObject);
var
source, dest: file;
s: string[255];
c, counter, intValue: cardinal;
bufHi: string[255];
bufLo: byte;
od: tOpenDialog;
sd: tSaveDialog;
begin
   od := tOpenDialog.Create(self);
   od.Options := od.Options + [ofAllowMultiSelect];
   if not od.Execute then exit;

   //sd.FileName := od.FileName;

   sd := tSaveDialog.Create(self);
   if not sd.Execute then exit;

   //s := inputBox('Comments', 'Input your comments:', 'Atom Altera Testing 123456');

   assignFile(dest, sd.FileName);
   reWrite(dest, 1);

   c := od.Files.Count;
   blockWrite(dest, word(c), 2);

   pb.Position := 0;
   pb.Max := word(c);

   for counter := 0 to c - 1 do
   begin
      assignFile(source, od.Files.Strings[counter]);
      reset(source, 1);

      repaint;

      s := extractFileName(od.Files.Strings[counter]);
      intValue := fileSize(source);

      blockWrite(dest, intValue, 4);
      blockWrite(dest, s, sizeOf(s));

      try
      while filePos(source) < (fileSize(source) - 255) do
      begin
         blockRead(source, bufHi, 255);
         blockWrite(dest, bufHi, 255);
      end;

      if filePos(source) < (fileSize(source)) then
      begin
         while filePos(source) < (fileSize(source)) do
         begin
            blockRead(source, bufLo, 1);
            blockWrite(dest, bufLo, 1);
         end;
      end;
      closeFile(source);
      pb.Position := counter + 1;
      except

      end;
   end;

   pb.Position := 0;

   od.Free;
   closeFile(dest);
end;

procedure Tmain_form.Button2Click(Sender: TObject);
var
source, dest: file;
s: string[255];
c, c2, counter, intValue: cardinal;
bufHi: string[255];
bufLo: byte;
od: tOpenDialog;
sd: tSaveDialog;
begin
   od := tOpenDialog.Create(self);
   if not od.Execute then exit;

   createDir(extractFilePath(od.FileName)+'Extract');

   assignFile(source, od.FileName);
   reset(source, 1);

   repaint;

   blockRead(source, c, 2);

   pb.Position := 0;
   pb.Max := word(c);

   for counter := 1 to word(c) do
   begin
      blockRead(source, intValue, 4);
      blockRead(source, s, sizeOf(s));

      assignFile(dest, extractFilePath(od.FileName)+'Extract\'+s);
      reWrite(dest, 1);
      try
      while filePos(dest) < (intValue - 255) do
      begin
         blockRead(source, bufHi, 255);
         blockWrite(dest, bufHi, 255);
      end;

      if filePos(dest) < (intValue) then
      begin
         while filePos(dest) < (intValue) do
         begin
            blockRead(source, bufLo, 1);
            blockWrite(dest, bufLo, 1);
         end;
      end;
      except

      end;
      closeFile(dest);
      pb.Position := counter;
   end;

   pb.Position := 0;
   closeFile(source);
end;

И вот что я хочу спросить: Я не могу разве брать структуру больше, чем 255 байт? И ещё, может что-то занимался этим, как мне получить картинку, скажем запаованную в таким алгоритмом из файла не распаковывая её в файл. Я имею ввиду, что распаковывать не в файл, как у меня, а в, скажем, tBitmap. Или что вы там можете предложить?

[Pas]

Сообщение от Altera

Привет всем!
Я вот тут фигнёй маюсь, решил несколько файлов в один напихать. Ну и распаковать соответственно.
Ну вроде что-то получилось,
Вот два алгоритма, полный код во вложении

procedure Tmain_form.Button1Click(Sender: TObject);
var
source, dest: file;
s: string[255];
c, counter, intValue: cardinal;
bufHi: string[255];
bufLo: byte;
od: tOpenDialog;
sd: tSaveDialog;
begin
   od := tOpenDialog.Create(self);
   od.Options := od.Options + [ofAllowMultiSelect];
   if not od.Execute then exit;

   //sd.FileName := od.FileName;

   sd := tSaveDialog.Create(self);
   if not sd.Execute then exit;

   //s := inputBox('Comments', 'Input your comments:', 'Atom Altera Testing 123456');

   assignFile(dest, sd.FileName);
   reWrite(dest, 1);

   c := od.Files.Count;
   blockWrite(dest, word(c), 2);

   pb.Position := 0;
   pb.Max := word(c);

   for counter := 0 to c - 1 do
   begin
      assignFile(source, od.Files.Strings[counter]);
      reset(source, 1);

      repaint;

      s := extractFileName(od.Files.Strings[counter]);
      intValue := fileSize(source);

      blockWrite(dest, intValue, 4);
      blockWrite(dest, s, sizeOf(s));

      try
      while filePos(source) < (fileSize(source) - 255) do
      begin
         blockRead(source, bufHi, 255);
         blockWrite(dest, bufHi, 255);
      end;

      if filePos(source) < (fileSize(source)) then
      begin
         while filePos(source) < (fileSize(source)) do
         begin
            blockRead(source, bufLo, 1);
            blockWrite(dest, bufLo, 1);
         end;
      end;
      closeFile(source);
      pb.Position := counter + 1;
      except

      end;
   end;

   pb.Position := 0;

   od.Free;
   closeFile(dest);
end;

procedure Tmain_form.Button2Click(Sender: TObject);
var
source, dest: file;
s: string[255];
c, c2, counter, intValue: cardinal;
bufHi: string[255];
bufLo: byte;
od: tOpenDialog;
sd: tSaveDialog;
begin
   od := tOpenDialog.Create(self);
   if not od.Execute then exit;

   createDir(extractFilePath(od.FileName)+'Extract');

   assignFile(source, od.FileName);
   reset(source, 1);

   repaint;

   blockRead(source, c, 2);

   pb.Position := 0;
   pb.Max := word(c);

   for counter := 1 to word(c) do
   begin
      blockRead(source, intValue, 4);
      blockRead(source, s, sizeOf(s));

      assignFile(dest, extractFilePath(od.FileName)+'Extract\'+s);
      reWrite(dest, 1);
      try
      while filePos(dest) < (intValue - 255) do
      begin
         blockRead(source, bufHi, 255);
         blockWrite(dest, bufHi, 255);
      end;

      if filePos(dest) < (intValue) then
      begin
         while filePos(dest) < (intValue) do
         begin
            blockRead(source, bufLo, 1);
            blockWrite(dest, bufLo, 1);
         end;
      end;
      except

      end;
      closeFile(dest);
      pb.Position := counter;
   end;

   pb.Position := 0;
   closeFile(source);
end;

И вот что я хочу спросить: Я не могу разве брать структуру больше, чем 255 байт? И ещё, может что-то занимался этим, как мне получить картинку, скажем запаованную в таким алгоритмом из файла не распаковывая её в файл. Я имею ввиду, что распаковывать не в файл, как у меня, а в, скажем, tBitmap. Или что вы там можете предложить?

LoadFromStream