Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

advance version of "inserting a file into another file "

Posted on 2002-04-26
6
Medium Priority
?
178 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
  • 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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 9

Accepted Solution

by:
ITugay earned 400 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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Integration Management Part 2
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…

773 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