FindFirst, FindNext (Delphi Xe, Win7) rank is not correct - delphi

I have some files in a directory. I try get these files with FindFirst and FindNext but I can't get same order on Windows 7.
C:\Test
SampleFile.0.png
SampleFile.1.png
SampleFile.2.png
SampleFile.3.png
SampleFile.4.png
SampleFile.5.png
SampleFile.6.png
SampleFile.7.png
SampleFile.8.png
SampleFile.9.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.20.png
SampleFile.21.png
SampleFile.22.png
When I try using my code I've got
SampleFile.0.png
SampleFile.1.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.2.png
SampleFile.20.png
SampleFile.21.png
.
.
.
How can I get file list on correct rank order?
Procedure Test;
var
sr : TSearchRec;
i : integer;
ListFiles : TStringList;
begin
ListFiles := TStringList.Create;
i := FindFirst('c:\test\*.png', faDirectory, sr);
while i = 0 do begin
ListFiles.Add(ExtractFileName(sr.FindData.cFileName));
i := FindNext(sr);
end;
FindClose(sr);
end;
Note : Result is still wrong, if I can use ListFiles.Sorted = True
I think I've a solution, created a function.
function SortFilesByName(List: TStringList; Index1, Index2: Integer): integer;
var
FileName1, FileName2: String;
i, FileNumber1, FileNumber2: Integer;
begin
FileName1 := ChangeFileExt(ExtractFileName(List[Index1]), '');
FileName2 := ChangeFileExt(ExtractFileName(List[Index2]), '');
i := POS('.', FileName1)+1;
FileNumber1 := StrToInt(Copy(FileName1, i, MaxInt));
i := POS('.', FileName2)+1;
FileNumber2 := StrToInt(Copy(FileName2, i, MaxInt));
Result := (FileNumber1 - FileNumber2);
end;
I've added another line
ListFiles.CustomSort(SortFilesByName); //(ListFiles,1,2):integer);
before
FindClose(sr);

As jachguate said, the sorting is done by Explorer.exe, not the filesystem. FindFirst/FindNext does not guarantee any specific sorting, including plain ASCII based, so you shouldn't rely on it. You don't, however, need to re-implement the numeric sort in Delphi. Windows exposes the one it uses as StrCmpLogicalW, which is in shlwapi.dll. The import looks like this:
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
external 'shlwapi.dll'
It is possible to disable that behavior in Windows. If you want to follow the order that Windows uses, you need to call SHRestricted with the REST_NOSTRCMPLOGICAL value. If it returns true you should use AnsiCompareStr instead.
const
// Use default CompareString instead of StrCmpLogical
REST_NOSTRCMPLOGICAL = $4000007E;
function SHRestricted(rest: DWORD): LongBool; stdcall; external 'shell32.dll';
So your final sort function should be something like this:
function CompareFilenames(const AFilename1, AFilename2: string): Integer;
begin
if SHRestricted(REST_NOSTRCMPLOGICAL) then
Result := AnsiCompareStr(AFilename1, AFilename2)
else
Result := StrCmpLogicalW(PWideChar(AFilename1), PWideChar(AFilename2));
end;
You can cache the result of the SHRestricted call, but if you do you need to watch for the WM_SETTINGSCHANGE broadcast message and re-read it when you get one.

