Why is FileAge returning unexpected values? - delphi

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

Related

How to delete a specific line from a text file in Delphi

I have a text file with user information stored in it line by line. Each line is in the format: UserID#UserEmail#UserPassword with '#' being the delimiter.
I have tried to use this coding to perform the task:
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.Delete(Index);
sl.SaveToFile('filename');
sl.free;
end;
But I'm not sure what to put in the "index" space.
Is there any way I can receive the User ID as input and then delete the line of text from the text file that has this user ID in? Any help would be appreciated.
You can set the NameValueSeparator to # then use IndexOfName to find the user, as long as the username is the first value in the file.
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
So in your example, like so
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
if (Index <> -1) then
begin
sl.Delete(Index);
sl.SaveToFile('filename');
end;
sl.free;
end;
This may be slow on large files as IndexOfName loops though each line in the TStringList and checks each string in turn until it finds a match.
Disclaimer: Tested/ works with Delphi 2007, Delphi 7 may be diffrent.
I don't see why so many people make this so hard. It is quite simple:
function ShouldDeleteLine(const UserID, Line: string): Boolean;
begin
// Remember: Pos(Needle, Haystack)
Result := Pos(UserID + '#', Line) = 1; // always 1-based!
end;
procedure DeleteLinesWithUserID(const FileName, UserID: string);
var
SL: TStringList;
I: Integer;
begin
if not FileExists(FileName) then
Exit;
SL := TStringList.Create;
try
SL.LoadFromFile(FileName); // Add exception handling for the
// case the file does not load properly.
// Always work backward when deleting items, otherwise your index
// may be off if you really delete.
for I := SL.Count - 1 downto 0 do
if ShouldDeleteLine(SL[I], UserID) then
begin
SL.Delete(I);
// if UserID is unique, you can uncomment the following line.
// Break;
end;
SL.SaveToFile(FileName);
finally
SL.Free;
end;
end;
As Arioch'The says, if you save to the same file name, you risk losing your data when the save fails, so you can do something like
SL.SaveToFile(FileName + '.dup');
if FileExists(FileName + '.old') then
DeleteFile(FileName + '.old');
RenameFile(FileName, FileName + '.old');
RenameFile(FileName + '.dup', FileName);
That keeps a backup of the original file as FileName + '.old'.
Explanations
Working backward
Why work backward? Because if you have the following items
A B C D E F G
^
And you delete the item at ^, then the following items will shift downward:
A B C E F G
^
If you iterate forward, you will now point to
A B C E F G
^
and E is never examined. If you go backward, then you will point to:
A B C E F G
^
Note that E, F and G were examined already, so now you will indeed examine the next item, C, and you won't miss any. Also, if you go upward using 0 to Count - 1, and delete, Count will become one less and at the end, you will try to access past the boundary of the list. This can't happen if you work backwards using Count - 1 downto 0.
Using + '#'
If you append '#' and test for Pos() = 1, you will be sure to catch the entire UserID up to the delimiter, and not a line with a user ID that only contains the UserID you are looking for. IOW, if UserID is 'velthuis', you don't want to delete lines like 'rudyvelthuis#rvelthuis01#password' or 'velthuisresidence#vr#password2', but you do want to delete 'velthuis#bla#pw3'.
E.g. when looking for a user name, you look for '#' + UserName + '#' for the same reason.
There is the only way to actually "delete a line from the text file" - that is to create a new file with changed content, to REWRITE it.
So you better just do it explicitly.
And don't you forget about protecting from errors. Your current code might just destroy the file and leak memory, if any error occurs...
var sl: TStringList;
s, prefix: string;
i: integer; okay: Boolean;
fs: TStream;
begin
prefix := 'UserName' + '#';
okay := false;
fs := nil;
sl:=TStringList.Create;
Try /// !!!!
sl.LoadFromFile('filename');
fs := TFileStream.Create( 'filename~new', fmCreate or fmShareExclusive );
for i := 0 to Prev(sl.Count) do begin
s := sl[ i ];
if AnsiStartsStr( prefix, Trim(s) ) then
continue; // skip the line - it was our haunted user
s := s + ^M^J; // add end-of-line marker for saving to file
fs.WriteBuffer( s[1], length(s)*SizeOf(s[1]) );
end;
finally
fs.Free;
sl.Free;
end;
// here - and only here - we are sure we successfully rewritten
// the fixed file and only no are able to safely delete old file
if RenameFile( 'filename' , 'filename~old') then
if RenameFile( 'filename~new' , 'filename') then begin
okay := true;
DeleteFile( 'filename~old' );
end;
if not okay then ShowMessage(' ERROR!!! ');
end;
Note 1: See if check for username should be case-sensitive or case-ignoring:
http://www.freepascal.org/docs-html/rtl/strutils/ansistartsstr.html
http://www.freepascal.org/docs-html/rtl/strutils/ansistartstext.html
Note 2: in Delphi 7 SizeOf( s[1] ) is always equal to one because string is an alias to AnsiString. But in newer Delphi version it is not. It might seems tedious and redundant - but it might save a LOT of headache in future. Even better would be to have a temporary AnsiString type variable like a := AnsiString( s + ^m^J ); fs.WriteBuffer(a[1],Length(a));
So far everyone has been suggesting the use for a For..Then Loop but can I suggest a Repeat..While.
The traditional For..Loop is a good option but could be inefficient if you have a long list of Usernames (they are usually unique). Once found and deleted the For Loop continues until the end of the list. That's ok if you have a small list but if you have 500,000 Usernames and the one you want is at position 10,000 there is no reason to continue beyond that point.
Therefore, try this.
Function DeleteUser(Const TheFile: String; Const TheUserName: String): Boolean;
Var
CurrentLine: Integer;
MyLines: TStringlist;
Found: Boolean;
Eof: Integer;
Begin
MyLines := TStringlist.Create;
MyLines.LoadFromFile(TheFile);
CurrentLine := 0;
Eof := Mylines.count - 1;
Found := false;
Repeat
If Pos(UpperCase(TheUserName), UpperCase(MyLines.Strings[CurrentLine])) = 1 Then
Begin
MyLines.Delete(CurrentLine);
Found := True;
End;
Inc(CurrentLine);
Until (Found) Or (CurrentLine = Eof); // Jump out when found or End of File
MyLines.SaveToFile(TheFile);
MyLines.Free;
result := Found;
End;
Once called the function returns True or False indicating the Username was deleted or not.
If Not DeleteUsername(TheFile,TheUsername) then
ShowMessage('User was not found, what were you thinking!');
Just for fun, here's a compact solution, which I like for its readability.
const fn = 'myfile.txt';
procedure DeleteUser(id: integer);
var s:string; a:TStringDynArray;
begin
for s in TFile.ReadAllLines(fn) do
if not s.StartsWith(id.ToString + '#') then
a := a + [s];
TFile.WriteAllLines(fn, a);
end;
Obviously it's not the most efficient solution. This could run faster by not appending single items to the array, or by caching the search string.
And to search for other fields, you could use s.split(['#'])[0] to find the username, s.split(['#'])[1] for email, etc.
For those who like one-liners. This works too:
const fn = 'users.txt';
procedure DeleteUserRegExp(id: string);
begin
TFile.WriteAllText(fn,TRegEx.Replace(TFile.ReadAllText(fn),''+id+'\#.*\r\n',''))
end;
Explanation
It loads the content of a file into a string.
The string is sent to TRegEx.Replace
The regular expression searches for the username followed by the hash sign, then any character, and then a CRLF. It replaces it with an empty string.
The resulting string is then written to the original file
This is just for fun though, because I saw long code where I thought that this would be possible with a single line of code.

