Solved

Multifile packing with folders

Posted on 2003-11-01
10
223 Views
Last Modified: 2012-05-04
Hi all

I am making a program in wich there is a function to make a backup. I want to use a method to pack everything together into ONE file so I use this method below.

BUT, I want to get the folders like they are. This way I can only pick the files in ONE folder, if there is a folder in that folder it WONT be packed.

Anyone who can help.

Thanx

type
TMultiRec = record
   Size: Cardinal;
   Name: String[255];

procedure TForm1.Button1Click(Sender: TObject);
var
Folder1: String;
SearRec : TSearchRec;
StrList1: TStringList;
NumFiles, i: Integer;
SizeFiles: Cardinal;
MultiFile, InFile: TFileStream;
Multi1: TMultiRec;

begin

NumFiles := 0;
SizeFiles := 0;

Folder1 := 'C:\temp\';
StrList1 := TStringList.Create;
try
if FindFirst(Folder1+'\*.*', faAnyFile, SearRec) = 0 then
repeat
if SearRec.Attr and faDirectory < 1 then
begin
Inc(NumFiles);
StrList1.Add(Folder1 + '\'+SearRec.Name);
Inc(SizeFiles, SearRec.Size);
end;
until FindNext(SearRec) <> 0;
FindClose(SearRec);
DeleteFile('temp');
MultiFile := TFileStream.Create('c:\save\temp.dir', fmCreate or fmOpenWrite or fmShareDenyWrite);
try
i := 1431544;
MultiFile.Write(i, SizeOf(Integer));
for i := 0 to StrList1.Count-1 do
begin
InFile := TFileStream.Create(StrList1[i], fmOpenRead or fmShareDenyWrite);
try
if InFile.Size > 0 then
begin
Multi1.Size := InFile.Size;
Multi1.Name := ExtractFileName(StrList1[i]);
MultiFile.Write(Multi1, SizeOf(TMultiRec));
MultiFile.CopyFrom(InFile, 0);
end;
finally
InFile.Free;
end;
end;
Multi1.Name := 't1e2m3p4';
MultiFile.Write(Multi1, SizeOf(TMultiRec));
finally
MultiFile.Free;
end;
finally
StrList1.Free;
end;
end;
end.
0
Comment
Question by:Fixzy
  • 6
  • 3
10 Comments
 
LVL 5

Expert Comment

by:DeerBear
ID: 9665200
Hi,

I would suggest that you try Turbo Power Abbrevia components.
You can find them on SourceForge.

HTH,

Andrew
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9666986
hello Fixzy, are you asking about using  FindFirst  or about making the multi-data file ? ?  ?

you can get some information about making and reading muti-data files at my site -

http://www.angelfire.com/hi5/delphizeus/customfiles.html
0
 

Author Comment

by:Fixzy
ID: 9667350
I am askin how to get the folders into the one file creation...ex I want to put all files and folders from c:\my folders <-----folder contains files and folders

I can only get the files in the folder...not the other folders.

/Fixzy
0
 
LVL 33

Accepted Solution

by:
Slick812 earned 125 total points
ID: 9674078
OK, found some time to look at your code, you will not get the sub folders unless you do another search for every sub-folder and get it's files.
Here is some code for a button click that will get all of the files in all of the folders (sub-folders also) in a given folder, I have left out the string list and used a memo so I could see the files that were going in, you can replace the string List for the Meno1.Lines. . .
My main addition is the SearchAgain procedure




procedure TForm1.sbut_FindFirstClick(Sender: TObject);
type
TMultiRec = record
   Size: Cardinal;
   Name: String[255];
   end;

var
SearRec : TSearchRec;
Folder1: String;
NumFiles, i: Integer;
SizeFiles: Cardinal;
MultiFile, InFile: TFileStream;
Multi1: TMultiRec;

  procedure SearchAgain(Fold: String);
    var
    SearRec2: TSearchRec;
    begin
    if FindFirst(Fold+'\*.*', faAnyFile, SearRec2) = 0 then
    repeat
      if SearRec2.Attr and faDirectory <> 0 then
        begin
        if (SearRec2.Name = '.') or (SearRec2.Name = '..') then Continue;
        SearchAgain(Fold + '\'+ SearRec2.Name);
        end else
        begin
        Inc(NumFiles);
        Memo1.Lines.Add(Fold + '\'+SearRec2.Name);
        Inc(SizeFiles, SearRec.Size);
        end;
    until FindNext(SearRec2) <> 0;
    FindClose(SearRec2);
    end;

begin
{I use a Memo1.Lines instead of a StringList so I can see what file are going in}
Memo1.Lines.Clear;
NumFiles := 0;
SizeFiles := 0;

Folder1 := 'C:\temp';
{I have changed the \ so it will use the folder names from FindFirst}
if FindFirst(Folder1+'\*.*', faAnyFile, SearRec) = 0 then
repeat
{to keep the files list in order I get the Files of the
original Folder First, and next I will get the other Folders}
  if SearRec.Attr and faDirectory = 0 then
    begin
    Inc(NumFiles);
    Memo1.Lines.Add(Folder1 + '\'+SearRec.Name);
    Inc(SizeFiles, SearRec.Size);
    end;
  until FindNext(SearRec) <> 0;
FindClose(SearRec);

if FindFirst(Folder1+'\*.*', faAnyFile, SearRec) = 0 then
repeat
  if SearRec.Attr and faDirectory <> 0 then
    begin
    if (SearRec.Name = '.') or (SearRec.Name = '..') then Continue;
    SearchAgain(Folder1 + '\'+SearRec.Name);
    end;
  until FindNext(SearRec) <> 0;
FindClose(SearRec);

{the next tests for no Files and Large number of files}
if (NumFiles = 0) or (SizeFiles = 0) then
  begin
  ShowMessage('CANCELED - There are NO files or no file data');
  Exit;
  end;

if NumFiles > 300 then
if MessageBox(Handle, PChar('There are '+IntToStr(NumFiles)+' Files in these folders'#10'Do you want to continue this Backup? ?'),
              'DO YOU WANT TO CONTINUE? ?', MB_YESNO or MB_ICONQUESTION) <> ID_YES then Exit;

if SizeFiles > 24000000 then
if MessageBox(Handle, PChar('There are '+IntToStr(SizeFiles)+' Bytes in these files'#10'Do you want to continue this Backup? ?'),
              'DO YOU WANT TO CONTINUE? ?', MB_YESNO or MB_ICONQUESTION) <> ID_YES then Exit;

MultiFile := TFileStream.Create('E:\temp.dir', fmCreate or fmOpenWrite or fmShareDenyWrite);
try
  i := 1431501;
  MultiFile.Write(i, SizeOf(Integer));
  for i := 0 to Memo1.Lines.Count-1 do
    begin
    InFile := TFileStream.Create(Memo1.Lines[i], fmOpenRead or fmShareDenyWrite);
    try
      if InFile.Size > 0 then
        begin
        Multi1.Size := InFile.Size;
        Multi1.Name := ExtractFileName(Memo1.Lines[i]);
        MultiFile.Write(Multi1, SizeOf(TMultiRec));
        MultiFile.CopyFrom(InFile, 0);
        end;
      finally
      InFile.Free;
      end;
  end;
  Multi1.Name := 't1e2m3p4';
  MultiFile.Write(Multi1, SizeOf(TMultiRec));
  finally
  MultiFile.Free;
  end;
end;
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9674087
My code does NOT preservere the original File Paths of each file, just their file name, as your code did
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:Fixzy
ID: 9674344
Hi Slick812.

It works fine, U will get the points....just one more Q...When I try to extract the files and folders I get stream read error all the time, think I made something wrong when I try to unpack it all.

Could u help with a liiiiitle bit of code :D

/Fixzy
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9683702
OK, will have time tomorrow
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9691139
ok Fixzy, Here is the code for 2 button clicks, the first one will search a Folder and write all of the files found there and in subfolders to a single multiFile. This will record all of the Sub-folder paths into the file, so when you read this backup file it will create all of the folders in the original and write all of the files back in the same sub-folder arrangement according to a "Base" Folder. The second button click will read a backup file and then read the folder paths out and create that folder if it does not exist, and then write all of the files into each separate sub-folder.
This even does zero byte files and empty folders

procedure TForm1.sbut_WriteBackUpClick(Sender: TObject);
type
TMultiRec = record
   Size: Cardinal;
   Name: String[255];
   end;

var
FileList: TStringList;
SearRec : TSearchRec;
Folder1, BaseFolder, COB: String;
NumFiles, i: Integer;
SizeFiles, sLen: Cardinal;
MultiFile, InFile: TFileStream;
Multi1: TMultiRec;
wID: Word;

  function ChopOffBase(Full, Base: String): String;
    var
    Pos1: Integer;
    begin
    {this extracts the Sub Folder from the Full Path}
    Result := '';
    if Full[Length(Full)] = '\' then
    Delete(Full, Length(Full), 1);
    if Base[Length(Base)] = '\' then
    Delete(Base, Length(Base), 1);

    if Length(Full) < Length(Base)+2 then Exit;

    Pos1 := Pos(Base, Full);
    if Pos1 = 0 then Exit;

    Full := Copy(Full, Pos1+Length(Base), Length(Full));
    Result := Full;
    end;

  function SearchAgain(Fold: String): Boolean;
    var
    save1: String;
    SearRec2: TSearchRec;
    DoIt, noSave: Boolean;
    begin
    {this is called for each folder and does a search of eash sub-folder}
    Result := True;
    Application.ProcessMessages;
    DoIt := True;
    NoSave := True;
    COB := ChopOffBase(Fold, BaseFolder);
    if COB = '' then
      begin
      ShowMessage('ERROR - Folder name error, can not do backup');
      Result := False;
      Exit;
      end;
    save1 := '?'+ COB;
    if FindFirst(Fold+'\*.*', faAnyFile, SearRec2) = 0 then
    begin
    repeat
      if SearRec2.Attr and faDirectory = 0 then
        begin
        if DoIt then
          begin
          NoSave := False;
          {I need to add the folder once, each time SearchAgain is called}
          FileList.Add('?'+ChopOffBase(Fold, BaseFolder));
          Memo1.Lines.Add('?'+ChopOffBase(Fold, BaseFolder));
          DoIt := False;
          end;
        Inc(NumFiles);
        Memo1.Lines.Add(Fold + '\'+SearRec2.Name);
        FileList.Add(Fold + '\'+SearRec2.Name);
        Inc(SizeFiles, SearRec2.Size);
        end else
        begin
        DoIt := True;
        if (SearRec2.Name = '.') or (SearRec2.Name = '..') then Continue;
        if Not SearchAgain(Fold + '\'+ SearRec2.Name) then
          begin
          Result := False;
          Break;
          end;
        end;
    until FindNext(SearRec2) <> 0;
    if NoSave then
      begin
      {if a folder is empty then NoSave is true}
      FileList.Add(save1);
      Memo1.Lines.Add(save1);
      end;
    end;
    FindClose(SearRec2);
    end;

begin
Memo1.Lines.Clear;
FileList := TStringList.Create;
NumFiles := 0;
SizeFiles := 0;

Folder1 := 'C:\Temp';
if Folder1[Length(Folder1)] = '\' then
    Delete(Folder1, Length(Folder1), 1);

BaseFolder := Copy(Folder1, LastDelimiter('\,:', Folder1)+1, 2000);
{In order to record the File Paths for ALL of the files, I have a
 BASE folder, which will be the starting point}
if Length(BaseFolder) < 1 then
BaseFolder := Folder1[1];
{If Folder1 is a Drive, I need to have a BaseFolder so I just give it the Drive Letter}
Memo1.Lines.Add('?'+BaseFolder);
FileList.Add('?'+BaseFolder);

if FindFirst(Folder1+'\*.*', faAnyFile, SearRec) = 0 then
repeat
  if SearRec.Attr and faDirectory = 0 then
    begin
    {Get all of the files first}
    Inc(NumFiles);
    Memo1.Lines.Add(Folder1 + '\'+SearRec.Name);
    FileList.Add(Folder1 + '\'+SearRec.Name);
    Inc(SizeFiles, SearRec.Size);
    end;
  until FindNext(SearRec) <> 0;
FindClose(SearRec);

if FindFirst(Folder1+'\*.*', faAnyFile, SearRec) = 0 then
repeat
  if SearRec.Attr and faDirectory <> 0 then
    begin
    if (SearRec.Name = '.') or (SearRec.Name = '..') then Continue;
    if not SearchAgain(Folder1 + '\'+SearRec.Name) then
    Exit;
    end;
  until FindNext(SearRec) <> 0;
FindClose(SearRec);


{the next tests for no Files and Large number of files}
if (NumFiles = 0) or (SizeFiles = 0) then
  begin
  ShowMessage('CANCELED - There are NO files or no file data');
  Exit;
  end;

if NumFiles > 300 then
if MessageBox(Handle, PChar('There are '+IntToStr(NumFiles)+' Files in these folders'#10'Do you want to continue this Backup? ?'),
              'DO YOU WANT TO CONTINUE? ?', MB_YESNO or MB_ICONQUESTION) <> ID_YES then Exit;

if SizeFiles > 24000000 then
if MessageBox(Handle, PChar('There are '+IntToStr(SizeFiles)+' Bytes in these files'#10'Do you want to continue this Backup? ?'),
              'DO YOU WANT TO CONTINUE? ?', MB_YESNO or MB_ICONQUESTION) <> ID_YES then Exit;

MultiFile := TFileStream.Create('E:\temp.dir', fmCreate or fmOpenWrite or fmShareDenyWrite);
try
  i := 1431503;  // File Type and version ID
  MultiFile.Write(i, SizeOf(Integer));
  for i := 0 to FileList.Count-1 do
    begin
    if FileList[i][1] = '?' then
      begin
      wID := $FCCF;
      {I use Three Word data segment ID's, the first is $FCCF
      which is for sub-Folder name String Data}
      MultiFile.Write(wID, SizeOf(wID));
      sLen := Length(FileList[i]);
      MultiFile.Write(sLen, SizeOf(Cardinal));
      MultiFile.Write(FileList[i][1], sLen);
      end else
      begin
      InFile := TFileStream.Create(FileList[i], fmOpenRead or fmShareDenyWrite);
      try
        wID := $CFFC;
        {the next data segment ID is $CFFC, and will designate a
        File Data segment}
        MultiFile.Write(wID, SizeOf(wID));
        Multi1.Size := InFile.Size;
        Multi1.Name := ExtractFileName(FileList[i]);
        MultiFile.Write(Multi1, SizeOf(TMultiRec));
        if InFile.Size > 0 then
        MultiFile.CopyFrom(InFile, 0);
        finally
        InFile.Free;
        end;
      end;
    end;
  wID := $C0C0;
  {the last data segment ID is $C0C0, and will designate the
        END of the file}
  MultiFile.Write(wID, SizeOf(wID));
  {Multi1.Name := '?*t1e2m3p4';
  MultiFile.Write(Multi1, SizeOf(TMultiRec));}
  finally
  MultiFile.Free;
  end;
ShowMessage('Finished BackUp'#10'Number of File is '+IntToStr(NumFiles)+#10'Total Size of Files is '+IntToStr(SizeFiles));
end;




procedure TForm1.sbut_ReadBackupClick(Sender: TObject);
type
TMultiRec = record
   Size: Cardinal;
   Name: String[255];
   end;

var
BackUpFile, OutFolder, BaseFolder, SubDir: String;
NumFiles, i: Integer;
sLen: Cardinal;
MultiFile, OutFile: TFileStream;
Multi1: TMultiRec;
wID: Word;
begin
NumFiles := 0;
OutFolder := 'E:\Demos';
{OutFolder is the Path to the folder to write the new files to}
if Not DirectoryExists(OutFolder) then
  begin
  ShoWMessage('ERROR - '+OutFolder+#10'Folder does NOT Exist');
  Exit;
  end;

BackUpFile := 'E:\temp.dir';
{BackUpFile is the backup file that will be opened and read}
if not FileExists(BackUpFile) then
  begin
  ShowMessage('ERROR - '+BackUpFile+#10'Back Up File File Does NOT Exist');
  Exit;
  end;
MultiFile := TFileStream.Create(BackUpFile, fmOpenRead or fmShareDenyWrite);
try
  MultiFile.Read(i, SizeOf(Integer));
  if i <> 1431503 then
    begin
    ShowMessage('ERROR - This is NOT the correct file type or Version'#10'Can Not Load');
    Exit;
    end;
  MultiFile.Read(wID, SizeOf(wID));
  if wID <> $FCCF then
    begin
    {if wID is not $FCCF for a folder name string, then something is wrong}
    ShowMessage('ERROR - Incorrect File Read at 1, Read has Failed');
    Exit
    end;
  MultiFile.Read(sLen, SizeOf(Cardinal));
  if sLen < 2 then
    begin
    ShowMessage('ERROR - Incorrect File Read at 2, Read has Failed');
    Exit;
    end;
  SetLength(BaseFolder, sLen);
  MultiFile.Read(BaseFolder[1], sLen);
  if BaseFolder[1] <> '?' then
    begin
    ShowMessage('ERROR - Incorrect File Read at 3, Read has Failed');
    Exit;
    end;
  Delete(BaseFolder, 1, 1);
  if Not DirectoryExists(OutFolder+'\'+BaseFolder) then
  if not CreateDir(OutFolder+'\'+BaseFolder) then
    begin
    ShoWMessage('ERROR - Can NOT create this folder'#10+OutFolder+'\'+BaseFolder+
                #10'Read Backup has FAILED');
    Exit;
    end;

  MultiFile.Read(wID, SizeOf(wID));
  while wID <> $C0C0 do // $C0C0 is the marker for end of file
    begin
    if (wID <> $FCCF) and (wID <> $CFFC) then
      begin
      ShowMessage('ERROR - Incorrect File Read at 4, Read has Failed');
      Exit;
      end;
    if wID = $FCCF  then
      begin
      Application.ProcessMessages;
      MultiFile.Read(sLen, SizeOf(Cardinal));
      if sLen < 2 then
        begin
        ShowMessage('ERROR - Incorrect File Read at 5, Read has Failed');
        Exit;
        end;
      SetLength(SubDir, sLen);
      MultiFile.Read(SubDir[1], sLen);
      if SubDir[1] <> '?' then
        begin
        ShowMessage('ERROR - Incorrect File Read at 6, Read has Failed');
        Exit;
        end;
      Delete(SubDir, 1, 1);
      {you need to find or create all of the subfolders}
      if Not DirectoryExists(OutFolder+'\'+BaseFolder+SubDir) then
        if not ForceDirectories(OutFolder+'\'+BaseFolder+SubDir) then
          begin
          ShoWMessage('ERROR - Can NOT create this folder'#10+OutFolder+'\'+BaseFolder+ SubDir+
                #10'Read Backup has FAILED');
          Exit;
          end;
      end else
      begin
      MultiFile.ReadBuffer(Multi1, SizeOf(TMultiRec));
      Inc(NumFiles);
      OutFile := TFileStream.Create(OutFolder+'\'+BaseFolder+SubDir+'\'+Multi1.Name, fmCreate or fmOpenWrite or fmShareDenyWrite);
        try
          if Multi1.Size > 0 then
          OutFile.CopyFrom(MultiFile, Multi1.Size);
          finally
          FreeAndNil(OutFile);
          end;
      end;
    MultiFile.Read(wID, SizeOf(wID)); // get the wID after each read
    end;
  finally
  MultiFile.Free;
  end;
ShowMessage('Read BackUp is FINISHED, total files written is '+IntToStr(numFiles));
end;



 - - - - - - - - - - - - - -  - - - - - - -  - - - - - - - - - - - - -  - - - - - -  - - --

I hope you can understand what I have done, ask questions if you need to
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9691150
Oh, there are several many "Error" tests, which I have left in, to maybe give you some ides on how to trap and error and get a messsgage about where it occored, but you might can take out some of these error test in your finnal version,
0
 

Author Comment

by:Fixzy
ID: 9697328
Thanx Slick


/Fixzy
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now