The different orders you see in the windows explorer is implemented in explorer.exe and not in the file system.
The Numerical sort order is a new feature in windows 7, so if you sort by name and you have a bunch of files with a prefix followed by numbers, the explorer "identifies" that pattern and doesn't present a list sorted by name in the traditional way, but sorted by prefix and then by number (as if the string were a Integer number).
If you want to do the same in Delphi, you can do it by adding all the file names returned by FindFirst/FindNext to a TSlist and then sort the string list using this compare function:
var
FileNames: TList<string>;
begin
FileNames := TList<string>.Create;
try
SearchForFiles(FileNames); //here you add all the file names
//sort file names a la windows 7 explorer
FileNames.Sort(System.Generics.Defaults.TComparer<string>.Construct(
function (const s1, s2: string): Integer
procedure ProcessPrefix(const fn: string; var prefix, number: string);
var
I: Integer;
begin
for I := length(fn) downto 1 do
if not TCharacter.IsDigit(fn[I]) then
begin
Prefix := Copy(fn, 1, I);
number := Copy(fn, I+1, MaxInt);
Break;
end;
end;
var
prefix1, prefix2: string;
number1, number2: string;
fn1, fn2: string;
begin
//compare filenames a la windows 7 explorer
fn1 := TPath.GetFileNameWithoutExtension(s1);
fn2 := TPath.GetFileNameWithoutExtension(s2);
ProcessPrefix(fn1, prefix1, number1);
ProcessPrefix(fn2, prefix2, number2);
if (Number1 <> '') and (Number2 <> '') then
begin
Result := CompareText(prefix1, prefix2);
if Result = 0 then
Result := CompareValue(StrToInt(number1), StrToInt(Number2));
end
else
Result := CompareText(s1, s2);
end
));
UseYourSortedFileNames(FileNames);
finally
FileNames.Free;
end;
end;

By "rank", you mean sort order.
The files are sorting in the proper order (based on the ASCII value of the characters). 2 comes after 19 because the comparison is only made up to the same number of characters in both names, and '2' comes after 1.
If you want them to sort properly as numbers, you need to left-pad the numbers with zeros so they're all the same width (eg., instead of SampleFile.2.png, use SampleFile.02.png). This will cause '02' to come before 19 so they sort correctly numerically.
You can fix the numbering issue by using something like:
PngFileName := Format('SampleFile.%.2d.png', [Counter]);

Related

Why is FileAge returning unexpected values?