How to read FoxPro Memory Variable Files (.MEM) with Delphi

I'm trying to read a .MEM file using Delphi. It's a FoxPro Memory Variable Files. I've tried to read using TFileStream and load into TStringList. But, it only returns the first word.
F := TFileStream.Create(sFile, fmOpenRead);
L := TStringList.Create;
try
F.Position := 0;
L.LoadFromStream(F);
ShowMessage(L.Text);
finally
F.Free;
L.Free;
end;
The reason is because I want to migrate some useful .MEM values from an old program to my new program. Thanks for any help.
If it's a one-time affair and you have access to a VFP installation - i.e. the IDE, not only the runtime - then David Heffernan's suggestion is certainly the most sensible way. In this case you can load and inspect the .MEM via
release all extended && to clear away all existing memvars
restore from foo && assuming the file in question is named FOO.MEM
activate window Locals && inspect the variables...
list memory to foo && or list them to FOO.TXT
modify file foo.txt
However, LIST MEMORY (and DISPLAY MEMORY) also include all the system variables - the things that start with an underscore - which would need to be parsed off.
If it's an ongoing affair - repeated imports necessary - and you know which variables you need then there are two fairly clean and easy ways.
The first is only valid if a VFP IDE is installed on the computer on which the Delphi program is to be run. In this case you can instantiate VFP from Delphi (leave it invisible), have it read the .MEM and then query individual variables:
procedure fetch_variables_from_MEM (mem_filename: string; var_list: CFoos);
var
fox: Variant;
foo: CFoo;
begin
fox := CreateOleObject('VisualFoxpro.Application.9');
try
fox.DoCmd('release all extended');
fox.DoCmd('restore from ' + mem_filename);
for foo in var_list do
foo.Value := fox.Eval('m.' + foo.Name);
finally
fox.Quit; // AutoQuit not supported
end;
end;
I glossed over some details, like that CoInitialize() needs to be called on the thread somewhere before calling this, and I assumed suitable definitions for the variable list (a list/collection of hypothetical CFoo objects), but the sketched outline works - even in 64-bit Delphi.
The advantage is that things like datetime values arrive as TDateTime by virtue of the COM infrastructure and the use of variants.
The second easy way is applicable if an IDE is not available on the machine where the Delphi program is to be used but you have access to an IDE somewhere, so that you can build a small COM server:
define class FoxWrapper as custom olepublic
function Eval (cExpression as string) as variant
return evaluate(m.cExpression)
procedure DoCmd (cCommand as string)
&cCommand
enddefine
This can then be used instead of "VisualFoxPro.Application.9" in the example above. Note: for 64-bit Delphi you need to build this as an out-of-process server (i.e. an EXE). Also, this may run afoul of the VFP licence conditions.
For accessing the data directly, here's some quick & dirty Delphi code that I modelled after some FoxPro stuff that I coded eons ago and updated for VFP9. This is proof-of-principle code with simplified array handling and other compromises for the sake of exposition; it lacks all the production-quality noise necessitated by Delphi's half-assed language definition and its quarter-assed runtime.
type
TMEMVarHeader = packed record
var_name: array [0..10] of AnsiChar;
mem_type: AnsiChar; // 0ACDHLNOQYacdhlnoqy
big_size: UInt32; // only if mem_type == 'H'
width : Byte; // special meaning if mem_type == 'H'
decimals: Byte;
padding : array [0..13] of Byte; // 0 0 0 0 0 0 0 3 0 0 0 0 0 0
end;
SizeOf_TMEMVarHeader_eq_32 = true .. SizeOf(TMEMVarHeader) = 32;
TMEMVarInfo = record
header: TMEMVarHeader;
null_t: AnsiChar;
name : AnsiString;
value : Variant;
function ReadFromStream (stream: TStream): Boolean; // false if EOF
end;
function TMEMVarInfo.ReadFromStream (stream: TStream): Boolean;
const
DELPHI_EPOCH = 2415019.0;
var
header_bytes_read: Integer;
name_length: UInt16;
text_length: UInt32;
array_dim_1: UInt16;
array_dim_2: UInt16;
d: TDate; // 64-bit double
l: Boolean;
n: Double; // 64-bit double
q: array of Byte;
c: AnsiString;
t: TDateTime; // 64-bit double
y: Int64;
binary: Boolean;
i: Cardinal;
a: array of Variant;
v: TMEMVarInfo;
begin
name := ''; value := Unassigned;
header_bytes_read := stream.Read(header, SizeOf(header));
if header_bytes_read <> Sizeof(header) then begin
if not ((header_bytes_read = 1) and (header.var_name[0] = #26)) then
raise Exception.Create('unexpected MEM file format (problem reading header)');
result := false; // EOF
EXIT;
end;
result := true;
// variable name
if header.var_name[0] = #0 then begin // long variable name
assert(header.mem_type = LoCase(header.mem_type));
stream.ReadBuffer(name_length, Sizeof(name_length));
SetLength(name, name_length);
stream.ReadBuffer(name[1], name_length);
end else begin
assert(header.mem_type = UpCase(header.mem_type));
name := header.var_name;
end;
// variable value
case UpCase(header.mem_type) of
'A':
begin
stream.ReadBuffer(array_dim_1, SizeOf(array_dim_1));
stream.ReadBuffer(array_dim_2, SizeOf(array_dim_2));
if array_dim_2 = 0 then // it's a vector, not an array
array_dim_2 := 1;
SetLength(a, array_dim_1 * array_dim_2);
for i := 0 to array_dim_1 * array_dim_2 - 1 do begin
if not v.ReadFromStream(stream) then
raise Exception.Create('error reading array element');
a[i] := v.value;
end;
value := a;
end;
'0': begin stream.ReadBuffer(null_t, 1); value := Null; end;
'C', 'H', 'Q':
begin
if UpCase(header.mem_type) = 'H' then begin // length > 254
binary := header.width <> 0;
text_length := header.big_size;
end else begin
binary := UpCase(header.mem_type) = 'Q';
text_length := header.width;
end;
if binary then begin
SetLength(q, text_length); stream.ReadBuffer(q[0], text_length); value := q;
end else begin
SetLength(c, text_length); stream.ReadBuffer(c[1], text_length); value := c;
end;
end;
'D': begin stream.ReadBuffer(d, Sizeof(d)); if d > 0 then d := d - DELPHI_EPOCH; VarCast(value, d, varDate); end;
'L': begin stream.ReadBuffer(l, Sizeof(l)); value := l; end;
'N': begin stream.ReadBuffer(n, Sizeof(n)); value := n; end;
'T': begin stream.ReadBuffer(t, Sizeof(t)); if t > 0 then t := t - DELPHI_EPOCH; value := t; end;
'Y': begin stream.ReadBuffer(y, Sizeof(y)); VarCast(value, y / 10000.0, varCurrency); end;
else
raise Exception.Create('unexpected type ''' + header.mem_type + ''' in MEM file');
end;
end;
For reading a .MEM, create a TFileStream and a TMEMVarInfo variable, then read variables one by one until var_info.ReadFromStream(stream) returns false.
Note: the byte at offset 19h (shown as 3 in the structure comment) is a code page identifier. The values are the same as those found in .DBF headers, i.e. 1 for DOS 437, 3 for Windows 1252 and so on. However, even though VFP stores these identifiers when writing a .MEM, all the newer versions of VFP that I tested completely ignore these code page marks when loading a .MEM. A self-written importer could put the code page marks to good use, though.
Reading the binary .mem files is not the correct way to proceed. The correct solution is to get VFP to export the data. It knows how to read it. Get VFP to export to a known format, and read that. This is the standard approach to data migration.

Strings getting corrupted in ComboBox.AddObject. How to add them the proper way?

I'm adding strings with objects (also strings) to a TComboBox, but getting corrupted strings when trying to retrieve them later.
This is how I'm adding them:
var
i: Integer;
sl: TStringList;
c: Integer;
s: PChar;
begin
for i := 1 to tblCalls.FieldCount do
if tblCalls.Fields[i - 1].Tag = 1 then
ListBox1.Items.Append(tblCalls.Fields[i - 1].FieldName);
sl := TStringList.Create;
try
LoadStyles(TStrings(sl));
for c := 0 to sl.Count - 1 do
begin
s := PChar(sl.Values[sl.Names[c]]);
ComboBox1.Items.AddObject(sl.Names[c], TObject(s));
end;
finally
sl.Free;
end;
end;
procedure LoadStyles(var AStylesList: TStrings);
var
f, n: String;
filelist: TStringDynArray;
begin
f := ExtractFilePath(ParamStr(0)) + 'Styles';
if (not DirectoryExists(f)) then
Exit;
filelist := TDirectory.GetFiles(f);
for f in filelist do
begin
n := ChangeFileExt(ExtractFileName(f), EmptyStr);
AStylesList.Add(n + '=' + f);
end;
end;
..and this is where I'm trying to retrieve a string object:
procedure TfrmOptions.ComboBox1Change(Sender: TObject);
var
si: TStyleInfo;
i: Integer;
s: String;
begin
i := TComboBox(Sender).ItemIndex;
s := PChar(TComboBox(Sender).Items.Objects[i]);
Showmessage(s); // --> Mostly shows a corrupted string (gibberish chars)
if (TStyleManager.IsValidStyle(s, si)) then
begin
if (not MatchStr(s, TStyleManager.StyleNames)) then
TStyleManager.LoadFromFile(s);
TStyleManager.TrySetStyle(si.Name);
end;
end;
I suspect that its something with the way I'm adding them. Perhaps I need to allocate memory at:
s := PChar(sl.Values[sl.Names[c]]);
Not sure. Looking at the help on StrNew, NewStr and StrAlloc, it says that those functions are deprecated. Can you help point out whats wrong?
There's nothing to keep the string alive. When you write:
s := PChar(sl.Values[sl.Names[c]]);
an implicit local variable of type string is created to hold whatever sl.Values[sl.Names[c]] evaluates to. That local variable goes out of scope, as far as the compiler is aware, nothing references it, and the string object is destroyed.
In fact, it's even worse than that. Because the assignment above happens in a loop, there is only one implicit local variable. Each time round the loop, the string that you asked the combo box to remember is destroyed.
You need to find a way to extend the lifetime of the string. You could do it like this:
var
StrPtr: ^string;
....
for c := 0 to sl.Count - 1 do
begin
New(StrPtr);
StrPtr^ := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], TObject(StrPtr));
end;
Then when you need to access the string you can do so like this:
var
StrPtr: ^string;
....
TObject(StrPtr) := TComboBox(Sender).Items.Objects[i];
// do something with StrPtr^
When you clear the combo box you must also run through each item and call Dispose on the pointer.
Having said that, it's going to be much easier not to do it that way. Stop trying to force strings into the TObject data associated with each item. Instead keep a parallel string list containing these strings. When you need to look up a name look it up in that list rather than in the combo box.
I know this is an old question but I came across this problem again and rather than use the separate string list I used an object with a string value (I think someone suggested it in a comment) as follows:
Declare a type as TObject with a string value:
TStringObject = class(TObject)
StringValue : string;
end;
Then when adding your items declare a local var of TStringObject and create a new instance for each item:
var
strObj : TStringObject
begin
...
for c := 0 to sl.Count - 1 do
begin
strObj := TStringObject.Create;
strObj.StringValue := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], strObj);
end;
And when retrieving the values:
s := TStringObject(TComboBox(Sender).Items.Objects[i]).StringValue;
As #Dejan Dozet mentions in the comments - you should always free the data objects before freeing the TStringList!

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

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

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.

Resources