I always was thinking that OleVariant variables always has initial value equal to Unassigned (type VT_EMPTY). But the following simple code compiled with XE3 shows me it is not true.
{$APPTYPE CONSOLE}
uses
ActiveX;
function GetValue: OleVariant;
begin
Result := TVariantArg(Result).vt;
end;
function GetValue2: OleVariant;
begin
Result := 10;
Result := GetValue;
end;
var
Msg: string;
begin
Msg := GetValue2;
Writeln(Msg);
end.
App writes "3". Is it normal?
The return value of a Delphi function, for types that don't fit in a register, are passed as var parameters. So the compiler transforms the code to be like so:
procedure GetValue(var Result: OleVariant);
Hence the value of Result on entry to the function is the value of the variable that you assign the return value to.
So your calling code is transformed to
function GetValue2: OleVariant;
begin
Result := 10;
GetValue(Result);
end;
So in its entirety your program becomes
{$APPTYPE CONSOLE}
uses
ActiveX;
procedure GetValue(var Result: OleVariant);
begin
Result := TVariantArg(Result).vt;
end;
procedure GetValue2(var Result: OleVariant);
begin
Result := 10;
GetValue(Result);
end;
var
tmp: OleVariant;
Msg: string;
begin
GetValue2(tmp);
Msg := tmp;
Writeln(Msg);
end.
Which explains the output of VT_I4.
Of course this is all a consequence of implementation detail. You should always initialize function return values.
Related
I'm trying to implement an IDE Wizard with ToolsApi and using the GExperts FAQ (http://www.gexperts.org/examples/GXModuleCreator.pas) as reference.
Although the bpl compiles, the unit doesn't shows up on the IDE.
I'm Using Delphi 10.3.2 Rio.
unit ModuleCreator;
interface
uses
SysUtils, Windows, Dialogs, ToolsAPI;
type
TJIdeWizardSourceFile = class(TInterfacedObject, IOTAFile)
private
FSource: string;
public
function GetSource: string;
function GetAge: TDateTime;
constructor Create(const Source: string);
end;
TJIdeWizardModuleCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
public
// IOTACreator
function GetCreatorType: string;
function GetExisting: Boolean;
function GetFileSystem: string;
function GetOwner: IOTAModule;
function GetUnnamed: Boolean;
// IOTAModuleCreator
function GetAncestorName: string;
function GetImplFileName: string;
function GetIntfFileName: string;
function GetFormName: string;
function GetMainForm: Boolean;
function GetShowForm: Boolean;
function GetShowSource: Boolean;
function NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
procedure FormCreated(const FormEditor: IOTAFormEditor);
end;
implementation
{ TJIdeWizardModuleCreator }
procedure TJIdeWizardModuleCreator.FormCreated(const FormEditor: IOTAFormEditor);
begin
//
end;
function TJIdeWizardModuleCreator.GetAncestorName: string;
begin
Result := 'Form';
end;
function TJIdeWizardModuleCreator.GetCreatorType: string;
begin
Result := sUnit;
end;
function TJIdeWizardModuleCreator.GetExisting: Boolean;
begin
Result := False;
end;
function TJIdeWizardModuleCreator.GetFileSystem: string;
begin
Result := '';
end;
function TJIdeWizardModuleCreator.GetFormName: string;
begin
Result := '';
end;
function TJIdeWizardModuleCreator.GetImplFileName: string;
begin
Result := '';
end;
function TJIdeWizardModuleCreator.GetIntfFileName: string;
begin
Result := '';
end;
function TJIdeWizardModuleCreator.GetMainForm: Boolean;
begin
Result := False;
end;
function TJIdeWizardModuleCreator.GetOwner: IOTAModule;
var
ModuleServices: IOTAModuleServices;
Module: IOTAModule;
NewModule: IOTAModule;
begin
// You may prefer to return the project group's ActiveProject instead
Result := nil;
ModuleServices := (BorlandIDEServices as IOTAModuleServices);
Module := ModuleServices.CurrentModule;
if Module <> nil then
begin
if Module.QueryInterface(IOTAProject, NewModule) = S_OK then
Result := NewModule
else if Module.OwnerModuleCount > 0 then
begin
NewModule := Module.OwnerModules[0];
if NewModule <> nil then
if NewModule.QueryInterface(IOTAProject, Result) <> S_OK then
Result := nil;
end;
end;
end;
function TJIdeWizardModuleCreator.GetShowForm: Boolean;
begin
Result := True;
end;
function TJIdeWizardModuleCreator.GetShowSource: Boolean;
begin
Result := True;
end;
function TJIdeWizardModuleCreator.GetUnnamed: Boolean;
begin
Result := True;
end;
function TJIdeWizardModuleCreator.NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
begin
Result := nil;
end;
function TJIdeWizardModuleCreator.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
begin
// or Result := nil; for the default unit
Result := nil;
end;
function TJIdeWizardModuleCreator.NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
begin
Result := nil;
end;
{ TJIdeWizardSourceFile }
constructor TJIdeWizardSourceFile.Create(const Source: string);
begin
FSource := Source;
end;
function TJIdeWizardSourceFile.GetAge: TDateTime;
begin
Result := -1;
end;
function TJIdeWizardSourceFile.GetSource: string;
begin
result := FSource;
end;
end.
Here is an example of how I´m calling the method "NewImplSource" from IOTAModuleCreator
procedure TfrmMapearObjetoRelacional.btnSimpleORMDaoClick(Sender: TObject);
var
_Mod: TJIdeWizardModuleCreator;
_Str: string;
begin
_Mod := TJIdeWizardModuleCreator.Create;
try
_Str := _Mod.NewImplSource('unit1','','');
ShowMessage(_Str);
finally
FreeAndNil(_Mod);
end;
end;
The answer for the question is YES it does.
The problem was that one should not call "NewImplSource" directly.
In order for it to work, it should be called based on the result from "GetCreatorType" inside the "IOTAModuleCreator" Constructor.
for instance:
procedure TJModuleCreatorWizard.Execute;
begin
(BorlandIDEServices as IOTAModuleServices).CreateModule(TJModuleCreator.Create);
end;
Where "TJModuleCreator" implements IOTAModuleCreator interface.
Martyn, thak you very much for your assistance, in fact I was able to figure it out by simplifying the scenario as you suggested on your answer.
If you don't have any luck debugging this in a second instance of the IDE like I suggested
in a project, I think you should consider changing your code do follow the way I go about
implementing something like this.
I implement the OTA interface of interest on a small form. Although the form is, in principle,
unnecessary, it is very useful to give a visual sign that the thing's working and there is actually
quite a lot of debugging you can do without having to resort to the second-IDE-instance business. You can build quite a lot of debugging facilities into the form by placing a small TMemo on it
and using it as a logging facility to record what it does. And, of course, the form can have
a MainMenu or whatever to invoke various of the OTA interface's methods to check that they do
what they are supposed to do.
The form shouldn't be autocreated. Instead, create and call .Show on it in the `Initialization'
section of the form's unit and Free it in its Finalization section.
Once you've compiled the .Dpk containing the form, install it in the IDE using Install Packages.
I always write OTA stuff in a form like this and very rarely get into any major problems that need
the second-IDE-instance to investigate and resolve.
Good luck!
I have some code which i did not write, but there is a memory leak. The real strangeness is the memory only leaks if i zero a structure before returning it.
Reproducible minimum code
The leak is reproducible in Delphi 5 and Delphi 7.
First we have a structure:
type
TLocalFile = packed record
FileName: AnsiString;
end;
This structure is the private member of a CollectionItem object:
TEntry = class(TCollectionItem)
private
FLocalFile: TLocalFile;
end;
Then we have the owning collection, which has a function that can return a populated structure:
TEntries = class(TCollection)
protected
function GetLocalFile: TLocalFile;
public
procedure DoStuff;
end;
With the weirdness located in the GetLocalFile function:
function TEntries.GetLocalFile: TLocalFile;
var
s: AnsiString;
begin
//Only leaks if i initialize the returned structure
// FillChar(Result, SizeOf(Result), 0);
ZeroMemory(#Result, SizeOf(Result));
s := 'Testing Leak';
Result.Filename := s; //'Testing leak'; only leaks if i set the string through a variable
end;
In reality this function is passed a stream, and returns a populated structure, but that's not important now.
Next we have a method of the collection that will populate all it's entries's LocalFile structures:
procedure TEntries.DoStuff;
var
x: Integer;
begin
for X := 0 to Count-1 do
begin
(Items[X] as TEntry).FLocalFile := GetLocalFile;
end;
end;
Finally, we construction a collection, add 10 items to it, have them DoStuff, then free the list:
procedure TForm1.Button1Click(Sender: TObject);
var
list: TEntries;
i: Integer;
entry: TCollectionItem;
begin
list := TEntries.Create(TEntry);
try
for i := 1 to 10 do
entry := list.Add;
list.DoStuff;
finally
list.Free;
end;
end;
We created 10 items, we leak 9 AnsiStrings.
The horrifying confusing things
There are ways in which this code doesn't leak. It only leaks when using an intermediate string stack variable
Change:
function TEntries.GetLocalFile: TLocalFile;
var
s: AnsiString;
begin
s := 'Testing Leak';
Result.Filename := s; //'Testing leak'; only leaks if i set the string through a variable
end;
to
function TEntries.GetLocalFile: TLocalFile;
begin
Result.Filename := 'Testing leak'; //doesn't leak
end;
and it doesn't leak.
The other method is not to initialize the structure before returning it:
Remove the call to FillChar or ZeroMemory, and it doesn't leak:
function TEntries.GetLocalFile: TLocalFile;
var
s: AnsiString;
begin
//Only leaks if i initialize the returned structure
// FillChar(Result, SizeOf(Result), 0);
// ZeroMemory(#Result, SizeOf(Result));
s := 'Testing Leak';
Result.Filename := s; //'Testing leak'; only leaks if i set the string through a variable
end;
These are strange resolutions. Whether i use an intermediate stack variable, or not, whether i Zero the structure or not, should not have any effect on memory cleanup.
I doubt this is a bug in the compiler. Which mean that i (meaning the person who wrote this) is doing something fundamentally wrong. i assume it has something to do with TCollectionItemClass. But i cannot for the life of me figure out what.
Full code
unit FMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TLocalFile = packed record
FileName: AnsiString;
end;
TEntry = class(TCollectionItem)
private
FLocalFile: TLocalFile;
end;
TEntries = class(TCollection)
protected
function GetLocalFile: TLocalFile;
public
procedure DoStuff;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
contnrs;
procedure TForm1.Button1Click(Sender: TObject);
var
list: TEntries;
i: Integer;
entry: TCollectionItem;
begin
list := TEntries.Create(TEntry);
try
for i := 1 to 10 do
begin
entry := list.Add;
end;
list.DoStuff;
finally
list.Free;
end;
end;
{ TEntries }
procedure TEntries.DoStuff;
var
x: Integer;
entry: TEntry;
begin
for X := 0 to Count-1 do
begin
entry := Items[X] as TEntry;
entry.FLocalFile := GetLocalFile;
end;
end;
function TEntries.GetLocalFile: TLocalFile;
var
s: AnsiString;
begin
//Only leaks if i initialize the returned structure
// FillChar(Result, SizeOf(Result), 0);
ZeroMemory(#Result, SizeOf(Result));
s := 'Testing Leak';
Result.Filename := s; //'Testing leak'; only leaks if i set the string through a variable
end;
end.
Oh, and don't forget to add FastMM4 to your project (if you don't already have it built-in), so you can detect the leaks.
AnsiString (and its Unicode counterpart) is reference-counted by the compiler. You can't simply zero memory containing a reference to it; you need to assign '' to it so that the compiler will generate code to decrement the refcount and release the memory correctly.
You'll have similar problems trying to block-clear data structures containing references to dynamic arrays, Interfaces, or (some) variants.
If you're not using a Delphi version recent enough to support the Default compiler magic expression, (I believe it was introduced in D2009,) the best way to clear out a record safely would be to call Finalize first, and then zero the memory as you're doing.
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;
The following code (constructed only to demonstrate the problem) compiles and works in Delphi 2010. In Delphi 2009, compiler fails with "E2035 Not enough actual parameters".
program Project50;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(param: integer);
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
end;
a := TProc(b); // <-- [DCC Error] Project50.dpr(19): E2035 Not enough actual parameters
end.
I have found only one very ugly hack to work around the problem (a: TProc absolute b). Does anybody knows of a nicer workaround for this compiler deficiency?
[TProc field is actually hidden inside a record that can store various 'executable' code - TProcedure, TMethod and TProc. Casting is used to store specific anonymous proc into this field.]
The trick is not to do
a := TProc(b);
but
TMyProc(a) := b;
That compiles and works in D2009. Sample project attached below.
program Project51;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(var param: integer);
TStorage = record
FDelegate: TProc;
end;
var
a : TMyProc;
b : TMyProc;
param: integer;
stg : TStorage;
begin
b := procedure (var param: integer)
begin
param := 2*param;
end;
// stg.FDelegate := TMyProc(b); // doesn't compile in Delphi 2009, compiles in Delphi 2010
TMyProc(stg.FDelegate) := b;
param := 21;
TMyProc(stg.FDelegate)(param);
Writeln(param);
Readln;
end.
However, this doesn't work if casting to a local variable.
var
p: TProc;
a: TMyProc;
TMyProc(p) := a; // this will not compile
Curiouser and curiouser.
I have found a hack #2:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(param: integer);
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
Writeln('asdf');
end;
PPointer(#a)^ := PPointer(#b)^;
a;
readln;
end.
I am in doubt what are you trying to achieve by assigning TMyProc (with param argument) to TProc (without argument)?
Updated: A hack #3 (should increment ref counter, the idea is stolen from System._IntfCopy):
procedure AnonCopy(var Dest; const Source);
var
P: Pointer;
begin
P:= Pointer(Dest);
if Pointer(Source) <> nil
then IInterface(Source)._AddRef;
Pointer(Dest):= Pointer(Source);
if P <> nil then
IInterface(P)._Release;
end;
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
Writeln('asdf');
end;
AnonCopy(a, b);
// PPointer(#a)^ := PPointer(#b)^;
a;
readln;
end.
It appears that the best way would be to use generics to store the correct type of delegate in the record. No hacks required.
program Project51;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(var param: integer);
TStorage<T> = record
FDelegate: T;
end;
var
a : TMyProc;
b : TMyProc;
p : TProc;
param: integer;
stg : TStorage<TMyProc>;
begin
b := procedure (var param: integer)
begin
param := 2*param;
end;
stg.FDelegate := b;
param := 21;
stg.FDelegate(param);
Writeln(param);
Readln;
end.
I currently use a record to pass several result parameters for a function and need to add some more data as it follows:
type
TItemType = (itFile, itRegistry);
TItemDetails = record
Success: Boolean;
ItemType: TItemType;
TotalCount: Integer;
TotalSize: Int64;
List: TStringList;
end;
function DoSomething: TItemDetails;
Is it possible/advisable to use a TStringList inside a record for this specific case?
I found on Embarcadero Developer Network a class that allows to declare StringList instead of TStringList and takes care of creating and freeing the list. Would this be an advisable solution?
http://cc.embarcadero.com/Item/25670
Also, if this does indeed works, will I have to manually free the TStringList?
Yes, by all means, just be aware that if the record goes out of scope, then it looses the reference to the object (unless you add code otherwise).
I've used that StringList example you are referring too, and that works great to have a record manage the lifetime of a TStringList. You can adapt that to your usage. The key is the embedded Interface which frees the object when it goes out of scope with the record.
You can also look at Allen Bauer's Nullable record example. I included the code, but you will want to read the article (and comments) too. It uses Generics in Delphi 2009 or newer, but you can adapt it to earlier versions of Delphi. Again the key is the interface, but he takes a different approach.
unit Foo;
interface
uses Generics.Defaults, SysUtils;
type
Nullable<T> = record
private
FValue: T;
FHasValue: IInterface;
function GetValue: T;
function GetHasValue: Boolean;
public
constructor Create(AValue: T);
function GetValueOrDefault: T; overload;
function GetValueOrDefault(Default: T): T; overload;
property HasValue: Boolean read GetHasValue;
property Value: T read GetValue;
class operator NotEqual(ALeft, ARight: Nullable<T>): Boolean;
class operator Equal(ALeft, ARight: Nullable<T>): Boolean;
class operator Implicit(Value: Nullable<T>): T;
class operator Implicit(Value: T): Nullable<T>;
class operator Explicit(Value: Nullable<T>): T;
end;
procedure SetFlagInterface(var Intf: IInterface);
implementation
function NopAddref(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
function NopRelease(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
Result := E_NOINTERFACE;
end;
const
FlagInterfaceVTable: array[0..2] of Pointer =
(
#NopQueryInterface,
#NopAddref,
#NopRelease
);
FlagInterfaceInstance: Pointer = #FlagInterfaceVTable;
procedure SetFlatInterface(var Intf: IInterface);
begin
Intf := IInterface(#FlagInterfaceInstance);
end;
{ Nullable<T> }
constructor Nullable<T>.Create(AValue: T);
begin
FValue := AValue;
SetFlagInterface(FHasValue);
end;
class operator Nullable<T>.Equal(ALeft, ARight: Nullable<T>): Boolean;
var
Comparer: IEqualityComparer<T>;
begin
if ALeft.HasValue and ARight.HasValue then
begin
Comparer := TEqualityComparer<T>.Default;
Result := Comparer.Equals(ALeft.Value, ARight.Value);
end else
Result := ALeft.HasValue = ARight.HasValue;
end;
class operator Nullable<T>.Explicit(Value: Nullable<T>): T;
begin
Result := Value.Value;
end;
function Nullable<T>.GetHasValue: Boolean;
begin
Result := FHasValue <> nil;
end;
function Nullable<T>.GetValue: T;
begin
if not HasValue then
raise Exception.Create('Invalid operation, Nullable type has no value');
Result := FValue;
end;
function Nullable<T>.GetValueOrDefault: T;
begin
if HasValue then
Result := FValue
else
Result := Default(T);
end;
function Nullable<T>.GetValueOrDefault(Default: T): T;
begin
if not HasValue then
Result := Default
else
Result := FValue;
end;
class operator Nullable<T>.Implicit(Value: Nullable<T>): T;
begin
Result := Value.Value;
end;
class operator Nullable<T>.Implicit(Value: T): Nullable<T>;
begin
Result := Nullable<T>.Create(Value);
end;
class operator Nullable<T>.NotEqual(const ALeft, ARight: Nullable<T>): Boolean;
var
Comparer: IEqualityComparer<T>;
begin
if ALeft.HasValue and ARight.HasValue then
begin
Comparer := TEqualityComparer<T>.Default;
Result := not Comparer.Equals(ALeft.Value, ARight.Value);
end else
Result := ALeft.HasValue <> ARight.HasValue;
end;
end.
It will work, but you'll have to free it manually. And since records clean themselves up automatically when they go out of scope, and don't have destructors, making sure you do it right can be a hassle. You're better off not using objects in records. If you need a data type that contains objects, why not make it an object too?
Any solution for a record correctly lifetime-managing a string list object will involve an interface in one way or another. So why not return an interface from your function in the first place? Add properties to the interface, and for the consuming code it will look like record fields. It will allow you to easily add more "record fields" later on, and you can put arbitrarily complex code in the getters that return the values.
Another issue to be aware of, if you use sizeof to determine the memory footprint of the record, it will only include the size of a pointer for the TStringList. If you attempt to stream it out, the pointer which is stored will NOT be available to later instances, so you would have to ignore the pointer on the load and have another method to load the Tstringlist.
For example:
Procedure SaveRecToStream(Rec: TItemDetails ; Stream:tStream);
var
i : integer;
begin
Stream.Write(Rec,SizeOf(Rec)-SizeOf(tSTringList));
Rec.List.saveToStream(Stream);
end;
Procedure LoadRecFromStream(Rec: TItemDetails ; Stream:tStream);
var
i : integer;
begin
FillMemory(#Rec,SizeOf(Rec),0);
i := Stream.Read(rec,SizeOf(Rec)-SizeOf(tStringList));
if i <> SizeOf(Rec)-SizeOf(tStringList) then
Raise Exception.create('Unable to load record');
Rec.List := tStringlist.create;
Rec.List.LoadFromStream(Stream);
end;
This assumes that each stream contains exactly one record, and that the record variable passed to LoadRecFromStream does not contain a live tStringlist (if it was previously used it must be freed prior to the call or a leak occurs).
Why not use something like
type PStringList = ^TStringList;
type TMyFreakyRecord = record
PointerToAStringList : PStringList;
// some more code here
end;
...
var x : TMyFreakyRecord;
stringlist : TStringList;
begin
stringList := TStringlist.create;
stringList.Add('any data you wish');
x.PointertoaStringList := #stringlist;
// some more code here
end;
and access the record's string list like
procedure ProcedureThatPasses(AFreakyRecord: TFreakyRecord);
var i : integer;
begin
for i := 0 to AFreakyRecord.PointerToAStringList.count -1 do
// something with AFreakyRecord.PointerToAStringList[i];
end;
in order to transparently free the memory allocated you can create a TList variable in which you add every variable of type TStringList that is used inside a record,
var frmMain : TfrmMain;
MyJunkList : TList;
...
implementation
...
procedure clearjunk;
var i : integer;
o : TObject;
begin
for i := MyJunkList.count -1 downto 0 do begin
o := MyJunkList[i];
FreeandNil(o);
end;
MyJunkList.clear;
end;
...
initialization
MyJunkList := TList.Create;
finalization
clearjunk;
FreeAndNil(MyJunkList );
end. // end of unit
if this helps, don't hesitate to visit http://delphigeist.blogspot.com/