Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #4  
Antiguo 03-01-2008
Avatar de elcolo83
elcolo83 elcolo83 is offline
Miembro
 
Registrado: feb 2007
Ubicación: Argentina
Posts: 65
Poder: 20
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
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Aplicación con varios archivos Alexander Varios 8 08-11-2007 15:15:22
obtener el nombre de varios archivos rzf1983 Varios 4 24-10-2007 18:18:29
Abrir varios archivos asociados a la aplicacion JMGR Varios 2 11-02-2007 00:12:39
UPLOAD de varios archivos por código HombreSigma .NET 3 04-12-2005 15:23:07
Borrar varios archivos mrmanuel Varios 5 27-05-2004 02:03:54


La franja horaria es GMT +2. Ahora son las 18:59:12.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi