如何将字符串列表的名称作为参数传递
How can I pass the name of a stringlist as a parameter
我写了一个单元来保存多个字符串列表。每个 TStrings 项目都存储为包含文本和表示对象的整数值的记录。整体写入二进制文件。下面是写入数据的例程。
function AddToStream(Stream: TStream; Const pList: TStringList):Boolean;
Var idy: Integer;
TmpItem: tItemRec;
begin
TmpItem.pText := pList.ClassName; // Set up the Header
TmpItem.pObj := pList.Count * SizeOf(TmpItem); // Calc the # bytes for Stringlist
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write it to the Stream
for idy := 0 to plist.Count -1 do begin // Cycle through StringList
TmpItem.pText := pList[idy]; // Get the Text part
TmpItem.pObj := Integer(pList.Objects[idy]); // Get the Object part
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write record to stream
end;
end;
写入流的第一条记录旨在携带一个名称,用于标识字符串列表和后续文件中的字节数。显然在上面的代码中ClassName returns TStringList,如何获取传递的stringlist的变量名,即MyStringList。
是否可以从传递的标准字符串列表派生它,或者我是否必须对字符串列表进行子类化并向列表中添加一个变量名 属性。
也许我应该展示我所有的代码。除了我原来的问题,我相信我的代码至少适用于单个 TStringList。在我决定如何处理命名问题之前,我还没有测试过多个字符串列表。所以下面是完整的单元。
unit MultiFileUtils;
interface
Uses
System.SysUtils, System.Variants, System.Classes, Vcl.Dialogs, system.UITypes;
{This unit enables Multiple stringlist to be saved with objects to a single file
and reloaded the into the stringlists retaining their originla object value.
The stringlists you reload to should have classname as the stringlist you saved from
The data is held in a binary file, each string list has a aheader which holds
the ClassName of the stringlist and the length of the file. The text portion
of each entry in the stringlist should not exceed 255 characters.
Save functions return true if OK, AllowOverWrite doesn't check file already exists.
Read function returns true if OK, false if file not found or classname not found in file}
Function SaveLists(Const pLists: Array of TStringList; const pFileName: String; AllowOverwrite: Boolean): Boolean;
Function SaveList(Const pList: TStringList; const pFileName: String; AllowOverwrite: Boolean):Boolean;
Function ReadList(Const pFileName: String; Var pList: TStringList): Boolean;
procedure LoadTestData;
procedure SetUpTests;
procedure TestSave;
procedure TestRead;
Procedure ClearTests;
implementation
Type
tItemRec = record
pText: String[255];
pObj: Integer;
end;
{$ifDef Debug}
Var StrList1: TStringlist;
StrList2: TStringlist;
{$EndIf}
function CheckFileExists(pFileName: String):Boolean;
begin
if FileExists(pFileName) then
Result := (MessageDlg(pFileName + ' already exists, do you want to overwrite file?',
mtConfirmation, [mbYes,mbNo],0) = mrYes);
end;
function AddToStream(Stream: TStream; Const pList: TStringList):Boolean;
Var
idy: Integer;
TmpItem: tItemRec;
begin
TmpItem.pText := pList.ClassName; // Set up the Header
TmpItem.pObj := pList.Count * SizeOf(TmpItem); // Calc the # bytes for Stringlist
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write it to the Stream
for idy := 0 to plist.Count -1 do begin // Cycle through StringList
TmpItem.pText := pList[idy]; // Get the Text part
TmpItem.pObj := Integer(pList.Objects[idy]); // Get the Object part
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write record to stream
end;
end;
function SaveLists(Const pLists: Array of TStringList; Const pFileName: String;
AllowOverwrite: Boolean): Boolean;
Var
idx: Integer;
Stream: TStream;
begin
if AllowOverwrite then
Result := true
else
Result := CheckFileExists(pFileName);
if Result then begin
Stream := TFileStream.Create(pFileName, fmCreate); // Set up a fileStream
try
for idx := 0 to Length(plists) do // Loop through array of stringlists
AddToStream(Stream, pLists[idx]); // Add each Stringlist
finally
Stream.Free; // Write to disk and free Stream
end;
end;
end;
function SaveList(Const pList: TStringList; const pFileName: String;
AllowOverwrite: Boolean): Boolean;
Var
idx: Integer;
Stream: TStream;
begin
If AllowOverwrite then
result := true
else
Result := CheckFileExists(pFileName);
if Result then begin
Stream := TFileStream.Create(pFileName, fmCreate); // Set up filestream
try
AddToStream(Stream, pList); // Add Stringlist to stream
finally
Stream.Free; // Write to disk and free Stream
end;
end;
end;
function ReadList(Const pFileName: String; var pList: TStringList): Boolean;
Var idx: Integer;
Stream: TStream;
TmpItem: tItemRec;
Function NotEos: Boolean;
begin
Result := Stream.Position < Stream.Size;
end;
begin
Result := false;
if FileExists(pFileName) then begin
Stream := TFileStream.Create(pFileName, fmOpenRead);
Stream.Seek(0, soBeginning);
while NotEos do begin
if Stream.Read(TmpItem, SizeOf(TmpItem)) = SizeOf(TmpItem) then // Read Header
if TmpItem.pText = pList.ClassName then begin
Result := True; // Found header so file looks OK
idx := TmpItem.pObj; // Get the byte count
while (idx > 0) And NotEos do begin
Stream.ReadBuffer(TmpItem, SizeOf(TmpItem));
pList.AddObject(Trim(TmpItem.pText), Pointer(TmpItem.pObj));
Dec(idx);
end;
break;
end;
end;
Stream.Free;
end;
end;
{$ifDef Debug}
Procedure LoadTestData;
Var i: Integer;
begin
for i := 0 to 20 do begin
StrList1.AddObject('StrLst1 Data' + IntToStr(i), Pointer(i+1000));
StrList2.AddObject('StrLst2 Data' + IntToStr(i), pointer(i+2000));
end;
end;
procedure SetUpTests;
begin
StrList1 := TStringList.Create;
StrList2 := TStringList.Create;
LoadTestData;
end;
Procedure TestSave;
begin
SaveList(StrList1, 'MyTestFile.dat', true);
end;
Procedure TestRead;
begin
StrList1.Clear;
ReadList('MyTestFile.dat', StrList1);
end;
procedure ClearTests;
begin
StrList1.Free;
StrList2.Free;
end;
{$endif}
end.
字符串列表实例没有名称。无法以编程方式检索变量名称,即使可以,调用站点的变量也会在您进入函数时丢失。你试图做的事是不可能的。
在我看来,最干净的做法是将一个额外的参数传递给包含名称的函数。您同样可以使用派生的 class 添加名称,但这会限制此代码的使用者使用派生的 class。
看你写字符串列表的代码,很烂。您似乎在写内存地址而不是内存的内容。但这是一个不同的问题。
我写了一个单元来保存多个字符串列表。每个 TStrings 项目都存储为包含文本和表示对象的整数值的记录。整体写入二进制文件。下面是写入数据的例程。
function AddToStream(Stream: TStream; Const pList: TStringList):Boolean;
Var idy: Integer;
TmpItem: tItemRec;
begin
TmpItem.pText := pList.ClassName; // Set up the Header
TmpItem.pObj := pList.Count * SizeOf(TmpItem); // Calc the # bytes for Stringlist
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write it to the Stream
for idy := 0 to plist.Count -1 do begin // Cycle through StringList
TmpItem.pText := pList[idy]; // Get the Text part
TmpItem.pObj := Integer(pList.Objects[idy]); // Get the Object part
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write record to stream
end;
end;
写入流的第一条记录旨在携带一个名称,用于标识字符串列表和后续文件中的字节数。显然在上面的代码中ClassName returns TStringList,如何获取传递的stringlist的变量名,即MyStringList。
是否可以从传递的标准字符串列表派生它,或者我是否必须对字符串列表进行子类化并向列表中添加一个变量名 属性。
也许我应该展示我所有的代码。除了我原来的问题,我相信我的代码至少适用于单个 TStringList。在我决定如何处理命名问题之前,我还没有测试过多个字符串列表。所以下面是完整的单元。
unit MultiFileUtils;
interface
Uses
System.SysUtils, System.Variants, System.Classes, Vcl.Dialogs, system.UITypes;
{This unit enables Multiple stringlist to be saved with objects to a single file
and reloaded the into the stringlists retaining their originla object value.
The stringlists you reload to should have classname as the stringlist you saved from
The data is held in a binary file, each string list has a aheader which holds
the ClassName of the stringlist and the length of the file. The text portion
of each entry in the stringlist should not exceed 255 characters.
Save functions return true if OK, AllowOverWrite doesn't check file already exists.
Read function returns true if OK, false if file not found or classname not found in file}
Function SaveLists(Const pLists: Array of TStringList; const pFileName: String; AllowOverwrite: Boolean): Boolean;
Function SaveList(Const pList: TStringList; const pFileName: String; AllowOverwrite: Boolean):Boolean;
Function ReadList(Const pFileName: String; Var pList: TStringList): Boolean;
procedure LoadTestData;
procedure SetUpTests;
procedure TestSave;
procedure TestRead;
Procedure ClearTests;
implementation
Type
tItemRec = record
pText: String[255];
pObj: Integer;
end;
{$ifDef Debug}
Var StrList1: TStringlist;
StrList2: TStringlist;
{$EndIf}
function CheckFileExists(pFileName: String):Boolean;
begin
if FileExists(pFileName) then
Result := (MessageDlg(pFileName + ' already exists, do you want to overwrite file?',
mtConfirmation, [mbYes,mbNo],0) = mrYes);
end;
function AddToStream(Stream: TStream; Const pList: TStringList):Boolean;
Var
idy: Integer;
TmpItem: tItemRec;
begin
TmpItem.pText := pList.ClassName; // Set up the Header
TmpItem.pObj := pList.Count * SizeOf(TmpItem); // Calc the # bytes for Stringlist
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write it to the Stream
for idy := 0 to plist.Count -1 do begin // Cycle through StringList
TmpItem.pText := pList[idy]; // Get the Text part
TmpItem.pObj := Integer(pList.Objects[idy]); // Get the Object part
Stream.WriteBuffer(TmpItem, SizeOf(TmpItem)); // Write record to stream
end;
end;
function SaveLists(Const pLists: Array of TStringList; Const pFileName: String;
AllowOverwrite: Boolean): Boolean;
Var
idx: Integer;
Stream: TStream;
begin
if AllowOverwrite then
Result := true
else
Result := CheckFileExists(pFileName);
if Result then begin
Stream := TFileStream.Create(pFileName, fmCreate); // Set up a fileStream
try
for idx := 0 to Length(plists) do // Loop through array of stringlists
AddToStream(Stream, pLists[idx]); // Add each Stringlist
finally
Stream.Free; // Write to disk and free Stream
end;
end;
end;
function SaveList(Const pList: TStringList; const pFileName: String;
AllowOverwrite: Boolean): Boolean;
Var
idx: Integer;
Stream: TStream;
begin
If AllowOverwrite then
result := true
else
Result := CheckFileExists(pFileName);
if Result then begin
Stream := TFileStream.Create(pFileName, fmCreate); // Set up filestream
try
AddToStream(Stream, pList); // Add Stringlist to stream
finally
Stream.Free; // Write to disk and free Stream
end;
end;
end;
function ReadList(Const pFileName: String; var pList: TStringList): Boolean;
Var idx: Integer;
Stream: TStream;
TmpItem: tItemRec;
Function NotEos: Boolean;
begin
Result := Stream.Position < Stream.Size;
end;
begin
Result := false;
if FileExists(pFileName) then begin
Stream := TFileStream.Create(pFileName, fmOpenRead);
Stream.Seek(0, soBeginning);
while NotEos do begin
if Stream.Read(TmpItem, SizeOf(TmpItem)) = SizeOf(TmpItem) then // Read Header
if TmpItem.pText = pList.ClassName then begin
Result := True; // Found header so file looks OK
idx := TmpItem.pObj; // Get the byte count
while (idx > 0) And NotEos do begin
Stream.ReadBuffer(TmpItem, SizeOf(TmpItem));
pList.AddObject(Trim(TmpItem.pText), Pointer(TmpItem.pObj));
Dec(idx);
end;
break;
end;
end;
Stream.Free;
end;
end;
{$ifDef Debug}
Procedure LoadTestData;
Var i: Integer;
begin
for i := 0 to 20 do begin
StrList1.AddObject('StrLst1 Data' + IntToStr(i), Pointer(i+1000));
StrList2.AddObject('StrLst2 Data' + IntToStr(i), pointer(i+2000));
end;
end;
procedure SetUpTests;
begin
StrList1 := TStringList.Create;
StrList2 := TStringList.Create;
LoadTestData;
end;
Procedure TestSave;
begin
SaveList(StrList1, 'MyTestFile.dat', true);
end;
Procedure TestRead;
begin
StrList1.Clear;
ReadList('MyTestFile.dat', StrList1);
end;
procedure ClearTests;
begin
StrList1.Free;
StrList2.Free;
end;
{$endif}
end.
字符串列表实例没有名称。无法以编程方式检索变量名称,即使可以,调用站点的变量也会在您进入函数时丢失。你试图做的事是不可能的。
在我看来,最干净的做法是将一个额外的参数传递给包含名称的函数。您同样可以使用派生的 class 添加名称,但这会限制此代码的使用者使用派生的 class。
看你写字符串列表的代码,很烂。您似乎在写内存地址而不是内存的内容。但这是一个不同的问题。