Solved

advance version of "inserting a file into another file "

Posted on 2002-04-26
6
175 Views
Last Modified: 2010-04-04
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.
0
Comment
Question by:classic_gaming
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
6 Comments
 
LVL 9

Expert Comment

by:ITugay
ID: 6972910
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
 

Author Comment

by:classic_gaming
ID: 6973043
yes please :)

cheers
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6976387
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 9

Accepted Solution

by:
ITugay earned 100 total points
ID: 6976481
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
 

Author Comment

by:classic_gaming
ID: 6976867
this is exactly what i needed many thanks :)
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6976875
you are wellcome, thanx for "A" grade :-)
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video shows how to use Hyena, from SystemTools Software, to update 100 user accounts from an external text file. View in 1080p for best video quality.

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question