I have a puzzling result that I'm struggling to understand.
I've been attempting to improve the speed of this routine
function TStringRecord.GetWord: String;
begin
// return the next word in Input
Result := '';
while (PC^ <> #$00) and not PC^.IsLetter do begin
inc(FPC);
end;
while (PC^ <> #$00) and PC^.IsLetter do begin
Result := Result + PC^;
inc(FPC);
end;
end;
by replacing the Result := Result + PC^ by a pointer-based operation. This
is my attempt:
function TStringRecord.GetWord2: String;
var
Len : Integer;
StartPC,
DestPC : PChar;
begin
// return the next word in Input
Result := '';
while (PC^ <> #$00) and not PC^.IsLetter do begin
inc(FPC);
end;
Len := Length(Input);
SetLength(Result, Len);
StartPC := PChar(Result);
DestPC := PChar(Result);
while (PC^ <> #$00) and PC^.IsLetter do begin
WStrPLCopy(DestPC, PC, 1);
inc(FPC);
inc(DestPC);
end;
SetLength(Result, DestPC - StartPC);
end;
According to my line profiler, WStrPLCopy(DestPC, PC, 1) takes 50 times longer
than Result := Result + PC^. As far as I can tell, this is because on entry
to WStrPLCopy there is a call to _WStrFromPWChar which seems to copy many more
characters than the one necessary. How can I avoid this, or can someone suggest
an alternative PChar-based method?
The remainder of my code is below:
TStringRecord = record
private
FPC: PChar;
FInput: String;
procedure SetInput(const Value: String);
public
function NextWord : String;
function NextWord2 : String;
property Input : String read FInput write SetInput;
property PC : PChar read FPC;
end;
procedure TStringRecord.SetInput(const Value: String);
begin
FInput := Value;
FPC := PChar(Input);
end;
This is how I would write it:
function TStringRecord.GetWord: String;
var beg: PChar;
begin
// return the next word in Input
while (FPC^ <> #0) and not FPC^.IsLetter do
inc(FPC);
beg := FPC;
while (FPC^ <> #0) and FPC^.IsLetter do
inc(FPC);
SetString(result, beg, FPC-beg);
end;
With this, code is very readable, and you have a single memory allocation, and I guess you could not write anything faster (but by inlining PC^.IsLetter, which is the only call to an external piece of code).
Related
In a Delphi 10.4.2 Win32 VCL Application, and based on the question + solution here which provides a way to get the string representation of a Shortcut Key (but presumably with no possibility to also pass a SHIFTSTATE for the Shortcut Key) I wrote this code:
function MyGetSpecialShortcutName(ShortCut: TShortCut): string;
// gets shortcut name for e.g. VK_NUMPAD0 where TMenuItem.Shortcut gets the wrong shortcut name
var
ScanCode: Integer;
KeyName: array[0..255] of Char;
begin
Result := '';
FillChar(KeyName, SizeOf(KeyName), 0);
ScanCode := Winapi.Windows.MapVirtualKey(LoByte(Word(ShortCut)), 0) shl 16;
if ScanCode <> 0 then
begin
if Winapi.Windows.GetKeyNameText(ScanCode, KeyName, Length(KeyName)) <> 0 then
Result := KeyName;
end;
end;
function GetSpecialShortcutNameWithShiftState(const AScanCode: Word; const AShiftState: System.Classes.TShiftState = []): string;
begin
Result := MyGetSpecialShortcutName(Vcl.Menus.ShortCut(AScanCode, AShiftState));
end;
Usage:
Result := GetSpecialShortcutNameWithShiftState(VK_A, [ssCTRL]);
However, the Result is "A" where the expected Result should be "CTRL+A".
How to get the string representation of a ShortCut Key including the SHIFTSTATE?
The OP wants the key names fully localised, but for completeness I first show that the VCL already has a function to obtain a partly unlocalised string, namely, ShortCutToText in the Menus unit:
ShortCutToText(ShortCut(Ord('A'), [ssShift, ssAlt]))
This returns Shift+Alt+A on all systems.
Now, using the Win32 function GetKeyNameText already mentioned in the Q, it is easy to obtain a fully localised shortcut string:
function GetKeyName(AKey: Integer): string;
var
name: array[0..128] of Char;
begin
FillChar(name, SizeOf(name), 0);
GetKeyNameText(MapVirtualKey(AKey, 0) shl 16, #name[0], Length(name));
Result := name;
end;
function ModifierVirtualKey(AModifier: Integer): Integer;
begin
case AModifier of
Ord(ssShift):
Result := VK_SHIFT;
Ord(ssCtrl):
Result := VK_CONTROL;
Ord(ssAlt):
Result := VK_MENU;
else
Result := 0;
end;
end;
function ShortcutToString(AKey: Integer; AShiftState: TShiftState = []): string;
begin
Result := '';
for var Modifier in AShiftState do
begin
var ModifierKey := ModifierVirtualKey(Ord(Modifier));
if ModifierKey <> 0 then
Result := Result + IfThen(not Result.IsEmpty, '+') + GetKeyName(ModifierKey);
end;
Result := Result + IfThen(not Result.IsEmpty, '+') + GetKeyName(AKey);
end;
(Here I use a IfThen overload from StrUtils.)
Now,
ShortcutToString(Ord('A'), [ssShift, ssAlt])
returns SKIFT+ALT+A on my Swedish system. SKIFT is, as you might already have guessed, the Swedish name for the SHIFT key.
I am trying to find and replace text in a text file. I have been able to do this in the past with methods like:
procedure SmallFileFindAndReplace(FileName, Find, ReplaceWith: string);
begin
with TStringList.Create do
begin
LoadFromFile(FileName);
Text := StringReplace(Text, Find, ReplaceWith, [rfReplaceAll, rfIgnoreCase]);
SaveToFile(FileName);
Free;
end;
end;
The above works fine when a file is relatively small, however; when the the file size is something like 170 Mb the above code will cause the following error:
EOutOfMemory with message 'Out of memory'
I have tried the following with success, however it takes a long time to run:
procedure Tfrm_Main.button_MakeReplacementClick(Sender: TObject);
var
fs : TFileStream;
s : AnsiString;
//s : string;
begin
fs := TFileStream.Create(edit_SQLFile.Text, fmOpenread or fmShareDenyNone);
try
SetLength(S, fs.Size);
fs.ReadBuffer(S[1], fs.Size);
finally
fs.Free;
end;
s := StringReplace(s, edit_Find.Text, edit_Replace.Text, [rfReplaceAll, rfIgnoreCase]);
fs := TFileStream.Create(edit_SQLFile.Text, fmCreate);
try
fs.WriteBuffer(S[1], Length(S));
finally
fs.Free;
end;
end;
I am new to "Streams" and working with buffers.
Is there a better way to do this?
Thank You.
You have two mistakes in first code example and three - in second example:
Do not load whole large file in memory, especially in 32bit application. If file size more than ~1 Gb, you always get "Out of memory"
StringReplace slows with large strings, because of repeated memory reallocation
In second code you don`t use text encoding in file, so (for Windows) your code "think" that file has UCS2 encoding (two bytes per character). But what you get, if file encoding is Ansi (one byte per character) or UTF8 (variable size of char)?
Thus, for correct find&replace you must use file encoding and read/write parts of file, as LU RD said:
interface
uses
System.Classes,
System.SysUtils;
type
TFileSearchReplace = class(TObject)
private
FSourceFile: TFileStream;
FtmpFile: TFileStream;
FEncoding: TEncoding;
public
constructor Create(const AFileName: string);
destructor Destroy; override;
procedure Replace(const AFrom, ATo: string; ReplaceFlags: TReplaceFlags);
end;
implementation
uses
System.IOUtils,
System.StrUtils;
function Max(const A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
{ TFileSearchReplace }
constructor TFileSearchReplace.Create(const AFileName: string);
begin
inherited Create;
FSourceFile := TFileStream.Create(AFileName, fmOpenReadWrite);
FtmpFile := TFileStream.Create(ChangeFileExt(AFileName, '.tmp'), fmCreate);
end;
destructor TFileSearchReplace.Destroy;
var
tmpFileName: string;
begin
if Assigned(FtmpFile) then
tmpFileName := FtmpFile.FileName;
FreeAndNil(FtmpFile);
FreeAndNil(FSourceFile);
TFile.Delete(tmpFileName);
inherited;
end;
procedure TFileSearchReplace.Replace(const AFrom, ATo: string;
ReplaceFlags: TReplaceFlags);
procedure CopyPreamble;
var
PreambleSize: Integer;
PreambleBuf: TBytes;
begin
// Copy Encoding preamble
SetLength(PreambleBuf, 100);
FSourceFile.Read(PreambleBuf, Length(PreambleBuf));
FSourceFile.Seek(0, soBeginning);
PreambleSize := TEncoding.GetBufferEncoding(PreambleBuf, FEncoding);
if PreambleSize <> 0 then
FtmpFile.CopyFrom(FSourceFile, PreambleSize);
end;
function GetLastIndex(const Str, SubStr: string): Integer;
var
i: Integer;
tmpSubStr, tmpStr: string;
begin
if not(rfIgnoreCase in ReplaceFlags) then
begin
i := Pos(SubStr, Str);
Result := i;
while i > 0 do
begin
i := PosEx(SubStr, Str, i + 1);
if i > 0 then
Result := i;
end;
if Result > 0 then
Inc(Result, Length(SubStr) - 1);
end
else
begin
tmpStr := UpperCase(Str);
tmpSubStr := UpperCase(SubStr);
i := Pos(tmpSubStr, tmpStr);
Result := i;
while i > 0 do
begin
i := PosEx(tmpSubStr, tmpStr, i + 1);
if i > 0 then
Result := i;
end;
if Result > 0 then
Inc(Result, Length(tmpSubStr) - 1);
end;
end;
var
SourceSize: int64;
procedure ParseBuffer(Buf: TBytes; var IsReplaced: Boolean);
var
i: Integer;
ReadedBufLen: Integer;
BufStr: string;
DestBytes: TBytes;
LastIndex: Integer;
begin
if IsReplaced and (not(rfReplaceAll in ReplaceFlags)) then
begin
FtmpFile.Write(Buf, Length(Buf));
Exit;
end;
// 1. Get chars from buffer
ReadedBufLen := 0;
for i := Length(Buf) downto 0 do
if FEncoding.GetCharCount(Buf, 0, i) <> 0 then
begin
ReadedBufLen := i;
Break;
end;
if ReadedBufLen = 0 then
raise EEncodingError.Create('Cant convert bytes to str');
FSourceFile.Seek(ReadedBufLen - Length(Buf), soCurrent);
BufStr := FEncoding.GetString(Buf, 0, ReadedBufLen);
if rfIgnoreCase in ReplaceFlags then
IsReplaced := ContainsText(BufStr, AFrom)
else
IsReplaced := ContainsStr(BufStr, AFrom);
if IsReplaced then
begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end
else
LastIndex := Length(BufStr);
SetLength(BufStr, LastIndex);
FSourceFile.Seek(FEncoding.GetByteCount(BufStr) - ReadedBufLen, soCurrent);
BufStr := StringReplace(BufStr, AFrom, ATo, ReplaceFlags);
DestBytes := FEncoding.GetBytes(BufStr);
FtmpFile.Write(DestBytes, Length(DestBytes));
end;
var
Buf: TBytes;
BufLen: Integer;
bReplaced: Boolean;
begin
FSourceFile.Seek(0, soBeginning);
FtmpFile.Size := 0;
CopyPreamble;
SourceSize := FSourceFile.Size;
BufLen := Max(FEncoding.GetByteCount(AFrom) * 5, 2048);
BufLen := Max(FEncoding.GetByteCount(ATo) * 5, BufLen);
SetLength(Buf, BufLen);
bReplaced := False;
while FSourceFile.Position < SourceSize do
begin
BufLen := FSourceFile.Read(Buf, Length(Buf));
SetLength(Buf, BufLen);
ParseBuffer(Buf, bReplaced);
end;
FSourceFile.Size := 0;
FSourceFile.CopyFrom(FtmpFile, 0);
end;
how to use:
procedure TForm2.btn1Click(Sender: TObject);
var
Replacer: TFileSearchReplace;
StartTime: TDateTime;
begin
StartTime:=Now;
Replacer:=TFileSearchReplace.Create('c:\Temp\123.txt');
try
Replacer.Replace('some текст', 'some', [rfReplaceAll, rfIgnoreCase]);
finally
Replacer.Free;
end;
Caption:=FormatDateTime('nn:ss.zzz', Now - StartTime);
end;
Your first try creates several copies of the file in memory:
it loads the whole file into memory (TStringList)
it creates a copy of this memory when accessing the .Text property
it creates yet another copy of this memory when passing that string to StringReplace (The copy is the result which is built in StringReplace.)
You could try to solve the out of memory problem by getting rid of one or more of these copies:
e.g. read the file into a simple string variable rather than a TStringList
or keep the string list but run the StringReplace on each line separately and write the result to the file line by line.
That would increase the maximum file size your code can handle, but you will still run out of memory for huge files. If you want to handle files of any size, your second approach is the way to go.
No - I don't think there's a faster way that the 2nd option (if you want a completely generic search'n'replace function for any file of any size). It may be possible to make a faster version if you code it specifically according to your requirements, but as a general-purpose search'n'replace function, I don't believe you can go faster...
For instance, are you sure you need case-insensitive replacement? I would expect that this would be a large part of the time spent in the replace function. Try (just for kicks) to remove that requirement and see if it doesn't speed up the execution quite a bit on large files (this depends on how the internal coding of the StringReplace function is made - if it has a specific optimization for case-sensitive searches)
I believe refinement of Kami's code is needed to account for the string not being found, but the start of a new instance of the string might occur at the end of the buffer. The else clause is different:
if IsReplaced then begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end else
LastIndex :=Length(BufStr) - Length(AFrom) + 1;
Correct fix is this one:
if IsReplaced then
begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end
else
if FSourceFile.Position < SourceSize then
LastIndex := Length(BufStr) - Length(AFrom) + 1
else
LastIndex := Length(BufStr);
I have an app that needs to do heavy text manipulation in a TStringList. Basically i need to split text by a delimiter ; for instance, if i have a singe line with 1000 chars and this delimiter occurs 3 times in this line, then i need to split it in 3 lines. The delimiter can contain more than one char, it can be a tag like '[test]' for example.
I've wrote two functions to do this task with 2 different approaches, but both are slow in big amounts of text (more then 2mbytes usually).
How can i achieve this goal in a faster way ?
Here are both functions, both receive 2 paramaters : 'lines' which is the original tstringlist and 'q' which is the delimiter.
function splitlines(lines : tstringlist; q: string) : integer;
var
s, aux, ant : string;
i,j : integer;
flag : boolean;
m2 : tstringlist;
begin
try
m2 := tstringlist.create;
m2.BeginUpdate;
result := 0;
for i := 0 to lines.count-1 do
begin
s := lines[i];
for j := 1 to length(s) do
begin
flag := lowercase(copy(s,j,length(q))) = lowercase(q);
if flag then
begin
inc(result);
m2.add(aux);
aux := s[j];
end
else
aux := aux + s[j];
end;
m2.add(aux);
aux := '';
end;
m2.EndUpdate;
lines.text := m2.text;
finally
m2.free;
end;
end;
function splitLines2(lines : tstringlist; q: string) : integer;
var
aux, p : string;
i : integer;
flag : boolean;
begin
//maux1 and maux2 are already instanced in the parent class
try
maux2.text := lines.text;
p := '';
i := 0;
flag := false;
maux1.BeginUpdate;
maux2.BeginUpdate;
while (pos(lowercase(q),lowercase(maux2.text)) > 0) and (i < 5000) do
begin
flag := true;
aux := p+copy(maux2.text,1,pos(lowercase(q),lowercase(maux2.text))-1);
maux1.add(aux);
maux2.text := copy(maux2.text,pos(lowercase(q),lowercase(maux2.text)),length(maux2.text));
p := copy(maux2.text,1,1);
maux2.text := copy(maux2.text,2,length(maux2.text));
inc(i);
end;
finally
result := i;
maux1.EndUpdate;
maux2.EndUpdate;
if flag then
begin
maux1.add(p+maux2.text);
lines.text := maux1.text;
end;
end;
end;
I've not tested the speed, but for academic purposes, here's an easy way to split the strings:
myStringList.Text :=
StringReplace(myStringList.Text, myDelimiter, #13#10, [rfReplaceAll]);
// Use [rfReplaceAll, rfIgnoreCase] if you want to ignore case
When you set the Text property of TStringList, it parses on new lines and splits there, so converting to a string, replacing the delimiter with new lines, then assigning it back to the Text property works.
The problems with your code (at least second approach) are
You are constantly using lowecase which is slow if called so many times
If I saw correctly you are copying the whole remaining text back to the original source. This is sure to be extra slow for large strings (eg files)
I have a tokenizer in my library. Its not the fastest or best but it should do (you can get it from Cromis Library, just use the units Cromis.StringUtils and Cromis.Unicode):
type
TTokens = array of ustring;
TTextTokenizer = class
private
FTokens: TTokens;
FDelimiters: array of ustring;
public
constructor Create;
procedure Tokenize(const Text: ustring);
procedure AddDelimiters(const Delimiters: array of ustring);
property Tokens: TTokens read FTokens;
end;
{ TTextTokenizer }
procedure TTextTokenizer.AddDelimiters(const Delimiters: array of ustring);
var
I: Integer;
begin
if Length(Delimiters) > 0 then
begin
SetLength(FDelimiters, Length(Delimiters));
for I := 0 to Length(Delimiters) - 1 do
FDelimiters[I] := Delimiters[I];
end;
end;
constructor TTextTokenizer.Create;
begin
SetLength(FTokens, 0);
SetLength(FDelimiters, 0);
end;
procedure TTextTokenizer.Tokenize(const Text: ustring);
var
I, K: Integer;
Counter: Integer;
NewToken: ustring;
Position: Integer;
CurrToken: ustring;
begin
SetLength(FTokens, 100);
CurrToken := '';
Counter := 0;
for I := 1 to Length(Text) do
begin
CurrToken := CurrToken + Text[I];
for K := 0 to Length(FDelimiters) - 1 do
begin
Position := Pos(FDelimiters[K], CurrToken);
if Position > 0 then
begin
NewToken := Copy(CurrToken, 1, Position - 1);
if NewToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(NewToken);
Inc(Counter)
end;
CurrToken := '';
end;
end;
end;
if CurrToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(CurrToken);
Inc(Counter)
end;
SetLength(FTokens, Counter);
end;
How about just using StrTokens from the JCL library
procedure StrTokens(const S: string; const List: TStrings);
It's open source
http://sourceforge.net/projects/jcl/
As an additional option, you can use regular expressions. Recent versions of Delphi (XE4 and XE5) come with built in regular expression support; older versions can find a free regex library download (zip file) at Regular-Expressions.info.
For the built-in regex support (uses the generic TArray<string>):
var
RegexObj: TRegEx;
SplitArray: TArray<string>;
begin
SplitArray := nil;
try
RegexObj := TRegEx.Create('\[test\]'); // Your sample expression. Replace with q
SplitArray := RegexObj.Split(Lines, 0);
except
on E: ERegularExpressionError do begin
// Syntax error in the regular expression
end;
end;
// Use SplitArray
end;
For using TPerlRegEx in earlier Delphi versions:
var
Regex: TPerlRegEx;
m2: TStringList;
begin
m2 := TStringList.Create;
try
Regex := TPerlRegEx.Create;
try
Regex.RegEx := '\[test\]'; // Using your sample expression - replace with q
Regex.Options := [];
Regex.State := [preNotEmpty];
Regex.Subject := Lines.Text;
Regex.SplitCapture(m2, 0);
finally
Regex.Free;
end;
// Work with m2
finally
m2.Free;
end;
end;
(For those unaware, the \ in the sample expression used are because the [] characters are meaningful in regular expressions and need to be escaped to be used in the regular expression text. Typically, they're not required in the text.)
I have a function declare like this :
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer; //The "OutValues" is a out parameter.
And I call this function like this:
procedure TForm1.Button6Click(Sender: TObject);
var
v:integer;
s:pchar;
begin
Memo1.Clear;
v := execProc(pchar('PROC_TEST'),pchar('aaa'),s);
showmessage(inttostr(v)); //mark line
Memo1.Lines.Add(strpas(s));
end;
when i delete the mark line(showmessage(inttostr(v))),i will have a correct result display in the Memo1,but if i keep use the showmessage(), the memo1 will dispaly an error string : "Messag" ,Why?
Thanks for any help!
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer;
var
str: TStrings;
InValue,OutValue: string;
i,j,scount: integer;
begin
Result := -100;
i := 0;
j := 0;
str := TStringList.Create;
try
sCount := ExtractStrings(['|'], [], InValues, str);
with kbmMWClientStoredProc1 do
begin
Close;
Params.Clear;
StoredProcName := StrPas(ProcName);
FieldDefs.Updated := False;
FieldDefs.Update;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptUnknown) or
(Params[i].ParamType = ptInput) or
(Params[i].ParamType = ptInputOutput) then
begin
inc(j);
InValue := str[j-1];
Params[i].Value := InValue;
end;
end;
try
ExecProc;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptOutput) or
(Params[i].ParamType = ptInputOutput) then
OutValue := OutValue + '|' + Params[i].AsString;
end;
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
Result := 0;
except
on E:Exception do
begin
if E.Message = 'Connection lost.' then Result := -101;//服务器连接失败
if E.Message = 'Authorization failed.' then Result := -102;//身份验证失败
Writelog(E.Message);
end;
end;
end;
finally
str.Free;
end;
end;
The problem is in the design of your interface and the use of PChar.
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
This is implemented by making an implicit, hidden, local string variable which holds the value
Copy(OutValue,2,Length(OutValue)-1)
When the function returns, that string variable is destroyed and so OutValues points at deallocated memory. Sometimes your program appears to work but that's really just down to chance. Any small change can disturb that, as you have observed.
The problem is easy enough to fix. Simply use string parameters rather than PChar. This will make the code easier to read as well as making it work correctly.
function execProc(ProcName, InValues: string; out OutValues: string): integer;
i fill a tdictionary , read from a file, to iterate over the key-value-pairs. iterating was solved in delphi dictionary iterating.
the problem is that the values in the dict are not kept, probably a scope-problem with variables. i am more used to java... the values do exist directly after assigning them to the dictionary in the procedure parsetextfile, then get lost:
program parsefile;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var key : string;
dict: TDictionary<String, TStringlist>;
KeysList, Valuename: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
subsplit2:= TStringList.Create;
AssignFile(testfile, 'g:\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
split(' ', splitarray[0], subsplit1);
splitarray[0]:=subsplit1[1];
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
write('Values are : '+ Valuename[i]);
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
subsplit2.Free;
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Destroy;
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.
Top Edit
I now saw you're more used to Java, that kind of explains your problem. Java uses an Garbage Collector: if you've got a reference to something, that one thing is valid. Delphi doesn't use a GC, you're responsible for freeing all the memory you allocate. This leads to the second problem: you can free memory you're holding a reference to, there's nothing stopping you from doing that. In your parsetestfile procedure you're adding subsplit2 to the dictionary, so you're keeping a copy of that reference. Later in the same procedure you're freeing subsplit2, so your dictionary now holds a reference to what Delphi considers to be "free memory"!
With Delphi you need to be very careful and deliberate with life cycle management. In this case you obviously can't free the subsplit2 in the parsetestfile procedure itself, but you do need to free it later. You'll need to free it when you free the Dict, look at my initial code for how to do that.
*Recom
Here's your code with lots of things fixed. Please read the comments, I inserted comments wherever I changed something.
It compiles and values survive the parse procedure, but I'm not sure what you want to achieve and you forgot to provide a sample text file: I had to "make one up".
program Project23;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var deviceid, key, topmodule : string;
dict: TDictionary<String, TStringlist>;
KeysList: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
ValueName:TStringList; // Never Ever ignore compiler warnings!
i: Integer; // Never Ever ignore compiler warnings!
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
AssignFile(testfile, 'c:\temp\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
subsplit2:= TStringList.Create; // Moved the creation of subsplit2 over here, because you need one fresh list for every line of text you read.
split(' ', splitarray[0], subsplit1); // can't split on SPACE because the previous split allready broke the text at "=" and at SPACE. That's how DelimitedText works!
// splitarray[0]:=subsplit1[1]; // splitarray[0] already contains the stuff before "="; And you should check the nubmer of lines in subsplit1!
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
writeLN('Values are : '+ Valuename[i]); // Only use Write when you intend to write the line terminator later
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
// subsplit2.Free; // Ooops! You're freeing Subsplit2, after you added it as a value in the dict.
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Free; // dict.Destroy; // never call "Destroy" directly, call .Free.
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.