So i have a 'downloads' folder where i put everything i download in my day by day work. You know we always automate everything, so I'm trying to build a simply app to run everyday to delete files older than 30 days, as i have to do this manually from time to time to avoid the folder become too big.
Here is my code :
function TForm1.deleteOldDownloads: boolean;
var
f: string;
i, d: Integer;
var
sl: tstringlist;
begin
try
FileListBox1.Directory := '\\psf\home\downloads';
FileListBox1.refresh;
sl := tstringlist.create;
for i := 0 to FileListBox1.items.count - 1 do
begin
f := FileListBox1.Directory + '\' + FileListBox1.items[i];
if fileexists(f) then
d := daysbetween(FileAge(f), now)
else
d := 0;
if d > 30 then // problem is here, d is always a big number, not the actually age of file
sl.Add(f);
end;
if sl.count > 0 then
begin
for i := 0 to sl.count do
begin
f := sl[i];
deletefile(f);
end;
end;
sl.Free;
except
on e: Exception do
begin
end;
end;
Problem is "d" variable is returning very big numbers like 1397401677, even if the file has only 1 day.
The only detail here is i run Windows in a Parallels virtual machine and the "\psf\home\downloads" folder is on Mac, but i can access this folderl normally using Windows Explorer, so for Delphi is like a regular local folder.
What am i missing ?
Did you read the documentation for FileAge? The first day in programming school, you are taught "When you start using a new function or API, you begin by reading its documentation." In this case, the function's documentation says
The [one-argument] overloaded version of FileAge is deprecated.
So you are using a function you shouldn't be using.
Still, this function should probably still work.
But what do you expect it to return? Well, obviously the thing that the docs say it should return:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime function.
But when you use this in DaysBetween, you assume it already is a TDateTime!
Why is FileAge returning unexpected values?
It isn't. It is probably returning exactly the thing its documentation says it should return.
You are using the older version of FileAge() that returns a timestamp in DOS numeric format, but you are treating it as a TDateTime, which it is not. As the FileAge documentation says:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime() function.
So, do what the documentation says to do, eg:
var
age: Integer;
age := FileAge(f);
if age <> -1 then
d := DaysBetween(FileDateToDateTime(age), Now)
Otherwise, use the newer version of FileAge() that outputs a TDateTime to begin with, eg:
var
dt: TDateTime;
if FileAge(f, dt) then
d := DaysBetween(dt, Now)
This is NOT a direct answer to your question, but I cannot post it as a comment.
So, the thing is, you should never delete user files directly. What if you make a mistake? What if the user of your program makes a mistake?
Always delete files to Recycle Bin:
{--------------------------------------------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
Old name: Trashafile
Note related to UNC: The function won't move a file to the RecycleBin if the file is UNC. MAYBE it was moved to the remote's computer RecycleBin
--------------------------------------------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0); { ATENTION! This last #0 is MANDATORY. See this for details: http://stackoverflow.com/questions/6332259/i-cannot-delete-files-to-recycle-bin - Although this member is declared as a single null-terminated string, it is actually a buffer that can hold multiple null-delimited file names. Each file name is terminated by a single NULL character. The last file name is terminated with a double NULL character ("\0\0") to indicate the end of the buffer }
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
//DEBUG ONLY if Result<> 0 then Mesaj('last error: ' + IntToStr(Result)+ CRLF+ 'last error message: '+ SysErrorMessage(Result));
//if fos.fAnyOperationsAborted = True then Result:= -1;
end;
Also, you don't need that obsolete control to get the files in a folder. You can use this:
{ FIND FILES }
function ListFilesOf(CONST aFolder, FileType: string; CONST ReturnFullPath, DigSubdirectories: Boolean): TStringList;
{ If DigSubdirectories is false, it will return only the top level files,
else it will return also the files in subdirectories of subdirectories.
If FullPath is true the returned files will have full path.
FileType can be something like '*.*' or '*.exe;*.bin'
Will show also the Hidden/System files.
Source Marco Cantu Delphi 2010 HandBook
// Works with UNC paths}
VAR
i: Integer;
s: string;
SubFolders, filesList: TStringDynArray;
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
procedure ListFiles(CONST aFolder: string);
VAR strFile: string;
begin
Predicate:=
function(const Path: string; const SearchRec: TSearchRec): Boolean
VAR Mask: string;
begin
for Mask in MaskArray DO
if System.Masks.MatchesMask(SearchRec.Name, Mask)
then EXIT(TRUE);
EXIT(FALSE);
end;
// Long paths will raise an EPathTooLongexception exception, so we simply don't process those folders
if Length(aFolder) > MAXPATH
then exit;
filesList:= TDirectory.GetFiles (aFolder, Predicate);
for strFile in filesList DO
if strFile<> '' { Bug somewhere here: it returns two empty entries ('') here. Maybe the root folder? }
then Result.Add(strFile);
end;
begin
{ I need this in order to prevent the EPathTooLongexception (reported by some users) }
if aFolder.Length >= MAXPATH then
begin
MesajError('Path is longer than '+ IntToStr(MAXPATH)+ ' characters!');
EXIT(NIL);
end;
if NOT System.IOUtils.TDirectory.Exists (aFolder)
then RAISE exception.Create('Folder does not exist! '+ CRLF+ aFolder);
Result:= TStringList.Create;
{ Split FileType in subcomponents }
MaskArray:= System.StrUtils.SplitString(FileType, ';');
{ Search the parent folder }
ListFiles(aFolder);
{ Search in all subfolders }
if DigSubdirectories then
begin
SubFolders:= TDirectory.GetDirectories(aFolder, TSearchOption.soAllDirectories, NIL);
for s in SubFolders DO
begin
if ccIO.DirectoryExists(s) { This solves the problem caused by broken 'Symbolic Link' folders }
then ListFiles(s);
end;
end;
{ Remove full path }
if NOT ReturnFullPath then
for i:= 0 to Result.Count-1 DO
Result[i]:= TPath.GetFileName(Result[i]);
end;
The code above is from: https://github.com/GodModeUser/Delphi-LightSaber

Sort TStringList by first character after whitespace

I have a TStringList in Delphi.
after the items are inserted i call .sort procedure to sort the items.
the Items are first names followed by last names. for example: "John Smith".
I want to sort the items by last name. I mean by the first character after the space.
how can I do this?
and also the items may be unicode strings like persian characters.
I'd use the CustomSort method of TStringList to supply a custom compare function. First of all, let's imagine that we have already got the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := ...;
end;
This function will (in due course) return negative to mean less than, positive to mean greater than and zero to mean equal.
Then we sort the list like this:
List.CustomSort(NameCompareFunc);
So, that's the easy bit done. But how do we implement NameCompareFunc? First of all let's split the name into last name and the rest.
procedure SplitName(const Name: string; out Last, Rest: string);
var
P: Integer;
begin
P := Pos(' ', Name);
if P = 0 then begin
Last := Trim(Name);
Rest := '';
end else begin
Last := Trim(Copy(Name, P+1, MaxInt));
Rest := Trim(Copy(Name, 1, P-1));
end;
end;
This is a pretty naive way to split a name. You'd probably want to search for separators starting from the end of the name, but I'll let you decide how to do that.
Now we can implement the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
var
Last1, Last2, Rest1, Rest2: string;
begin
SplitName(List[Index1], Last1, Rest1);
SplitName(List[Index2], Last2, Rest2);
Result := AnsiCompareText(Last1, Last2);
if Result = 0 then begin
Result := AnsiCompareText(Rest1, Rest2);
end;
end;
Some notes:
I'm assuming that name comparison should always be case-insensitive.
We use AnsiCompareText to perform locale aware comparison.
If we encounter two names that have the same last name, then we implement a secondary comparison o the rest of the name.
You could use the CustomSort methos of Stringlist:
function LastNameCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
var
S1, S2: string;
SpaceIndex: Integer;
begin
S1 := List[Index1];
SpaceIndex := Pos(' ', S1);
if SpaceIndex <> 0 then
S1 := Copy(S1, 1, SpaceIndex - 1);
S2 := List[Index2];
SpaceIndex := Pos(' ', S2);
if SpaceIndex <> 0 then
S2 := Copy(S2, 1, SpaceIndex - 1);
if List.CaseSensitive then
Result := AnsiCompareStr(S1, S2)
else
Result := AnsiCompareText(S1, S2);
end;
procedure TForm7.ButtonFirstNameClick(Sender: TObject);
begin
NameBuffer.Sort;
Memo1.Lines.Assign(NameBuffer);
end;
procedure TForm7.ButtonLastNameClick(Sender: TObject);
begin
NameBuffer.CustomSort(#LastNameCompareStrings);
Memo1.Lines.Assign(NameBuffer);
end;
I my example I have all your names in a StringList called NameBuffer. Then I've added two buttons to a form where I sort mylist, and display the result on the Screen.
You could iterate through each item of your StringList (lets call it FullNames),
split each string and put the "splits" in two new separate stringlists which you could call
FirstNameList and LastNameList.
Now create a third stringlist which you can call ReverseFirstLast,
and combine the items from LastNameList with FirstNameList and put them in ReverseNames.
Now you have all names in reverse order. Last name first, and first name last.
You can now sort the ReverseFirstLast-list and do a split&combine method again to reverse orders again and maintain the sorting.
That is one way to do it to get a rough method up and running.

How can I loop through a delimited string and assign the contents of the string to local delphi variables?

I have written a Delphi function that loads data from a .dat file into a string list. It then decodes the string list and assigns to a string variable. The contents of the string use the '#' symbol as a separator.
How can I then take the contents of this string and then assign its contents to local variables?
// Function loads data from a dat file and assigns to a String List.
function TfrmMain.LoadFromFile;
var
index, Count : integer;
profileFile, DecodedString : string;
begin
// Open a file and assign to a local variable.
OpenDialog1.Execute;
profileFile := OpenDialog1.FileName;
if profileFile = '' then
exit;
profileList := TStringList.Create;
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
Line := '';
Line := profileList[Index];
end;
end;
After its been decoded the var "Line" contains something that looks like this:
example:
Line '23#80#10#2#1#...255#'.
Not all of the values between the separators are the same length and the value of "Line" will vary each time the function LoadFromFile is called (e.g. sometimes a value may have only one number the next two or three etc so I cannot rely on the Copy function for strings or arrays).
I'm trying to figure out a way of looping through the contents of "Line", assigning it to a local variable called "buffer" and then if it encounters a '#' it then assigns the value of buffer to a local variable, re-initialises buffer to ''; and then moves onto the next value in "Line" repeating the process for the next parameter ignoring the '#' each time.
I think I have been scratching around with this problem for too long now and I cannot seem to make any progress and need a break from it. If anyone would care to have a look, I would welcome any suggestions on how this might be achieved.
Many Thanks
KD
You need a second TStringList:
lineLst := TStringList.Create;
try
lineLst.Delimiter := '#';
lineLst.DelimitedText := Line;
...
finally
lineLst.Free;
end;
Depending on your Delphi version you can set lineLst.StrictDelimiter := true in case the line contains spaces.
You can do something like this:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, StrUtils;
var
S : string;
D : string;
begin
S := '23#80#10#2#1#...255#';
for D in SplitString(S,'#') do //SplitString is in the StrUtils unit
writeln(D);
readln;
end.
You did not tag your Delphi version, so i don't know if it applies or not.
That IS version-specific. Please do!
In order of my personal preference:
1: Download Jedi CodeLib - http://jcl.sf.net. Then use TJclStringList. It has very nice split method. After that you would only have to iterate through.
function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
uses JclStringLists;
...
var s: string; js: IJclStringList.
begin
...
js := TJclStringList.Create().Split(input, '#', True);
for s in js do begin
.....
end;
...
end;
2: Delphi now has somewhat less featured StringSplit routine. http://docwiki.embarcadero.com/Libraries/en/System.StrUtils.SplitString
It has a misfeature that array of string type may be not assignment-compatible to itself. Hello, 1949 Pascal rules...
uses StrUtils;
...
var s: string;
a_s: TStringDynArray;
(* aka array-of-string aka TArray<string>. But you have to remember this term exactly*)
begin
...
a_s := SplitString(input, '#');
for s in a_s do begin
.....
end;
...
end;
3: Use TStringList. The main problem with it is that it was designed that spaces or new lines are built-in separators. In newer Delphi that can be suppressed. Overall the code should be tailored to your exact Delphi version. You can easily Google for something like "Using TStringlist for splitting string" and get a load of examples (like #Uwe's one).
But you may forget to suppress here or there. And you may be on old Delphi,, where that can not be done. And you may mis-apply example for different Delphi version. And... it is just boring :-) Though you can make your own function to generate such pre-tuned stringlists for you and carefully check Delphi version in it :-) But then You would have to carefully free that object after use.
I use a function I've written called Fetch. I think I stole the idea from the Indy library some time ago:
function Fetch(var VString: string; ASeperator: string = ','): string;
var LPos: integer;
begin
LPos := AnsiPos(ASeperator, VString);
if LPos > 0 then
begin
result := Trim(Copy(VString, 1, LPos - 1));
VString := Copy(VString, LPos + 1, MAXINT);
end
else
begin
result := VString;
VString := '';
end;
end;
Then I'd call it like this:
var
value: string;
line: string;
profileFile: string;
profileList: TStringList;
index: integer;
begin
if OpenDialog1.Execute then
begin
profileFile := OpenDialog1.FileName;
if (profileFile = '') or not FileExists(profileFile) then
exit;
profileList := TStringList.Create;
try
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
line := profileList[index];
Fetch(line, ''''); //discard "Line '"
value := Fetch(line, '#')
while (value <> '') and (value[1] <> '''') do //bail when we get to the quote at the end
begin
ProcessTheNumber(value); //do whatever you need to do with the number
value := Fetch(line, '#');
end;
end;
finally
profileList.Free;
end;
end;
end;
Note: this was typed into the browser, so I haven't checked it works.

How can I create a function with an arbitrary number of parameters?

I want to create a function that receive multiples strings as parameters.
Like the function printf("Hello %s",name); of C. but I don't want to pass a ready array, it wouldn't be readable.
Edit1.text:=lang('Hello');
Edit2.text:=lang('Welcome to {1} guest',place);
Edit3.text:=lang('Hi {1}, is your {2} time in {3}','Victor','first','Disney');
output should be:
Hello
Welcome to Disney guest
Hi Victor is your first time in Disney
how I create the function TForm1.lang(parameters:String):String;, I did a research, but I can't get it work.
I need to access the parameters[] and the parameters.length also.
I'm needing this to turn my App to multilang.
Here's an example function of how you can do this:
function TForm1.lang(s: String; params: array of String): String;
var
i: Integer;
begin
for i := 0 to High(params) do
begin
ShowMessage(params[i]);
end;
end;
Call it like this:
lang('My format string', ['this', 'that']);
or like this:
var
b: String;
begin
b := 'this';
lang('My format string', [b, 'that']);
end;
Not sure what you mean by not readable
DoSomething(['Param1','Param2']);
for
procedure DoSomething(args : Array of String);
Var
Index : Integer;
Begin
for index := Low(args) to High(args) Do
ShowMessage(args[Index]);
End;
Seems okay to me. Course if you want to call it from outside delphi then you have an issue.
Quick fix is just to pass in a delimited string and then user TStringList to split it.
You could write a wee function to do that, don't forget to free it when you are done.
All your three examples could be fixed by using SysUtils.Format:
Edit1.text := format('%s',['Hello']));
Edit1.text := format('Welcome to %s guest',[place]));
Edit1.text := format('Hi %s, is your %s time in %s',['Victor','first','Disney']));
Personally I think it's quite readable. If you can have what you need from a basic sysutils function, you should seriously consider doing that, rather than to write your own version. On the other hand, you may need more complex functionality that doesn't show in your question. If that's the case, I think paulsm4's suggestion of using a stringlist seems like a good way to go.
Delphi does not support CREATING functions withvararg-style parameters that work exactly like printf() does. It only supports CONSUMING such functions from external libraries. The closest Delphi comes to supporting the creation of functions with variable parameter lists is to use "open array" parameters, like what SysUtils.Format() uses.
As Tony mentions above, I also recommend using a deliminated string. Except, a little more than just deliminating, but using more of a parsing technique. If I understand right, this function you're making for formatting shall NOT include an array in the parameters, but technically, that doesn't mean we can't use arrays anywhere at all (arrays are very ideal to use for this scenario for fast performance).
This method will allow virtually anything to be passed in the parameters, including the deliminator, without affecting the output. The idea is to do A) Size of parameter string, B) Deliminator between size and parameter, and C) parameter string... And repeat...
const
MY_DELIM = '|'; //Define a deliminator
type
TStringArray = array of String;
/////////////////////////////////
//Convert an array of string to a single parsable string
// (Will be the first step before calling your format function)
function MakeParams(const Params: array of String): String;
var
X: Integer;
S: String;
begin
Result:= '';
for X:= 0 to Length(Params)-1 do begin
S:= Params[X];
Result:= Result + IntToStr(Length(S)) + MY_DELIM + S;
end;
end;
//Convert a single parsable string to an array of string
// (Will be called inside your format function to decode)
// This is more or less called parsing
function ExtractParams(const Params: String): TStringArray;
var
S: String; //Used for temporary parsing
T: String; //Used for copying temporary data from string
P: Integer; //Used for finding positions
C: Integer; //Used for keeping track of param count
Z: Integer; //Used for keeping track of parameter sizes
begin
S:= Params; //Because we'll be using 'Delete' command
C:= 0; //Set count to 0 to start
SetLength(Result, 0); //Prepare result array to 0 parameters
while Length(S) > 0 do begin //Do loop until nothing's left
P:= Pos(MY_DELIM, S); //Get position of next deliminator
if P > 1 then begin //If deliminator was found...
C:= C + 1; //We have a new parameter
SetLength(Result, C); //Set array length to new parameter count
T:= Copy(S, 1, P-1); //Get all text up to where deliminator was found
Delete(S, 1, P); //Delete what we just copied, including deliminator
Z:= StrToIntDef(T, 0); //Convert T:String to Z: Integer for size of parameter
T:= Copy(S, 1, Z); //Get all text up to 'Z' (size of parameter)
Delete(S, 1, Z); //Delete what we just copied
Result[C-1]:= T; //Assign the new parameter to end of array result
end else begin //If deliminator was NOT found...
S:= ''; //Clear S to exit loop (possible bad format if this happens)
end;
end;
end;
//Main formatting routine
function MyFormat(const Input: String; const Params: String): String;
var
A: TStringArray;
X: Integer;
S: String;
P: Integer;
R: String;
begin
R:= Input;
A:= ExtractParams(Params);
//At this point, A contains all the parameters parsed from 'Params'
for X:= 0 to Length(A)-1 do begin
S:= A[X];
P:= Pos('%s', R);
if P > 0 then begin
Delete(R, P, 2);
Insert(S, R, P);
end;
end;
Result:= R;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Pars: String;
begin
Pars:= MakeParams(['this', 'that', 'something else']);
Edit1.Text:= MyFormat('%s is %s but not %s', Pars);
end;
As you probably know, SysUtils.Format() implements "varargs" by using a set.
In your case, however, why not just pass a TStringList? The function will simply check "list.Count". Voila - you're done!

