Copy/extract part of a File path? - delphi

How can I copy/extract part of a File path?
For example, say if I have this path: D:\Programs\Tools\Bin\Somefile.dat
how could I copy/extract it to make it like this:
C:\Users\Bin\Somefile.dat
or
C:\Users\Tools\Bin\Somefile.dat
or
C:\Users\Programs\Tools\Bin\Somefile.dat
Notice that the examples above are taking part of the original path, and changing it to another directory. I think this is called Expand name or something maybe??
PS, I already know about ExtractFileName and ExtractFilePath etc, the path anyway could be dynamic in that it wont be a hard coded path, but ever changing, so these functions are likely no good.
Thanks.

Here's a quick implementation that returns the TAIL of a path, including the specified number of elements. There's also a bit of demo of how to use it, and the results are exactly the ones you requested. Unfortunately I don't fully understand what transformations you're after: this might be exactly what you're after, or it might be something entirely wrong, that just happens to produce a result that looks like your sample:
program Project25;
{$APPTYPE CONSOLE}
uses
SysUtils;
function ExtractPathTail(const OriginalPath:string; const PathElemCount:Integer):string;
var i, start, found_delimiters: Integer;
begin
start := 0;
found_delimiters := 0;
for i:=Length(OriginalPath) downto 1 do
if OriginalPath[i] = '\' then
begin
Inc(found_delimiters);
if found_delimiters = PathElemCount then
begin
start := i;
Break;
end;
end;
if start = 0 then
raise Exception.Create('Original path is too short, unable to cut enough elements from the tail.') // mangled English to help SO's code formatter
else
Result := System.Copy(OriginalPath, start+1, MaxInt);
end;
const SamplePath = 'D:\Programs\Tools\Bin\Somefile.dat';
begin
try
WriteLn('C:\Users\' + ExtractPathTail(SamplePath, 2)); // prints: C:\Users\Bin\Somefile.dat
WriteLn('C:\Users\' + ExtractPathTail(SamplePath, 3)); // prints: C:\Users\Tools\Bin\Somefile.dat
WriteLn('C:\Users\Programs\' + ExtractPathTail(SamplePath, 3)); // prints: C:\Users\Programs\Tools\Bin\Somefile.dat
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Have you looked at the ExtractFileName function? all built in for you. Depending on where your paths/files are coming from of course, you may need the ExtractFilePath, or other related functions.

try using the PathAppend and PathExtractElements functions

Related

Attempting a TDataset Debugger Visualiser - AV on display

I am attempting to create a simple debug visualiser for TDatasets (well, I'm having to make it a TADODataset for now, so I can use the .SaveToFile method).
I've pretty much copied the TStrings visualiser example suplied by EMBT, but am running into problems when the form is being shown, as it gives me an AV without showing any data.
The top part of the callstack in the AV looks like this:
[5003C49E]{rtl150.bpl } System.#UStrAsg (Line 17745, "System.pas" + 30) + $0
[149038D1]{DatasetVisualiserProject.bpl} Datasetvisualiserframe.TDatasetVisualiserFrame.ThreadNotify + $151
[20A2CA9A]{coreide150.bpl} DebuggerMgr.TDebuggerMgr.OnShowVisualizer (Line 1112, "DebuggerMgr.pas" + 4) + $3B
So it's a problem with string assignments, likely unallocated memory? Like the TStrings implementation my ThreadNotify procedure has no code in it.
My 'work' routine replaces the TStrings implementation's AddStringListItems call, and looks like this:
procedure TDatasetVisualiserFrame.SetDataset(const Expression, TypeName, EvalResult: string);
var
TempFilename: string;
begin
FAvailableState := asAvailable;
FExpression := Expression;
IntDataset.Close;
TempFileName := GetTempFile('DSDebug');
try
if FTypeName = TADODataset.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset_ADO.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset_ADO;
end
else if FTypeName = TKBMMemTable.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset;
end
else raise Exception.Create('Unhandled class type ' + TypeName);
finally
if fileexists(TempFileName) then
begin
DeleteFile(TempFileName);
end;
end;
DebugDatasetView.beginupdate;
try
DebugDatasetView.ClearItems;
DebugDatasetView.DataController.CreateAllItems(false);
finally
DebugDatasetView.endupdate;
end;
end;
The frame itself has a TADODataset, Datasource and a QuantumGrid component for display (though a DBGrid should work)
Do I need to do something with thread handling because I'm dealing with Datasets or is it something more fundamental?
As a bonus question: My original plan was to take a TDataset and use KBMMemTable's LoadFromDataset routine passing in the original dataset, but soon after starting I discovered I was limited to getting strings back from the debugger so this wasn't possible. Am I mistaken, or is there a tricksy way around it?
After being given the means of how to debug the IDE (thanks #David M) I noticed that I hadn't implemented FrameCreated properly.
Other than that, SaveToFile also needed the filename with QuotedStr, otherwise the file would be created empty and LoadFromFile would fail due to an empty stream.
Now it works perfectly :-)

count number of subdirectories of a given path

I need to do some searching in the filesystem and would like to present a progress indication.
A rough approximation of that is the number of directories traversed.
function GetSubDirCount(Path : String): integer;
var
Index : Integer;
Temp : String;
SearchRec : TSearchRec;
begin
Result:= 0;
Temp:= Path;
if Path[Length(Path)] <> SysUtils.PathDelim then begin
Path:= Path + SysUtils.PathDelim;
end;
Path:= Path + '*.';
Index:= FindFirst(Path, faDirectory, SearchRec);
while Index = 0 do begin
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then begin
Index:= FindNext(SearchRec);
Continue;
end;
Inc(Result);
Result:= Result + GetSubDirCount(Temp + SysUtils.PathDelim + SearchRec.Name);
Index:= FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
I currently use the above code, is there a faster way?
I'm only interested in the count.
If there's a really fast way to get the number of files as well that would be a bonus.
As you are not specifying the Delphi version you are using, I suggest the corresponding methods from IOUtils - namely TDirectory.GetDirectories and TDirectory.GetFiles as they are available in recent Delphi versions.
Update: It is probably not the fastest way to count the number of directories and files, but if the files shall be iterated later anyway, one could as well use the result of these functions for the iteration.
Minor improvement: use const in the parameter declaration.
ex:
function GetSubDirCount(const Path : String): integer;
As Rob points out, this will not work as Path is modified in the body. I would still use this approach however, and NOT modify path in the body. I'd have a local string var "Suffix", modify that (add optional pathdelim, and '*.'), and pass both to FindFirst:
FindFirst(Path+Suffix, faDirectory, SearchRec);
#Johan
Since the Windows code takes up most time, I suggest you apply the fixes suggested by other respondents, and update your code to use threads if your feel comfortable with that:
As soon as you retrieve a subdirectory put add it to a (thread safe) list
Have a thread look at that list and spawn worker threads do to the actual file processing per directory
Update your progress all the time: number of dirs found/handled. This will be a bit wobbly in the beginning, but at least you can start working while Windows is still 'finding'
The 'usual' warnings apply:
don't make your number of threads too large
if your file processing creates new files make sure your find routines don't choke on the new output files

How to check if path points to a root folder using Delphi

What is the best/easiest way to check if a certain path points to a drive's root?
I guess I could just check if path name ends with '\' or ':', or if the path is only 2 or three characters in length, but I was hoping there was some kind of standard "IsDriveRoot" function to check this.
Tx
UPDATE:
After searching through the Delphi help file I found the ExtractFileDrive() function which returns the drive portion of any given path.
Using that function I gues it's easy to write a little function to check if the original path is the same as the result of ExtractFileDrive(), which would mean that the original path had to be the drive's root.
Function IsDriveRoot(APath: string): Boolean;
begin
Result := ((Length(APath) = 2) and (ExtractFileDrive(APath) = APath))
or ((Length(APath) = 3) and ((ExtractFileDrive(APath) + '\') = APath));
end;
or
Function IsDriveRoot(APath: string): Boolean;
begin
Result := ((Length(APath) = 2) and (Copy(APath,2,1) = ':'))
or ((Length(APath) = 3) and (Copy(APath,3,1) = '\'));
end;
Something like that should do it....
I actually think the second example is simpler, and will probably end up using that one.
Thanks again to all who responded :)
It seems GetVolumePathName can be quite helpful in your case.
You could utilize GetDriveType() call:
if GetDriveType(PChar(path)) <> DRIVE_NO_ROOT_DIR then
...

What does "free" do in Delphi?

I found the following code snippet here:
with TClipper.Create do
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end
Just curious, what does the free statement/function (between finally and end) do here? Google did not help.
The code
with TClipper.Create do
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end
is shorthand for
with TClipper.Create do
begin
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end;
end;
TClipper.Create creates an object of type TClipper, and returns this, and the with statement, which works as in most languages, lets you access the methods and properties of this TClipper object without using the NameOfObject.MethodOrProperty syntax.
(A simpler example:
MyPoint.X := 0;
MyPoint.Y := 0;
MyPoint.Z := 0;
MyPoint.IsSet := true;
can be simplified to
with MyPoint do
begin
X := 0;
Y := 0;
Z := 0;
IsSet := true;
end;
)
But in your case, you never need to declare a TClipper object as a variable, because you create it and can access its methods and properties by means of the with construct.
So your code is almost equivelant to
var
Clipper: TClipper;
Clipper := TClipper.Create;
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
Clipper.Free;
The first line, Clipper := TClipper.Create, creates a TClipper object. The following three lines work with this object, and then Clipper.Free destroys the object, freeing RAM and possibly also CPU time and OS resources, used by the TClipper object.
But the above code is not good, because if an error occurrs (an exception is created) within AddPolygon or Execute, then the Clipper.Free will never be called, and so you have a memory leak. To prevent this, Delphi uses the try...finally...end construct:
Clipper := TClipper.Create;
try
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
finally
Clipper.Free;
end;
The code between finally and end is guaranteed to run, even if an exception is created, and even if you call Exit, between try and finally.
What Mason means is that sometimes the with construct can be a paint in the ... brain, because of identifier conflicts. For instance, consider
MyObject.Caption := 'My test';
If you write this inside a with construct, i.e. if you write
with MyObect do
begin
// A lot of code
Caption := 'My test';
// A lot of code
end;
then you might get confused. Indeed, most often Caption := changes the caption of the current form, but now, due to the with statement, it will change the caption of MyObject instead.
Even worse, if
MyObject.Title := 'My test';
and MyObject has no Caption property, and you forget this (and think that the property is called Caption), then
MyObject.Caption := 'My test';
will not even compile, whereas
with MyObect do
begin
// A lot of code
Caption := 'My test';
// A lot of code
end;
will compile just fine, but it won't do what you expect.
In addition, constructs like
with MyObj1, MyObj2, ..., MyObjN do
or nested with statements as in
with MyConverter do
with MyOptionsDialog do
with MyConverterExtension do
..
can produce a lot of conflicts.
In Defence of The With Statement
I notice that there almost is a consensus (at least in this thread) that the with statement is more evil than good. Although I am aware of the potential confusion, and have fallen for it a couple of times, I cannot agree. Careful use of the with statement can make the code look much prettier. And this lessens the risk of confusion due to "barfcode".
For example:
Compare
var
verdata: TVerInfo;
verdata := GetFileVerNumbers(FileName);
result := IntToStr(verdata.vMajor) + '.' + IntToStr(verdata.vMinor) + '.' + IntToStr(verdata.vRelease) + '.' + IntToStr(verdata.vBuild);
with
with GetFileVerNumbers(FileName) do
result := IntToStr(vMajor) + '.' + IntToStr(vMinor) + '.' + IntToStr(vRelease) + '.' + IntToStr(vBuild);
There is absolutely no risk of confusion, and not only do we save a temporaray variable in the last case - it also is far more readable.
Or what about this very, very, standard code:
with TAboutDlg.Create(self) do
try
ShowModal;
finally
Free;
end;
Exactly where is the risk of confusion? From my own code I could give hundreds of more examples of with statements, all simplifying code.
Furthermore, as have been stated above, there is no risk of using with at all, as long as you know what you are doing. But what if you want to use a with statement together with the MyObject in the example above: then, inside the with statement, Caption is equal to MyObject.Caption. How do you change the caption of the form, then? Simple!
with MyObject do
begin
Caption := 'This is the caption of MyObject.';
Self.Caption := 'This is the caption of Form1 (say).';
end;
Another place where with can be useful is when working with a property or function result that takes a non-trivial amount of time to execute.
To work with the TClipper example above, suppose that you have a list of TClipper objects with a slow method that returns the clipper for a particular TabSheet.
Ideally you should only call this getter once, so you can either use an explicit local variable, or an implicit one using with.
var
Clipper : TClipper;
begin
Clipper := ClipList.GetClipperForTab(TabSheet);
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
end;
OR
begin
with ClipList.GetClipperForTab(TabSheet)do
begin
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
end;
end;
In a case like this, either method would do, but in some circumstances, typically in complex conditionals a with can be clearer.
var
Clipper : TClipper;
begin
Clipper := ClipList.GetClipperForTab(TabSheet);
if (Clipper.X = 0) and (Clipper.Height = 0) and .... then
Clipper.AddPolygon(subject, ptSubject);
end;
OR
begin
with ClipList.GetClipperForTab(TabSheet) do
if (X = 0) and (Height = 0) and .... then
AddPolygon(subject, ptSubject);
end;
In the end is is matter of personal taste. I generally will only use a with with a very tight scope, and never nest them. Used this way they are a useful tool to reduce barfcode.
It's a call to TObject.Free, which is basically defined as:
if self <> nil then
self.Destroy;
It's being executed on the unnamed TClipper object created in the with statement.
This is a very good example of why you shouldn't use with. It tends to make the code harder to read.
Free calls the destructor of the object, and releases the memory occupied by the instance of the object.
I don't know anything about Delphi but I would assume that it is releasing the resources used by TClipper much like a using statement in C#. That is just a guess....
Any dinamicly created object must call free to free at object creation alocated memory after use. TClipper object is a desktop content creation, capture and management tool. So it is some kind of Delphi connection object with Clipper. The create (object creation) is handled in try finaly end; statment what mean, if connection with Clipper isn't successful the object TClipper will not be created and can not be freed after after of try finaly end; statement.
If "with" is as evil as some posters are suggesting, could they please explain
1. why Borland created this language construct, and
2. why they (Borland/Embarcadero/CodeGear) use it extensively in their own code?
While I certainly understand that some Delphi programmers don't like "with", and while acknowledging that some users abuse it, I think it's silly to say "you shouldn't use it".
angusj - author of the offending code :)

Improve speed of own debug visualizer for Delphi 2010

I wrote Delphi debug visualizer for TDataSet to display values of current row, source + screenshot: http://delphi.netcode.cz/text/tdataset-debug-visualizer.aspx . Working good, but very slow. I did some optimalization (how to get fieldnames) but still for only 20 fields takes 10 seconds to show - very bad.
Main problem seems to be slow IOTAThread90.Evaluate used by main code shown below, this procedure cost most of time, line with ** about 80% time. FExpression is name of TDataset in code.
procedure TDataSetViewerFrame.mFillData;
var
iCount: Integer;
I: Integer;
// sw: TStopwatch;
s: string;
begin
// sw := TStopwatch.StartNew;
iCount := StrToIntDef(Evaluate(FExpression+'.Fields.Count'), 0);
for I := 0 to iCount - 1 do
begin
s:= s + Format('%s.Fields[%d].FieldName+'',''+', [FExpression, I]);
// FFields.Add(Evaluate(Format('%s.Fields[%d].FieldName', [FExpression, I])));
FValues.Add(Evaluate(Format('%s.Fields[%d].Value', [FExpression, I]))); //**
end;
if s<> '' then
Delete(s, length(s)-4, 5);
s := Evaluate(s);
s:= Copy(s, 2, Length(s) -2);
FFields.CommaText := s;
{ sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');}
end;
Now I have no idea how to improve performance.
That Evaluate needs to do a surprising amount of work. The compiler needs to compile it, resolving symbols to memory addresses, while evaluating properties may cause functions to be called, which needs the debugger to copy the arguments across into the debugee, set up a stack frame, invoke the function to be called, collect the results - and this involves pausing and resuming the debugee.
I can only suggest trying to pack more work into the Evaluate call. I'm not 100% sure how the interaction between the debugger and the evaluator (which is part of the compiler) works for these visualizers, but batching up as much work as possible may help. Try building up a more complicated expression before calling Evaluate after the loop. You may need to use some escaping or delimiting convention to unpack the results. For example, imagine what an expression that built the list of field values and returned them as a comma separated string would look like - but you would need to escape commas in the values themselves.
Because Delphi is a different process than your debugged exe, you cannot direct use the memory pointers of your exe, so you need to use ".Evaluate" for everything.
You can use 2 different approaches:
Add special debug dump function into executable, which does all value retrieving in one call
Inject special dll into exe with does the same as 1 (more hacking etc)
I got option 1 working, 2 should also be possible but a little bit more complicated and "ugly" because of hacking tactics...
With code below (just add to dpr) you can use:
Result := 'Dump=' + Evaluate('TObjectDumper.SpecialDump(' + FExpression + ')');
Demo code of option 1, change it for your TDataset (maybe make CSV string of all values?):
unit Unit1;
interface
type
TObjectDumper = class
public
class function SpecialDump(aObj: TObject): string;
end;
implementation
class function TObjectDumper.SpecialDump(aObj: TObject): string;
begin
Result := '';
if aObj <> nil then
Result := 'Special dump: ' + aObj.Classname;
end;
initialization
//dummy call, just to ensure it is linked c.q. used by compiler
TObjectDumper.SpecialDump(nil);
end.
Edit: in case someone is interested: I got option 2 working too (bpl injection)
I have not had a chance to play with the debug visualizers yet, so I do not know if this work, but have you tried using Evaluate() to convert FExpression into its actual memory address? If you can do that, then type-cast that memory address to a TDataSet pointer and use its properties normally without going through additional Evaluate() calls. For example:
procedure TDataSetViewerFrame.mFillData;
var
DS: TDataSet;
I: Integer;
// sw: TStopwatch;
begin
// sw := TStopwatch.StartNew;
DS := TDataSet(StrToInt(Evaluate(FExpression)); // this line may need tweaking
for I := 0 to DS.Fields.Count - 1 do
begin
with DS.Fields[I] do begin
FFields.Add(FieldName);
FValues.Add(VarToStr(Value));
end;
end;
{
sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');
}
end;

Resources