advance version of "inserting a file into another file "

hi,


in another post i asked how to save files into 1 file using tfilestream.

near the bottom is the code that was posted.

i need to use a listbox to handle multiple files and it possibly needs saving to a ini file or something so it knows the file structure of it.

any help would be great.

cheers

classic_gaming

code:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   Button4: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

var
 ThirdFile:string = 'c:\test3.txt';

// adds Source file to Dest file
procedure AddSecondFile(Source, Dest, StreamName: string);
var
NewFile: TFileStream;
OldFile: TFileStream;
begin
NewFile:=TFileStream.Create(Dest+':'+StreamName, fmCreate);
OldFile:=TFileStream.Create(Source, fmShareDenyNone);
NewFile.CopyFrom(OldFile, OldFile.Size);
FreeAndNil(OldFile);
FreeAndNil(NewFile);
end;

// Extract second file to Dest file
procedure ExtractSecondFile(Source, Dest, StreamName: string);
var
NewFile: TFileStream;
OldFile: TFileStream;
begin
OldFile:=TFileStream.Create(Source+':'+StreamName, fmShareDenyNone);
NewFile:=TFileStream.Create(Dest, fmCreate);
NewFile.CopyFrom(OldFile, OldFile.Size);
FreeAndNil(OldFile);
FreeAndNil(NewFile);
end;

// add 'c:\test2.txt' to 'c:\temp\test1.doc'
procedure TForm1.Button1Click(Sender: TObject);
begin
 AddSecondFile('c:\test2.txt','c:\temp\test1.doc','file1');
end;

// extract the second file to another directory 'c:\temp\test2.txt'
procedure TForm1.Button2Click(Sender: TObject);
begin
 ExtractSecondFile('c:\temp\test1.doc','c:\temp\test2.txt','file1');
end;

// add 'c:\test3.txt' to 'c:\temp\test1.doc'
procedure TForm1.Button3Click(Sender: TObject);
begin
 AddSecondFile(ThirdFile,'c:\temp\test1.doc', ExtractFileName(ThirdFile));
end;

// extract the third file to another directory 'c:\temp\test3.txt'
procedure TForm1.Button4Click(Sender: TObject);
begin
  ExtractSecondFile('c:\temp\test1.doc','c:\temp\test3.txt',ExtractFileName(ThirdFile));
end;

end.
classic_gamingAsked:
Who is Participating?
 
ITugayConnect With a Mentor Commented:
OK, sample is here:

const
  MaxFilesCount = 32;       // maximum number of files in package
  PackageIden = $5467F4D2;  // unique file identifier

type
  // info about one file
  TFileInfo = record
    Name: string[240];
    Size: Integer;
  end;

  // package header
  TPackageHeader = record
    Iden: Integer;  // unique identifier, allow to check that file is correct package
    Count: Integer; // number of stored files
    Files: array[0..MaxFilesCount -1] of TFileInfo; // info about files
  end;

  // object to serve package of files
  TFilePackage = class(TStringList)
  private
    FHeader: TPackageHeader;
    FFileName: String;
  protected
  public
    procedure Clear; override;

    // create new package
    procedure CreatePackage(const AFileName: String);

    // open an existing package
    procedure OpenPackage(const AFileName: String);

    // add file to package
    procedure FileToPackage(const AFileName: String);

    // extract file from given index to the file
    procedure ExtractFile(Index: Integer; AFileName: String);

    property FileName: String read FFileName;
  end;

  TForm1 = class(TForm)
    ListBox1: TListBox;
    btCreatePackage: TSpeedButton;
    btOpenPackage: TSpeedButton;
    btAddFile: TSpeedButton;
    btExtractFile: TSpeedButton;
    btExtractByName: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btCreatePackageClick(Sender: TObject);
    procedure btAddFileClick(Sender: TObject);
    procedure btOpenPackageClick(Sender: TObject);
    procedure btExtractFileClick(Sender: TObject);
    procedure btExtractByNameClick(Sender: TObject);
  private
  public
    Pkg: TFilePackage;
  end;


var
  Form1: TForm1;

implementation

{$R *.DFM}

//------------------------------------------------------------------------------
//
//        TFilePackage
//
//------------------------------------------------------------------------------
procedure TFilePackage.CreatePackage(const AFileName: String);
var
  F: TFileStream;
