ADD: Extract folders from archive

This commit is contained in:
Alexander Koblov 2007-04-07 23:30:13 +00:00
commit e93248b814
4 changed files with 116 additions and 6 deletions

View file

@ -1816,6 +1816,7 @@ begin
(*Extract files from archive*)
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
DebugLN('+++ Extract files +++');
ActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyOut(fl, sDestPath);
end
else

View file

@ -44,7 +44,7 @@ Type
function VFSMkDir(const sDirName:String ):Boolean;virtual;abstract;
function VFSRmDir(const sDirName:String):Boolean;virtual;abstract;
function VFSCopyOut(const flSrcList : TFileList; sDstPath:String):Boolean;virtual;abstract;
function VFSCopyOut(var flSrcList : TFileList; sDstPath:String):Boolean;virtual;abstract;
function VFSCopyIn(const flSrcList : TFileList; sDstName:String):Boolean;virtual;abstract;
function VFSRename(const sSrcName, sDstName:String):Boolean;virtual;abstract;
function VFSRun(const sName:String):Boolean;virtual;abstract;

View file

@ -24,6 +24,7 @@ uses
procedure AddUpLevel(sUpPath : String; var ls:TFileList);
function LowDirLevel(sPath : String) : String;
function IncludeFileInList(sPath : String; var sFileName : String) : Boolean;
function ExtractDirLevel(const sPrefix, sPath: String): String;
function ls2FileInfo(sls:string):TFileRecItem;
// convert line in ls -la (or vfs) format to our structure
function ModeStr2Mode(const sMode:String):Integer;
@ -31,7 +32,7 @@ function ModeStr2Mode(const sMode:String):Integer;
implementation
uses
SysUtils, uFileOp {$IFNDEF WIN32}, BaseUnix{$ENDIF};
SysUtils, uFileOp, uOSUtils, LCLProc {$IFNDEF WIN32}, BaseUnix{$ENDIF};
{ TFileList }
@ -96,6 +97,15 @@ if Index > 0 then
end;
end;
function ExtractDirLevel(const sPrefix, sPath: String): String;
begin
Result := sPath;
DebugLN('Prefix = ' + sPrefix);
DebugLN('sPath = ' + sPath);
IncludeFileInList(sPrefix, Result);
DebugLN('Result := ' + Result);
end;
function ModeStr2Mode(const sMode:String):Integer;
begin
// stupid conversion

View file

@ -43,6 +43,10 @@ Type
TWCXModule = class (TVFSModule)
private
FArcFileList : TList;
FDstPath,
fFolder : String;
procedure SelectFilesInSubfolders(var fl : TFileList; sDir : String);
procedure CopySelectedWithSubFolders(var flist:TFileList);
protected
// module's functions
//**mandatory:
@ -82,7 +86,7 @@ Type
function VFSMkDir(const sDirName:String ):Boolean;override;{Create a directory}
function VFSRmDir(const sDirName:String):Boolean;override; {Remove a directory}
function VFSCopyOut(const flSrcList : TFileList; sDstPath:String):Boolean;override;{Extract files from archive}
function VFSCopyOut(var flSrcList : TFileList; sDstPath:String):Boolean;override;{Extract files from archive}
function VFSCopyIn(const flSrcList : TFileList; sDstName:String):Boolean;override;{Pack files in archive}
function VFSRename(const sSrcName, sDstName:String):Boolean;override;{Rename or move file}
function VFSRun(const sName:String):Boolean;override;
@ -92,7 +96,7 @@ Type
end;
implementation
uses SysUtils, uFileOp, uOSUtils, LCLProc;
uses SysUtils, uFileOp, uOSUtils, LCLProc, uFileProcs;
constructor TWCXModule.Create;
begin
@ -232,9 +236,77 @@ begin
end;
procedure TWCXModule.SelectFilesInSubfolders(var fl : TFileList; sDir : String);
var
fr : PFileRecItem;
I, Count : Integer;
CurrFileName : String; // Current file name
begin
ForceDirectory(FDstPath + ExtractDirLevel(FFolder, PathDelim + sDir));
//DebugLN('ForceDirectory = ' + FDstPath + ExtractDirLevel(FFolder, PathDelim + sDir));
Count := FArcFileList.Count - 1;
for I := 0 to Count do
begin
CurrFileName := PathDelim + PHeaderData(FArcFileList.Items[I])^.FileName;
//DebugLN('sDir = ', sDir);
//DebugLN('In folder = ' + CurrFileName);
if not IncludeFileInList(sDir + PathDelim, CurrFileName) then
Continue;
// DebugLN('In folder = ' + CurrFileName);
New(fr);
with fr^, PHeaderData(FArcFileList.Items[I])^ do
begin
sName := FArchiveName + PathDelim + FileName;
iMode := FileAttr;
if FPS_ISDIR(iMode) then
begin
sExt:='';
//DebugLN('SelectFilesInSubfolders = ' + FileName);
SelectFilesInSubfolders(fl, FileName);
end;
end; //with
fl.AddItem(fr);
end;
end;
procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
var
xIndex:Integer;
p:TFileRecItem;
tmp : String;
Count : Integer;
begin
Count := flist.Count-1;
for xIndex:=0 to Count do
begin
p:=flist.GetItem(xIndex)^;
tmp := p.sName;
Delete(tmp, Pos(FArchiveName, tmp), Length(FArchiveName));
//DebugLN('Curr File = ' + tmp);
if FPS_ISDIR(p.iMode) then
SelectFilesInSubfolders(flist, tmp);
end;
end;
{Extract files from archive}
function TWCXModule.VFSCopyOut(const flSrcList: TFileList; sDstPath: String
function TWCXModule.VFSCopyOut(var flSrcList: TFileList; sDstPath: String
): Boolean;
var
ArcHandle : THandle;
@ -242,7 +314,28 @@ ArcFile : tOpenArchiveData;
ArcHeader : THeaderData;
Extract : Boolean;
Count, I : Integer;
Folder : String;
begin
FDstPath := sDstPath;
(* Get current folder in archive *)
Folder := LowDirLevel(flSrcList.GetItem(0)^.sName);
(* Get relative path *)
IncludeFileInList(FArchiveName, Folder);
FFolder := Folder;
//DebugLN('Folder = ' + Folder);
//sDstPath := ExcludeTrailingPathDelimiter(sDstPath);
CopySelectedWithSubFolders(flSrcList);
DebugLN('Extract file = ' + FArchiveName + DirectorySeparator + ArcHeader.FileName);
Count := flSrcList.Count;
FillChar(ArcFile, SizeOf(ArcFile), #0);
ArcFile.ArcName := PChar(FArchiveName);
@ -259,8 +352,14 @@ begin
while (ReadHeader(ArcHandle, ArcHeader) = 0) do
begin
if flSrcList.CheckFileName(FArchiveName + DirectorySeparator + ArcHeader.FileName) >= 0 then
ProcessFile(ArcHandle, PK_EXTRACT, nil, PChar(sDstPath + ExtractFileName(ArcHeader.FileName)))
begin
DebugLN(sDstPath + ExtractDirLevel(Folder, ArcHeader.FileName));
ProcessFile(ArcHandle, PK_EXTRACT, nil, PChar(sDstPath + ExtractDirLevel(Folder, PathDelim + ArcHeader.FileName)));
end
else
ProcessFile(ArcHandle, PK_SKIP, nil, nil);
FillChar(ArcHeader, SizeOf(ArcHeader), #0);