How to read FoxPro Memory Variable Files (.MEM) with Delphi - 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.

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

Has function initialization code changed from Seattle to Tokyo?

I am in the process of upgrading code from Delphi 10 Seattle to Delphi 10.2 Tokyo and get a lot of H2077 hints Value assigned to ... never used on assignments.
(Even in places where these were explicitly added in the past to get rid of 'may not have a value' warnings).
These are all function initialized like:
Result := 0;
...
Or:
Result := ftType1; // where ftType1 is an enumerated type
...
Did the compiler get smarter in detecting these or has something changed regarding the initial return values of functions?
We have always had these hints 'on', and I always build (not compile).
Example function (1) that builds without hints in Seattle,
but gives the hint H2077 Value assigned to 'GetDatabaseDialect' not used on the first Result := 0 line in Tokyo.
function GetDatabaseDialect(DBName, User, Pswd: string) : integer;
var
status: array[1..19] of longint;
szDbName, szDbParam: PANSIChar;
dbHandle : pointer;
rslt: longint;
lDPBBuffer : ANSIString;
lDPBLength : integer;
cItem: ANSIChar;
szRslt: PANSIChar; //array[0..IBResultBufferSize-1] of ANSIChar;
begin
Result := 0;
dbHandle := nil;
// init database parameter block with version number
lDPBBuffer := '';
SetLength(lDPBBuffer, 1);
lDPBBuffer[1] := ANSIChar(isc_dpb_version1);
lDPBLength := 1;
// fill Database Parameter Buffer with user name/password
lDPBBuffer := lDPBBuffer +
ANSIChar(isc_dpb_user_name) +
ANSIChar(Length(User)) +
ANSIString( User );
Inc(lDPBLength, 2 + Length(User));
lDPBBuffer := lDPBBuffer +
ANSIChar(isc_dpb_password) +
ANSIChar(Length(Pswd)) +
ANSIString( Pswd );
Inc(lDPBLength, 2 + Length(Pswd));
//Pointers naar naam + buffer
szDbName := PANSIChar(ANSISTring(DBName));
szDbParam := PANSIChar( lDPBBuffer );
// attach to the database and set dialect
rslt := isc_attach_database(#status, 0, szDbName, #dbHandle, lDPBLength, szDbParam);
if rslt <> 0 then
raise EDatabaseError.Create('Error attaching database! ISC# ' + IntToStr(rslt));
//Haal sql dialect op
szRslt := AllocMem(1000);
try
FillChar( szRslt^, 1000, 0);
cItem := ANSIChar( isc_info_db_SQL_dialect );
rslt := isc_database_info(#status, #DBHandle, 1, #cItem, 1000, szRslt);
if rslt <> 0 then
raise EDatabaseError.Create('Error retrieving database info ! ISC# ' + IntToStr(rslt));
Result := Ord(szRslt[3]); //3e positie is dialect
finally
FreeMem(szRslt);
end;
// Drop the connection to the database
rslt := isc_detach_database(#status, #dbHandle);
if rslt <> 0 then
raise EDatabaseError.Create('Error detaching database! ISC# ' + IntToStr(rslt));
end;
Example (2) from a third party library that does not seem to be optimized for Tokyo,
illustrating the case with enumerated types:
H2077 Value assigned to 'TppTemplate.StreamType' not used
Note that changing the assignment to Result := ftASCII; does not make the hint go away (my initial assumption that it was associated with the first enumeration value was incorrect).
type TppFormatType = (ftBinary, ftASCII);
function TppTemplate.StreamType(aStream: TStream): TppFormatType;
var
lSavePos: Integer;
begin
{save stream position}
lSavePos := aStream.Position;
Result := ftBinary;
try
ComputeOffsetFromStream(aStream);
aStream.Seek(FOffset, soBeginning);
if IsValidASCIISignature(aStream) then
Result := ftASCII
else if IsValidBinarySignature(aStream) then
Result := ftBinary
else
raise EInvalidTemplateError.Create(ppLoadStr(49));
finally
{restore stream position}
aStream.Seek(lSavePos, soBeginning);
end;
end; {function, StreamType}
The common denominator seems to be the Result assignments being in try/finally blocks.
Consider this code with a minimal reproduction of your scenario:
function Bar: Boolean;
begin
Result := Random<0.5;
end;
function Foo: Integer;
begin
Result := 0;
if Bar then
Result := 1
else
raise Exception.Create('');
end;
The compiler, even older versions, emits the following hint:
[dcc32 Hint]: H2077 Value assigned to 'Foo' never used
This is reasonable. The first assignment to Result is pointless and can be removed.
Now consider this variation:
function Foo: Integer;
begin
Result := 0;
try
if Bar then
Result := 1
else
raise Exception.Create('');
finally
end;
end;
Older versions of the compiler no longer emit the hint, but the latest version of the compiler does. This should be considered a compiler defect, for older versions. The two variants of Foo shown above are semantically identical. The compiler would be justified in generating identical code.
As you surmise, the assignment being inside the try/finally block is necessary to trigger the defect in previous versions.
We can conclude that the Embarcadero developers have fixed a defect in Tokyo. You can resolve the hints by removing the spurious initial assignments.
Of course, if your code is to be compiled by older versions of the compiler, as well as by new versions, then you are in a bind. With the code as it stands now, a hint is emitted by new versions of the compiler. Remove the initial assignment and a hint is emitted by old versions of the compiler.

How to read last line in a text file using Delphi

I need to read the last line in some very large textfiles (to get the timestamp from the data). TStringlist would be a simple approach but it returns an out of memory error. I'm trying to use seek and blockread, but the characters in the buffer are all nonsense. Is this something to do with unicode?
Function TForm1.ReadLastLine2(FileName: String): String;
var
FileHandle: File;
s,line: string;
ok: 0..1;
Buf: array[1..8] of Char;
k: longword;
i,ReadCount: integer;
begin
AssignFile (FileHandle,FileName);
Reset (FileHandle); // or for binary files: Reset (FileHandle,1);
ok := 0;
k := FileSize (FileHandle);
Seek (FileHandle, k-1);
s := '';
while ok<>1 do begin
BlockRead (FileHandle, buf, SizeOf(Buf)-1, ReadCount); //BlockRead ( var FileHandle : File; var Buffer; RecordCount : Integer {; var RecordsRead : Integer} ) ;
if ord (buf[1]) <>13 then //Arg to integer
s := s + buf[1]
else
ok := ok + 1;
k := k-1;
seek (FileHandle,k);
end;
CloseFile (FileHandle);
// Reverse the order in the line read
setlength (line,length(s));
for i:=1 to length(s) do
line[length(s) - i+1 ] := s[i];
Result := Line;
end;
Based on www.delphipages.com/forum/showthread.php?t=102965
The testfile is a simple CSV I created in excel ( this is not the 100MB I ultimately need to read).
a,b,c,d,e,f,g,h,i,j,blank
A,B,C,D,E,F,G,H,I,J,blank
1,2,3,4,5,6,7,8,9,0,blank
Mary,had,a,little,lamb,His,fleece,was,white,as,snow
And,everywhere,that,Mary,went,The,lamb,was,sure,to,go
You really have to read the file in LARGE chunks from the tail to the head.
Since it is so large it does not fit the memory - then reading it line by line from start to end would be very slow. With ReadLn - twice slow.
You also has to be ready that the last line might end with EOL or may not.
Personally I would also account for three possible EOL sequences:
CR/LF aka #13#10=^M^J - DOS/Windows style
CR without LF - just #13=^M - Classic MacOS file
LF without CR - just #10=^J - UNIX style, including MacOS version 10
If you are sure your CSV files would only ever be generated by native Windows programs it would be safe to assume full CR/LF be used. But if there can be other Java programs, non-Windows platforms, mobile programs - I would be less sure. Of course pure CR without LF would be the least probable case of them all.
uses System.IOUtils, System.Math, System.Classes;
type FileChar = AnsiChar; FileString = AnsiString; // for non-Unicode files
// type FileChar = WideChar; FileString = UnicodeString;// for UTF16 and UCS-2 files
const FileCharSize = SizeOf(FileChar);
// somewhere later in the code add: Assert(FileCharSize = SizeOf(FileString[1]);
function ReadLastLine(const FileName: String): FileString; overload; forward;
const PageSize = 4*1024;
// the minimal read atom of most modern HDD and the memory allocation atom of Win32
// since the chances your file would have lines longer than 4Kb are very small - I would not increase it to several atoms.
function ReadLastLine(const Lines: TStringDynArray): FileString; overload;
var i: integer;
begin
Result := '';
i := High(Lines);
if i < Low(Lines) then exit; // empty array - empty file
Result := Lines[i];
if Result > '' then exit; // we got the line
Dec(i); // skip the empty ghost line, in case last line was CRLF-terminated
if i < Low(Lines) then exit; // that ghost was the only line in the empty file
Result := Lines[i];
end;
// scan for EOLs in not-yet-scanned part
function FindLastLine(buffer: TArray<FileChar>; const OldRead : Integer;
const LastChunk: Boolean; out Line: FileString): boolean;
var i, tailCRLF: integer; c: FileChar;
begin
Result := False;
if Length(Buffer) = 0 then exit;
i := High(Buffer);
tailCRLF := 0; // test for trailing CR/LF
if Buffer[i] = ^J then begin // LF - single, or after CR
Dec(i);
Inc(tailCRLF);
end;
if (i >= Low(Buffer)) and (Buffer[i] = ^M) then begin // CR, alone or before LF
Inc(tailCRLF);
end;
i := High(Buffer) - Max(OldRead, tailCRLF);
if i - Low(Buffer) < 0 then exit; // no new data to read - results would be like before
if OldRead > 0 then Inc(i); // the CR/LF pair could be sliced between new and previous buffer - so need to start a bit earlier
for i := i downto Low(Buffer) do begin
c := Buffer[i];
if (c=^J) or (c=^M) then begin // found EOL
SetString( Line, #Buffer[i+1], High(Buffer) - tailCRLF - i);
exit(True);
end;
end;
// we did not find non-terminating EOL in the buffer (except maybe trailing),
// now we should ask for more file content, if there is still left any
// or take the entire file (without trailing EOL if any)
if LastChunk then begin
SetString( Line, #Buffer[ Low(Buffer) ], Length(Buffer) - tailCRLF);
Result := true;
end;
end;
function ReadLastLine(const FileName: String): FileString; overload;
var Buffer, tmp: TArray<FileChar>;
// dynamic arrays - eases memory management and protect from stack corruption
FS: TFileStream; FSize, NewPos: Int64;
OldRead, NewLen : Integer; EndOfFile: boolean;
begin
Result := '';
FS := TFile.OpenRead(FileName);
try
FSize := FS.Size;
if FSize <= PageSize then begin // small file, we can be lazy!
FreeAndNil(FS); // free the handle and avoid double-free in finally
Result := ReadLastLine( TFile.ReadAllLines( FileName, TEncoding.ANSI ));
// or TEncoding.UTF16
// warning - TFIle is not share-aware, if the file is being written to by another app
exit;
end;
SetLength( Buffer, PageSize div FileCharSize);
OldRead := 0;
repeat
NewPos := FSize - Length(Buffer)*FileCharSize;
EndOfFile := NewPos <= 0;
if NewPos < 0 then NewPos := 0;
FS.Position := NewPos;
FS.ReadBuffer( Buffer[Low(Buffer)], (Length(Buffer) - OldRead)*FileCharSize);
if FindLastLine(Buffer, OldRead, EndOfFile, Result) then
exit; // done !
tmp := Buffer; Buffer := nil; // flip-flop: preparing to broaden our mouth
OldRead := Length(tmp); // need not to re-scan the tail again and again when expanding our scanning range
NewLen := Min( 2*Length(tmp), FSize div FileCharSize );
SetLength(Buffer, NewLen); // this may trigger EOutOfMemory...
Move( tmp[Low(tmp)], Buffer[High(Buffer)-OldRead+1], OldRead*FileCharSize);
tmp := nil; // free old buffer
until EndOfFile;
finally
FS.Free;
end;
end;
PS. Note one extra special case - if you would use Unicode chars (two-bytes ones) and would give odd-length file (3 bytes, 5 bytes, etc) - you would never be ble to scan the starting single byte (half-widechar). Maybe you should add the extra guard there, like Assert( 0 = FS.Size mod FileCharSize)
PPS. As a rule of thumb you better keep those functions out of the form class, - because WHY mixing them? In general you should separate concerns into small blocks. Reading file has nothing with user interaction - so should better be offloaded to an extra UNIT. Then you would be able to use functions from that unit in one form or 10 forms, in main thread or in multi-threaded application. Like LEGO parts - they give you flexibility by being small and separate.
PPPS. Another approach here would be using memory-mapped files. Google for MMF implementations for Delphi and articles about benefits and problems with MMF approach. Personally I think rewriting the code above to use MMF would greatly simplify it, removing several "special cases" and the troublesome and memory copying flip-flop. OTOH it would demand you to be very strict with pointers arithmetic.
https://en.wikipedia.org/wiki/Memory-mapped_file
https://msdn.microsoft.com/en-us/library/ms810613.aspx
http://torry.net/quicksearchd.php?String=memory+map&Title=No
Your char type is two byte, so that buffer is 16 byte. Then with blockread you read sizeof(buffer)-1 byte into it, and check the first 2 byte char if it is equal to #13.
The sizeof(buffer)-1 is dodgy (where does that -1 come from?), and the rest is valid, but only if your input file is utf16.
Also your read 8 (or 16) characters each time, but compare only one and then do a seek again. That is not very logical either.
If your encoding is not utf16, I suggest you change the type of a buffer element to ansichar and remove the -1
In response to kopiks suggestion, I figured out how to do it with TFilestream, it works ok with the simple test file, though there may be some further tweeks when I use it on a variety of csv files. Also, I don't make any claims that this is the most efficient method.
procedure TForm1.Button6Click(Sender: TObject);
Var
StreamSize, ApproxNumRows : Integer;
TempStr : String;
begin
if OpenDialog1.Execute then begin
TempStr := ReadLastLineOfTextFile(OpenDialog1.FileName,StreamSize, ApproxNumRows);
// TempStr := ReadFileStream('c:\temp\CSVTestFile.csv');
ShowMessage ('approximately '+ IntToStr(ApproxNumRows)+' Rows');
ListBox1.Items.Add(TempStr);
end;
end;
Function TForm1.ReadLastLineOfTextFile(const FileName: String; var StreamSize, ApproxNumRows : Integer): String;
const
MAXLINELENGTH = 256;
var
Stream: TFileStream;
BlockSize,CharCount : integer;
Hash13Found : Boolean;
Buffer : array [0..MAXLINELENGTH] of AnsiChar;
begin
Hash13Found := False;
Result :='';
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
StreamSize := Stream.size;
if StreamSize < MAXLINELENGTH then
BlockSize := StreamSize
Else
BlockSize := MAXLINELENGTH;
// for CharCount := 0 to Length(Buffer)-1 do begin
// Buffer[CharCount] := #0; // zeroing the buffer can aid diagnostics
// end;
CharCount := 0;
Repeat
Stream.Seek(-(CharCount+3), 2); //+3 misses out the #0,#10,#13 at the end of the file
Stream.Read( Buffer[CharCount], 1);
Result := String(Buffer[CharCount]) + result;
if Buffer[CharCount] =#13 then
Hash13Found := True;
Inc(CharCount);
Until Hash13Found OR (CharCount = BlockSize);
ShowMessage(Result);
ApproxNumRows := Round(StreamSize / CharCount);
end;
Just thought of a new solution.
Again, there could be better ones, but this one is the best i thought of.
function GetLastLine(textFilePath: string): string;
var
list: tstringlist;
begin
list := tstringlist.Create;
try
list.LoadFromFile(textFilePath);
result := list[list.Count-1];
finally
list.free;
end;
end;

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