Skip to content

Commit

Permalink
fix(importList): missing path conversion (relative to absolute and vi…
Browse files Browse the repository at this point in the history
…ce versa) based of imported file list #95
  • Loading branch information
salvadorbs committed Aug 30, 2022
1 parent eb614b2 commit ab5f48a
Show file tree
Hide file tree
Showing 4 changed files with 77 additions and 10 deletions.
73 changes: 70 additions & 3 deletions Forms/Forms.ImportList.pas
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,9 @@ interface
Kernel.Enumerations, EditBtn;

type

{ TfrmImportList }

TfrmImportList = class(TForm)
bvl1: TBevel;
bvl2: TBevel;
Expand Down Expand Up @@ -64,6 +67,10 @@ TfrmImportList = class(TForm)
procedure CheckAllItems(State: TCheckState);
procedure PopulateTree(Tree: TVirtualStringTree; FilePath: String);
function TreeImpToTree(TreeImp, Tree: TVirtualStringTree): Boolean;
procedure MassRelativeToAbsolutePath(Sender: TBaseVirtualTree;
Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
procedure MassAbsoluteToRelativePath(Sender: TBaseVirtualTree;
Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
public
{ Public declarations }
class procedure Execute(AOwner: TComponent);
Expand All @@ -77,10 +84,10 @@ implementation
{$R *.lfm}

uses
AppConfig.Main, VirtualTree.Methods,
AppConfig.Main, VirtualTree.Methods, NodeDataTypes.Files,
Utility.FileFolder, Utility.XML, Database.Manager, NodeDataTypes.Base,
Kernel.Logger, Kernel.ResourceStrings, Utility.Misc, Kernel.Instance,
mormot.core.log;
mormot.core.log, AppConfig.Paths;

procedure TfrmImportList.btnBackClick(Sender: TObject);
begin
Expand Down Expand Up @@ -118,16 +125,27 @@ procedure TfrmImportList.FormCreate(Sender: TObject);
end;

procedure TfrmImportList.FormClose(Sender: TObject; var Action: TCloseAction);
var
ImportPaths: TConfigPaths;
begin
Config.ASuiteState := lsNormal;
if (ModalResult = mrOk) and (vstListImp.HasChildren[vstListImp.RootNode]) then
begin
try

ImportPaths := TConfigPaths.Create(edtPathList.Text);
try
vstListImp.IterateSubtree(nil, MassAbsoluteToRelativePath, @ImportPaths, [], True);
finally
ImportPaths.Free;
end;

if TreeImpToTree(vstListImp, ASuiteInstance.MainTree) then
begin
ShowMessageFmtEx(msgItemsImported, [GetNumberNodeImp(vstListImp)]);
TASuiteLogger.Info(msgItemsImported, [GetNumberNodeImp(vstListImp)]);
end;

TVirtualTreeMethods.GetAllIcons(ASuiteInstance.MainTree, nil);
except
on E : Exception do
Expand Down Expand Up @@ -169,13 +187,24 @@ class procedure TfrmImportList.Execute(AOwner: TComponent);
end;

procedure TfrmImportList.tsListShow(Sender: TObject);
var
AsuiteSqlPath: String;
ImportPaths: TConfigPaths;
begin
lblTitle.Caption := msgImportTitle3;
btnNext.Caption := msgImport;
btnNext.Enabled := vstListImp.CheckedCount > 0;
AsuiteSqlPath := edtPathList.Text;
//Import list in temporary vst
try
PopulateTree(vstListImp, edtPathList.Text);
PopulateTree(vstListImp, AsuiteSqlPath);

ImportPaths := TConfigPaths.Create(AsuiteSqlPath);
try
vstListImp.IterateSubtree(nil, MassRelativeToAbsolutePath, @ImportPaths, [], True);
finally
ImportPaths.Free;
end;
finally
TVirtualTreeMethods.GetAllIcons(vstListImp, nil);
end;
Expand Down Expand Up @@ -307,4 +336,42 @@ function TfrmImportList.TreeImpToTree(TreeImp,
Tree.EndUpdate;
end;

procedure TfrmImportList.MassRelativeToAbsolutePath(Sender: TBaseVirtualTree;
Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
var
ImportPath: TConfigPaths;
NodeData: TvBaseNodeData;
begin
ImportPath := TConfigPaths(Data^);
NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
if not(NodeData.IsSeparatorItem) then
begin
TvFileNodeData(NodeData).PathIcon := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).PathIcon);
if NodeData.IsFileItem then
begin
TvFileNodeData(NodeData).PathFile := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).PathFile);
TvFileNodeData(NodeData).WorkingDir := ImportPath.RelativeToAbsolute(TvFileNodeData(NodeData).WorkingDir);
end;
end;
end;

