Will the following code have a memory leak from the TStringlist?
function TDemo.GetList:TStringlist;
begin
Result:=TStringlist.Create;
{...}
end;
procedure TMain.Something;
Var
S:String;
begin
For S IN Demo.GetList do begin
end;
end;
Yes, the TStringList will leak. You must explicitly Free the TStringList when you are done using it, eg:
function TDemo.GetList: TStringList;
begin
Result := TStringlist.Create;
...
end;
procedure TMain.Something;
var
S: String;
SL: TStringList;
begin
SL := Demo.GetList;
try
for S in SL do begin
...
end;
finally
SL.Free;
end;
end;
This is why returning a Create'd object as a function return value is usually not a good idea. In this particular example, returning an array instead would be an alternative solution that doesn't require manual cleanup, eg:
function TDemo.GetList: TArray<String>;
begin
SetLength(Result, ...);
...
end;
procedure TMain.Something;
var
S: String;
begin
for S in Demo.GetList do begin
...
end;
end;
Related
Here its a VCL app and I have a link with my Ini file and I wanna keep adding lines in there with time and date stamps with press of a button.
private
FLog: TStringList;
FIni: TIniFile;
aTime: TDateTime;
procedure TForm2.btnBreakClick(Sender: TObject);
begin
FLog := TStringList.Create;
try
aTime := Now;
begin
FIni.WriteString('FileName', 'Break', FormatDateTime('dd/mm/yyyy hh:nn', aTime));
end;
finally
FLog.Free;
end
end;
With this piece of code I can only replace the previous time and date stamp I have tried to do it with a for loop but without succes.
This is the outcome with the current few lines of code.
[FileName]
Break=09-10-2018 13:35
And what I want is that everytime I hit the break button it needs to add on to the file with a other time.
An INI file contains key/value pairs. To do what you are asking for, you need to create a unique key name with every button press, otherwise you are just overwriting an existing value each time, as you have already discovered.
Try something more like this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
Keys: TStringList;
MaxBreak, I, Num: Integer;
begin
MaxBreak := 0;
Keys := TStringList.Create;
try
FIni.ReadSection('FileName', Keys);
for I := 0 to Keys.Count-1 do
begin
if StartsText('Break', Keys[I]) then
begin
if TryStrToInt(Copy(Keys, 6, MaxInt), Num) then
begin
if Num > MaxBreak then
MaxBreak := Num;
end;
end;
end;
finally
Keys.Free;
end;
FIni.WriteString('FileName', 'Break'+IntToStr(MaxBreak+1), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
I: Int64;
Key: string;
begin
for I := 1 to Int64(MaxInt) do
begin
Key := 'Break' + IntToStr(I);
if not FIni.ValueExists('FileName', Key) then
begin
FIni.WriteString('FileName', Key, FormatDateTime('dd/mm/yyyy hh:nn', Now));
Exit;
end;
end;
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
NumBreaks: Integer;
begin
NumBreaks := FIni.ReadInteger('FileName', 'NumBreaks', 0);
Inc(NumBreaks);
FIni.WriteInteger('FileName', 'NumBreaks', NumBreaks);
FIni.WriteString('FileName', 'Break' + IntToStr(NumBreaks), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Although you referred to TIniFile, your post and your comments tell me that that is not necessarily what you want. TIniFile is not really intended for the kind of usage you are describing, although it can be used (as the other answer shows).
For simple recording of events I suggest an ordinary text file, and for adding events to it, a TStringList as in the following example. The example is a simplified extract from code I used myself long time ago.
var
EventFile: TFileName;
procedure EventRecorder(EventTime: TDateTime; Description, Comment: string);
var
sl: TStringList;
es: string;
begin
sl: TStringList;
try
if FileExists(EventFile) then
sl.LoadFromFile(EventFile);
es := FormatDateTime('yyyy-mm-dd hh:nn:ss', EventTime)+' '+Description+' '+comment;
sl.Add(es);
sl.SaveToFile(EventFile);
finally
sl.free;
end;
end;
Typical usage
procedure TForm2.btnBreakClick(Sender: TObject);
begin
EventRecorder(now, 'Break', '');
end;
I need to save a TObjectList<TStrings> (or <TStringList>) in a TStream and then retrive it.
To be clear, how to apply SaveToStream and LoadFromStream to a TObjectList?
Try something like this:
procedure SaveListOfStringsToStream(List: TObjectList<TStrings>; Stream: TStream);
var
Count, I: Integer;
MStrm: TMemoryStream;
Size: Int64;
begin
Count := List.Count;
Stream.WriteBuffer(Count, SizeOf(Count));
if Count = 0 then Exit;
MStrm := TMemoryStream.Create;
try
for I := 0 to Count-1 do
begin
List[I].SaveToStream(MStrm);
Size := MStrm.Size;
Stream.WriteBuffer(Size, SizeOf(Size));
Stream.CopyFrom(MStrm, 0);
MStrm.Clear;
end;
finally
MStrm.Free;
end;
end;
procedure LoadListOfStringsFromStream(List: TObjectList<TStrings>; Stream: TStream);
var
Count, I: Integer;
MStrm: TMemoryStream;
Size: Int64;
SList: TStringList;
begin
Stream.ReadBuffer(Count, SizeOf(Count));
if Count <= 0 then Exit;
MStrm := TMemoryStream.Create;
try
for I := 0 to Count-1 do
begin
Stream.ReadBuffer(Size, SizeOf(Size));
SList := TStringList.Create;
try
if Size > 0 then
begin
MStrm.CopyFrom(Stream, Size);
MStrm.Position := 0;
SList.LoadFromStream(MStrm);
MStrm.Clear;
end;
List.Add(SList);
except
SList.Free;
raise;
end;
end;
finally
MStrm.Free;
end;
end;
Alternatively:
procedure SaveListOfStringsToStream(List: TObjectList<TStrings>; Stream: TStream);
var
LCount, SCount, Len, I, J: Integer;
SList: TStrings;
S: UTF8String;
begin
LCount := List.Count;
Stream.WriteBuffer(LCount, SizeOf(LCount));
if LCount = 0 then Exit;
for I := 0 to LCount-1 do
begin
SList := List[I];
SCount := SList.Count;
Stream.WriteBuffer(SCount, SizeOf(SCount));
for J := 0 to SCount-1 do
begin
S := UTF8String(SList[J]);
// or, if using Delphi 2007 or earlier:
// S := UTF8Encode(SList[J]);
Len := Length(S);
Stream.WriteBuffer(Len, SizeOf(Len));
Stream.WriteBuffer(PAnsiChar(S)^, Len * SizeOf(AnsiChar));
end;
end;
end;
procedure LoadListOfStringsFromStream(List: TObjectList<TStrings>; Stream: TStream);
var
LCount, SCount, Len, I, J: Integer;
SList: TStrings;
S: UTF8String;
begin
Stream.ReadBuffer(LCount, SizeOf(LCount));
for I := 0 to LCount-1 do
begin
Stream.ReadBuffer(SCount, SizeOf(SCount));
SList := TStringList.Create;
try
for J := 0 to SCount-1 do
begin
Stream.ReadBuffer(Len, SizeOf(Len));
SetLength(S, Len);
Stream.ReadBuffer(PAnsiChar(S)^, Len * SizeOf(AnsiChar));
SList.Add(String(S));
// or, if using Delphi 2007 or earlier:
// SList.Add(UTF8Decode(S));
end;
List.Add(SList);
except
SList.Free;
raise;
end;
end;
end;
What's in your list?
It depends on what type of objects you have in your objectlist.
You loop over the list and save each item in turn.
However the objects inside your list need to have a SaveToStream method.
For reasons unknown SaveToStream is not a method of TPersistent, instead it is implemented independently in different classes.
Test for stream support
If the VCL were built with interfaces in mind, in newer versions has been solved with the IStreamPersist interface.
If all your stuff in the list descents from a base class that has streaming built-in (e.g. TComponent) then there is no problem and you can just use TComponent.SaveToStream.
type
TStreamableClass = TStrings; //just to show that this does not depend on TStrings.
procedure SaveToStream(List: TObjectList; Stream: TStream);
var
i: integer;
begin
for i:= 0 to List.Count -1 do begin
if List[i] is TStreamableClass then begin
TStreamableClass(List[i]).SaveToStream(Stream);
end;
end; {for i}
end;
Add stream support
If you have items in your list that do not derive from a common streamable ancestor then you'll have to have multiple if list[i] is TX tests in your loop.
If the object does not have a SaveToStream method, but you have enough knowledge of the class to implement it yourself, then you have twothree options.
A: implement a class helper that adds SaveToStream to that class or B: add a descendent class that implements that option.
If these are your own objects, then see option C: below.
type
TObjectXStreamable = class(TObjectX)
public
procedure SaveToStream(Stream: TStream); virtual;
procedure LoadFromStream(Stream: TStream); virtual;
end;
procedure SaveToStream(List: TObjectList; Stream: TStream);
...
if List[i] is TObjectX then TObjectXStreamable(List[i]).SaveToStream(Stream);
...
Note that this approach fails if TObjectX has subclasses with additional data. The added streaming will not know about this extra data.
Option C: implement System.Classes.IStreamPersist
type
IStreamPersist = interface
['<GUID>']
procedure SaveToStream(Stream: TStream);
procedure LoadFromStream(Stream: TStream);
end;
//enhance your streamable objects like so:
TInterfaceBaseObject = TInterfacedObject //or TSingletonImplementation
TMyObject = class(TInterfaceBaseObject, IStreamPersist)
procedure SaveToStream(Stream: TStream); virtual;
procedure LoadFromStream(Stream: TStream); virtual;
See: Bypassing (disabling) Delphi's reference counting for interfaces
You test the IStreamPersist support using the supports call.
if Supports(List[i], IStreamPersist) then (List[i] as IStreamPersist).SaveToStream(Stream);
If you have a newer version of Delphi consider using a generic TObjectList, that way you can limit your list to: MyList: TObjectList<TComponent>;
Now you can just call MyList[i].SaveToStream, because Delphi knows that the list only contains (descendents of) TComponent.
You will need to create your own routine to do this: One for saving, the other for loading.
For saving, loop through the list, convert each pointer of the list into is hexadecimal (decimal, octal) then add a separator character like ','; When done write the string contain to the stream.
For loading, loop through the list, search for the first separator character, extract the value, convert it back as a pointer then add it to the list.
Procedure ObjListToStream(objList: TObjectList; aStream: TStream);
var
str: String;
iCnt: Integer;
Begin
if not assigned(aStream) then exit; {or raise exception}
for iCnt := 0 to objList.Count - 1 do
begin
str := str + IntToStr(Integer(objList.Items[iCnt])) + ',';
end;
aStream.Write(str[1], Length(str));
End;
Procedure StreamToObjList(objList: TObjectList; aList: String);
var
str: String;
iCnt: Integer;
iStart, iStop: Integer;
Begin
try
if not assigned(aStream) then exit; {or raise exception}
iStart := 0;
Repeat
iStop := Pos(',', aList, iStart);
if iStop > 0 then
begin
objList.Add(StrToInt(Copy(sList, iStart, iStop - iStart)));
iStart := iStop + 1;
end;
Until iStop = 0;
except
{something want wrong}
end;
End;
I haven't test it and wrote it from memory. But it should point you in the right direction.
The extended RTTI has the GetDeclaredProperties function which is exactly what i need, however i faced problems if i use the extended RTTI in multi-threading.
Therefore, i used GetPropList, but this gives me a list of all properties - not only published in the current class (or explicit stated).
i.e.
TBaseSettings = class(TPersistent)
published
property Charset: string read FCharset write FCharset;
end;
TBasicSettings = class(TBaseSettings)
published
property forums: Variant read fforums write fforums;
end;
TConcreteSettings = class(TBasicSettings)
published
property forums; // <-- make it explicit visible: OK
property prefix: Variant read fprefix write fprefix; // <-- OK
end;
I don't want to read the Charset property.
My first guess was to use a modified version of https://stackoverflow.com/a/1565686 to check for inheritance, but actually the forums property is also inherited.
Maybe this is not possible with the classic RTTI? I use Delphi 2010.
In case it's convenient to have your code calling GetDeclaredPropList in a similar way to calling GetPropList, see below.
Edit: I've rewritten the code in Delphi 7 and I believe it should work in Delphi 2010, too (which I don't have at hand).
type
PPropData = ^TPropData;
function AfterString(P: Pointer): Pointer;
begin
Result := Pointer(NativeUInt(P) + (PByte(P)^ + 1));
end;
function GetPropData(TypeData: PTypeData): PPropData;
begin
Result := AfterString(#TypeData^.UnitName);
end;
function NextPropInfo(PropInfo: PPropInfo): PPropInfo;
begin
Result := AfterString(#PropInfo^.Name);
end;
procedure GetDeclaredPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
var
TypeData: PTypeData;
PropData: PPropData;
PropInfo: PPropInfo;
I: Integer;
begin
TypeData := GetTypeData(TypeInfo);
PropData := GetPropData(TypeData);
FillChar(PropList^, Sizeof(PPropInfo) * PropData^.PropCount, 0);
PropInfo := PPropInfo(#PropData^.PropList);
for I := 0 to PropData^.PropCount - 1 do
begin
PropList^[I] := PropInfo;
PropInfo := NextPropInfo(PropInfo);
end;
end;
function GetDeclaredPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer; overload;
begin
Result := GetPropData(GetTypeData(TypeInfo))^.PropCount;
if Result > 0 then
begin
GetMem(PropList, Result * SizeOf(Pointer));
GetDeclaredPropInfos(TypeInfo, PropList);
end;
end;
function GetDeclaredPropList(AObject: TObject; out PropList: PPropList): Integer; overload;
begin
Result := GetDeclaredPropList(PTypeInfo(AObject.ClassInfo), PropList);
end;
// example usage:
var
I, Count: Integer;
PropList: PPropList;
PropInfo: PPropInfo;
begin
Count := GetDeclaredPropList(TypeInfo(TConcreteSettings), PropList);
try
for I := 0 to Count - 1 do
begin
PropInfo := PropList^[I];
Writeln(PropInfo^.Name);
end;
finally
FreeMem(PropList);
end;
end.
var
TypeData: PTypeData;
PropData: PPropData;
PropInfo: PPropInfo;
I: Integer;
begin
TypeData := GetTypeData(TypeInfo(TConcreteSettings));
PropData := GetPropData(TypeData);
if Assigned(PropData) then
begin
PropInfo := #PropData^.PropList;
for I := 0 to PropData^.PropCount - 1 do
begin
Writeln(PropInfo^.Name);
PropInfo := NextPropInfo(PropInfo);
end;
end;
end;
For implementation of GetPropData and NextPropInfo see my other answer above.
I don't know if it is even possible, but what I need is to access (use and free) a TStream variable by it pointer, passed thought a string parameter to another function.
Here is a "not working" example of what I am trying to do:
procedure TForm1.Button1Click(Sender: TObject);
var
Stm: TMemoryStream;
begin
Stm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Stm);
Stm.Position := 0;
Memo.Clear;
Edit.Text := IntToStr(Integer(#Stm));
except
Stm.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
PStm: ^TMemoryStream;
begin
PStm := Pointer(StrToInt(Edit.Text));
try
Memo.Lines.LoadFromStream(PStm^); // <--- Access Violation
finally
PStm^.Free;
end;
end;
Thanks for any help to solve this!
TStream is a reference type. Your Stm variable holds a pointer to the stream object instance. You want to pass this pointer value, not the address of the local variable. Here's the fixed code:
procedure TForm1.Button1Click(Sender: TObject);
var
Stm: TMemoryStream;
begin
Stm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Stm);
Stm.Position := 0;
Memo.Clear;
Edit.Text := IntToStr(Integer(Stm));
except
Stm.Free;
raise;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Stm: TMemoryStream;
begin
Stm := Pointer(StrToInt(Edit.Text));
try
Memo.Lines.LoadFromStream(Stm);
finally
Stm.Free;
end;
end;
To read a index file in a specific format, I cooked the following piece of code without considering byte ordering:
unit uCBI;
interface
uses
SysUtils,
Classes,
Generics.Collections;
type
TIndexList = class
private
FIndexList:TList<Cardinal>;
FOwnedStream:Boolean;
FMemoryStream: TMemoryStream;
function GetCount: Integer;
protected
public
constructor Create(AStream:TMemoryStream; OwnedStream:Boolean=True);
destructor Destroy; override;
function Add(const Value: Cardinal): Integer;
procedure Clear;
procedure SaveToFile(AFileName:TFileName);
procedure LoadFromFile(AFileName:TFileName);
property Count: Integer read GetCount;
end;
implementation
{ TIndexList }
function TIndexList.Add(const Value: Cardinal): Integer;
begin
Result := FIndexList.Add(Value)
end;
procedure TIndexList.Clear;
begin
FIndexList.Clear;
end;
constructor TIndexList.Create(AStream: TMemoryStream; OwnedStream: Boolean);
begin
FMemoryStream := AStream;
FOwnedStream := OwnedStream;
FIndexList := TList<Cardinal>.Create;
end;
destructor TIndexList.Destroy;
begin
if (FOwnedStream and Assigned(FMemoryStream)) then
FMemoryStream.Free;
FIndexList.Free;
//
inherited;
end;
function TIndexList.GetCount: Integer;
begin
Result := FIndexList.Count;
end;
procedure TIndexList.LoadFromFile(AFileName: TFileName);
var
lMemoryStream:TMemoryStream;
lCount:Cardinal;
begin
lMemoryStream := TMemoryStream.Create;
try
lMemoryStream.LoadFromFile(AFileName);
lMemoryStream.ReadBuffer(lCount,SizeOf(Cardinal));
if (lCount = Cardinal((lMemoryStream.Size-1) div SizeOf(Cardinal))) then
begin
FMemoryStream.Clear;
lMemoryStream.Position :=0;
FMemoryStream.CopyFrom(lMemoryStream,lMemoryStream.Size)
end else
raise Exception.CreateFmt('Corrupted CBI file: %s',[ExtractFileName(AFileName)]);
finally
lMemoryStream.Free;
end;
end;
procedure TIndexList.SaveToFile(AFileName: TFileName);
var
lCount:Cardinal;
lItem:Cardinal;
begin
FMemoryStream.Clear;
lCount := FIndexList.Count;
FMemoryStream.WriteBuffer(lCount,SizeOf(Cardinal));
for lItem in FIndexList do
begin
FMemoryStream.WriteBuffer(lItem,SizeOf(Cardinal));
end;
//
FMemoryStream.SaveToFile(AFileName);
end;
end.
It tested it and seems to work well as needed. Great was my suprise when I pursue extensive tests with real sample file. In fact the legacy format was devised with Amiga computer with a different byte ordering.
My Question:
How can I fix it ?
I want to keep the code unchanged and wonder wether a decorated TMemorySream will do so that I can transparently switch between big endian and little endian.
To change 'endianness' of Cardinals you can use the following:
function EndianChange(Value: Cardinal): Cardinal;
var
A1: array [0..3] of Byte absolute Value;
A2: array [0..3] of Byte absolute Result;
I: Integer;
begin
for I:= 0 to 3 do begin
A2[I]:= A1[3 - I];
end;
end;
If you want to keep your code unchanged, you can write your own TMemoryStream descendant and override its Read and Write methods using the above function, like that:
function TMyMemoryStream.Read(var Buffer; Count: Integer): Longint;
var
P: PCardinal;
I, N: Integer;
begin
inherited;
P:= #Buffer;
Assert(Count and 3 = 0);
N:= Count shr 2;
while N > 0 do begin
P^:= EndianChange(P^);
Inc(P);
Dec(N);
end;
end;