Solved

advance version of "inserting a file into another file "

Posted on 2002-04-26
6
171 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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

707 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now