procedure TfrmImportList.MassAbsoluteToRelativePath(Sender: TBaseVirtualTree;
Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
var
ImportPath: TConfigPaths;
NodeData: TvBaseNodeData;
begin
ImportPath := TConfigPaths(Data^);
NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
if not(NodeData.IsSeparatorItem) then
begin
TvFileNodeData(NodeData).PathIcon := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).PathIcon);
if NodeData.IsFileItem then
begin
TvFileNodeData(NodeData).PathFile := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).PathFile);
TvFileNodeData(NodeData).WorkingDir := ImportPath.AbsoluteToRelative(TvFileNodeData(NodeData).WorkingDir);
end;
end;
end;

end.
8 changes: 4 additions & 4 deletions Library/AppConfig.Paths.pas
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ TConfigPaths = class
procedure UpdateEnvironmentVars;
procedure UpdateASuiteVars;
public
constructor Create;
constructor Create(APathExecutable: string);
destructor Destroy; override;

function AbsoluteToRelative(const APath: String): string;
Expand Down Expand Up @@ -195,12 +195,12 @@ procedure TConfigPaths.UpdateASuiteVars;
FASuiteVars.Add(DeQuotedStr(CONST_PATH_URLICON), strFolderIcon + FILEICON_Url + EXT_ICO);
end;

constructor TConfigPaths.Create;
constructor TConfigPaths.Create(APathExecutable: string);
var
strPathExe, strFileListSql, strFileListXml: String;
begin
//Default paths
strPathExe := Application.ExeName;
strPathExe := APathExecutable;
FSuitePathWorking := ExtractFilePath(strPathExe);

strFileListSql := ExtractFileNameOnly(strPathExe) + EXT_SQL;
Expand Down Expand Up @@ -285,7 +285,7 @@ function TConfigPaths.RelativeToAbsolute(const APath: String;
//Note: Unfortunately old asuite vars is not quoted, but in format $var.
// So these two vars are deprecated. This code remain for only backwards compatibility
//CONST_PATH_ASuite_old = Launcher's path
Result := StringReplace(Result, CONST_PATH_ASuite_old, SuitePathWorking, [rfIgnoreCase,rfReplaceAll]);
Result := StringReplace(Result, CONST_PATH_ASuite_old, ExcludeTrailingPathDelimiter(SuitePathWorking), [rfIgnoreCase,rfReplaceAll]);
//CONST_PATH_DRIVE_old = Launcher's Drive (ex. ASuite in H:\Software\ASuite.exe, CONST_PATH_DRIVE is H: )
Result := StringReplace(Result, CONST_PATH_DRIVE_old, SUITEDRIVE, [rfIgnoreCase,rfReplaceAll]);

Expand Down
4 changes: 2 additions & 2 deletions Library/Icons.Thread.pas
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ implementation

uses
VirtualTree.Methods, NodeDataTypes.Base, AppConfig.Main, Kernel.Enumerations,
Kernel.Logger, mormot.core.log;
Kernel.Logger, mormot.core.log, Kernel.Instance;

{ TTreeIconsThread }

Expand Down Expand Up @@ -70,7 +70,7 @@ procedure TTreeIconsThread.GetImageIndex(Sender: TBaseVirtualTree;
var
NodeData: TvBaseNodeData;
begin
if Config.ASuiteState = lsNormal then
if (Config.ASuiteState = lsNormal) or ((Config.ASuiteState = lsImporting) and (Sender = ASuiteInstance.ImportTree)) then
begin
NodeData := TVirtualTreeMethods.GetNodeItemData(Node, Sender);
if Assigned(NodeData) then
Expand Down
2 changes: 1 addition & 1 deletion Library/Kernel.Instance.pas
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,7 @@ constructor TASuiteInstance.Create;
HandleParam(ParamStr(I));

//Create some classes
FPaths := TConfigPaths.Create;
FPaths := TConfigPaths.Create(Application.ExeName);

//Setup logger
with TSynLog.Family do
Expand Down

0 comments on commit ab5f48a

Please sign in to comment.