Ver Mensaje Individual
  #4  
Antiguo 03-01-2008
Avatar de elcolo83
elcolo83 elcolo83 is offline
Miembro
 
Registrado: feb 2007
Ubicación: Argentina
Posts: 65
Reputación: 18
elcolo83 Va por buen camino
Bueno.... aca esta la primera parde del problema resuelto...
es un form con 3 botones, un listbox y un opendialog respectivamente renombrados tengo esto:

Código Delphi [-]

unit ConcatArch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm3 = class(TForm)
    BAgregar: TButton;
    BExtraer: TButton;
    Lista: TListBox;
    OpenD: TOpenDialog;
    Contenido: TButton;
    procedure BAgregarClick(Sender: TObject);
    procedure BExtraerClick(Sender: TObject);
    procedure ContenidoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form3: TForm3;

implementation
Uses FConcatArch;
{$R *.dfm}


procedure TForm3.BAgregarClick(Sender: TObject);
var i: integer;
var
Stream: TFileStream;
begin
if OpenD.Execute then
  begin
    Stream:= TfileStream.Create('d:\prueba.concat',fmShareExclusive or fmCreate);
    try
      for I := 0 to OpenD.Files.Count - 1 do
        Agregar(OpenD.Files[i], Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TForm3.BExtraerClick(Sender: TObject);
var Stream: TFileStream;
begin
if Lista.ItemIndex>=0 then
begin
  Stream:= TfileStream.Create('d:\prueba.concat',fmOpenRead or fmShareDenyWrite);
  try
    Extraer('d:\Temp',Stream, Lista.Items[Lista.ItemIndex]);
  finally
    Stream.Free;
  end;
end;
end;

procedure TForm3.ContenidoClick(Sender: TObject);
var Stream: TFileStream;
    L: TStrings;
begin
Stream:= TfileStream.Create('d:\prueba.concat',fmOpenRead or fmShareDenyWrite);
  try
    L:= TStrings.Create;
    VerContenido(Stream, L);
    Lista.Items:= L;
    L.Free;
  finally
    Stream.Free;
  end;
end;

end.


Luego en una unidad que llame FConcatArch tengo estas funciones:

Código Delphi [-]
unit FConcatArch;

interface
Uses SysUtils, Classes;

  type TCabecera = packed record
    Nombre: String[255];
    Longitud: int64;
    end;


procedure Agregar(Archivo: string; Stream: TStream);
procedure Extraer(Ruta: string; Stream: TStream; NombreArch: String);
procedure VerContenido(Stream: TStream; var Lista: TStrings);


implementation


procedure Agregar(Archivo: string; Stream: TStream);
var
  Cabecera: TCabecera;
  FileStream: TFileStream;
begin
  Stream.Seek(0,soFromEnd);
  FileStream:= TFileStream.Create(Archivo,fmOpenRead or fmShareDenyWrite);
  try
    FillChar(Cabecera,Sizeof(Cabecera),0);
    Cabecera.Nombre:= ExtractFileName(Archivo);
    Cabecera.Longitud:= FileStream.Size;
    Stream.Write(Cabecera,Sizeof(Cabecera));
    Stream.CopyFrom(FileStream,0);
  finally
    FileStream.Free;
  end;
end;



procedure Extraer(Ruta: string; Stream: TStream; NombreArch: String);
var
  Cabecera: TCabecera;
  FileStream: TFileStream;
begin
  if Copy(Ruta,Length(Ruta),1) <> '\' then
    Ruta:= Ruta + '\';
  Stream.Seek(0,soFromBeginning);
  while Stream.Position < Stream.Size do
    begin
      Stream.Read(Cabecera,Sizeof(Cabecera));
      if Cabecera.Nombre=NombreArch then
        begin
          with TFileStream.Create(Ruta + Cabecera.Nombre,fmCreate or fmShareExclusive) do
            try
              CopyFrom(Stream,Cabecera.Longitud);
            finally
              Free;
            end;
          Break;
        end
      else Stream.Position:= Stream.Position+Cabecera.Longitud;
    end;
end;


procedure VerContenido(Stream: TStream; var Lista: TStrings);
var
  Cabecera: TCabecera;
  FileStream: TFileStream;
  L: TStringList;
  i: integer;
begin
  L:= TStringList.Create;
  Stream.Seek(0,soFromBeginning);
  L.Clear;
  while Stream.Position < Stream.Size do
    begin
      Stream.Read(Cabecera,Sizeof(Cabecera));
      Stream.Position:= Stream.Position+ Cabecera.Longitud;
      L.Add(Cabecera.Nombre);
    end;
  Lista:= L;
end;


end.


las funciones agregar y extraer las saque de este hilo http://www.clubdelphi.com/foros/arch...hp/t-2832.html
y modifique ligeramente la funcion extraer

Con esto ya tengo los archivos metidos en uno solo ahora me queda lo de la encriptacion...
Responder Con Cita