如何将字符串列表的名称作为参数传递

Question

我写了一个单元来保存多个字符串列表。每个 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.

Answer 1

字符串列表实例没有名称。无法以编程方式检索变量名称，即使可以，调用站点的变量也会在您进入函数时丢失。你试图做的事是不可能的。

在我看来，最干净的做法是将一个额外的参数传递给包含名称的函数。您同样可以使用派生的 class 添加名称，但这会限制此代码的使用者使用派生的 class。

看你写字符串列表的代码，很烂。您似乎在写内存地址而不是内存的内容。但这是一个不同的问题。

如何将字符串列表的名称作为参数传递

How can I pass the name of a stringlist as a parameter

delphi

delphi-2010