begin
  Clear;
  F := TFileStream.Create(AFileName, fmCreate);
  try
    F.Write(FHeader, SizeOf(FHeader));
    FFileName := AFileName;
  finally
    F.Free;
  end;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TFilePackage.Clear;
begin
  Inherited Clear;
  FillChar(FHeader, SizeOf(FHeader), 0);
  FHeader.Iden := PackageIden;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TFilePackage.OpenPackage(const AFileName: String);
var
  F: TFileStream;
  I: Integer;
begin
  Clear;
  F := TFileStream.Create(AFileName, fmOpenRead);
  try
    F.Read(FHeader, SizeOf(FHeader));

    // check for correct package
    if FHeader.Iden <> PackageIden then
    begin
      Clear;
      raise Exception.CreateFmt('Invalid file format %s', [AFileName]);
    end;

    FFileName := AFileName;

    // copy file names to self list
    // easy way to find index of file by it's name
    for I := 0 to FHeader.Count - 1 do
      AddObject(FHeader.Files[I].Name, Pointer(FHeader.Files[I].Size));
  finally
    F.Free;
  end;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TFilePackage.FileToPackage(const AFileName: String);
var
  F: TFileStream;
  W: TFileStream;
begin
  OpenPackage(FFileName);
  F := TFileStream.Create(AFileName, fmOpenRead);
  AddObject(AFileName, Pointer(F.Size));

  // add file info to header
  with FHeader do
  begin
    Files[Count].Name := AFileName;
    Files[Count].Size := F.Size;
    inc(Count);
  end;
  try
    W := TFileStream.Create(FFileName, fmOpenWrite);
    try

      // append file to the end of the package
      W.Seek(0, soFromEnd);
      W.CopyFrom(F, 0);
      W.Seek(0, soFromBeginning);

      // write new header on success
      W.Write(FHeader, SizeOf(FHeader));
    finally
      W.Free;
    end;
  finally
    F.Free;
  end;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TFilePackage.ExtractFile(Index: Integer; AFileName: String);
var
  F: TFileStream;
  W: TFileStream;
  I: Integer;
  P: Integer;
begin
  OpenPackage(FFileName);
  F := TFileStream.Create(FFileName, fmOpenRead);
  W := TFileStream.Create(AFileName, fmCreate);
  try
    // find file position on the package
    P := SizeOf(FHeader);
    for I := 0 to Index - 1 do
      P := P + FHeader.Files[I].Size;

    F.Seek(P, soFromBeginning);
    W.CopyFrom(F, FHeader.Files[Index].Size);
  finally
    W.Free;
    F.Free;
  end;
end;

//------------------------------------------------------------------------------
//
//        TForm1
//
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  Pkg := TFilePackage.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Pkg.Free;
end;

procedure TForm1.btCreatePackageClick(Sender: TObject);
begin
  Pkg.CreatePackage('F:\PACK000.DAT');
end;

procedure TForm1.btAddFileClick(Sender: TObject);
begin
  Pkg.FileToPackage('F:\layer.sql');
  Pkg.FileToPackage('F:\payment.sql');
  Pkg.FileToPackage('F:\provlog.sql');
end;

procedure TForm1.btOpenPackageClick(Sender: TObject);
begin
  Pkg.OpenPackage('F:\PACK000.DAT');
  Listbox1.Items.Assign(Pkg);
end;

procedure TForm1.btExtractFileClick(Sender: TObject);
begin
  Pkg.ExtractFile(ListBox1.ItemIndex, 'F:\Q0.TXT');
end;

procedure TForm1.btExtractByNameClick(Sender: TObject);
begin
  Pkg.ExtractFile(Pkg.IndexOf('F:\layer.sql'), 'F:\Q1.TXT');
end;
0
 
ITugayCommented:
Hi classic_gaming,

may be another way. You can store description of a package at the beginning of the file. There should be info about number of embedded files, its names, size and offset relative beginning of the package. Using this way you can easy get info about package structure and extract any file form it.

Do you need example?

----
Igor.
0
 
classic_gamingAuthor Commented:
yes please :)

cheers
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
ITugayCommented:
do you solve the problem or still need a sample. If yes, then I have one question:

do you know all files to be packed BEFORE create package?
What maximum amount of files should be packed?

----
Igor
0
 
classic_gamingAuthor Commented:
this is exactly what i needed many thanks :)
0
 
ITugayCommented:
you are wellcome, thanx for "A" grade :-)
0
All Courses

From novice to tech pro — start learning today.