fix(importList): missing path conversion (relative to absolute and vice versa) based of imported file list #95

Author: salvadorbs

Forms/Forms.ImportList.pas

@@ -29,6 +29,9 @@ interface
   Kernel.Enumerations, EditBtn;
 
 type
+
+  { TfrmImportList }
+
   TfrmImportList = class(TForm)
     bvl1: TBevel;
     bvl2: TBevel;
@@ -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);
@@ -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
@@ -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
@@ -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;
@@ -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.

Library/AppConfig.Paths.pas

@@ -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;
@@ -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;
@@ -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]);
 

Library/Icons.Thread.pas

@@ -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 }
 
@@ -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

Library/Kernel.Instance.pas

@@ -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