How to wash/validate a string to assign it to a componentname?

I have a submenu that list departments. Behind this each department have an action who's name is assigned 'actPlan' + department.name.
Now I realize this was a bad idea because the name can contain any strange character in the world but the action.name cannot contain international characters. Obviously Delphi IDE itself call some method to validate if a string is a valid componentname. Anyone know more about this ?
I have also an idea to use
Action.name := 'actPlan' + department.departmentID;
instead. The advantage is that departmentID is a known format, 'xxxxx-x' (where x is 1-9), so I have only to replace '-' with for example underscore. The problem here is that those old actionnames are already persisted in a personal textfile. It will be exceptions if I suddenly change from using departments name to the ID.
I could of course eat the exception first time and then call a method that search replace that textfile with the right data and reload it.
So basically I search the most elegant and futureproof method to solve this :)
I use D2007.
Component names are validated using the IsValidIdent function from SysUtils, which simply checks whether the first character is alphabetic or an underscore and whether all subsequent characters are alphanumeric or an underscore.
To create a string that fits those rules, simply remove any characters that don't qualify, and then add a qualifying character if the result starts with a number.
That transformation might yield the same result for similar names. If that's not something you want, then you can add something unique to the end of the string, such as a checksum computed from the input string, or your department ID.
function MakeValidIdent(const s: string): string;
var
len: Integer;
x: Integer;
c: Char;
begin
SetLength(Result, Length(s));
x := 0;
for c in s do
if c in ['A'..'Z', 'a'..'z', '0'..'9', '_'] then begin
Inc(x);
Result[x] := c;
end;
SetLength(Result, x);
if x = 0 then
Result := '_'
else if Result[1] in ['0'..'9'] then
Result := '_' + Result;
// Optional uniqueness protection follows. Choose one.
Result := Result + IntToStr(Checksum(s));
Result := Result + GetDepartment(s).ID;
end;
In Delphi 2009 and later, replace the second two in operators with calls to the CharInSet function. (Unicode characters don't work well with Delphi sets.) In Delphi 8 and earlier, change the first in operator to a classic for loop and index into s.
I have written a routine
// See SysUtils.IsValidIdent:
function MakeValidIdent(const AText: string): string;
const
Alpha = ['A'..'Z', 'a'..'z', '_'];
AlphaNumeric = Alpha + ['0'..'9'];
function IsValidChar(AIndex: Integer; AChar: Char): Boolean;
begin
if AIndex = 1 then
Result := AChar in Alpha
else
Result := AChar in AlphaNumeric;
end;
var
i: Integer;
begin
Result := AText;
for i := 1 to Length(Result) do
if not IsValidChar(i, Result[i]) then
Result[i] := '_';
end;
which makes Pascal identifiers from strings.
You might also want to copy FindUniqueName from Classes.pas and apply that to the result from MakeValidIdent.
Here is my routine:
function MakeValidIdent(const s: string): string;
begin
Result := 'clm'; //Prefix
for var c in s do
if CharInSet(c, ['A'..'Z', 'a'..'z', '0'..'9', '_']) then
Result := Result + c;
end;

Resources