Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

advance version of "inserting a file into another file "

Posted on 2002-04-26
6
Medium Priority
?
177 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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

[Webinar] Lessons on Recovering from Petya

Skyport is working hard to help customers recover from recent attacks, like the Petya worm. This work has brought to light some important lessons. New malware attacks like this can take down your entire environment. Learn from others mistakes on how to prevent Petya like worms.

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses

705 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