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上面的代码中返回TStringList，我如何获得传递的stringlist的变量名，即MyStringList。

是否可以从传递的标准字符串列表中派生它，或者我必须将字符串列表子类化并将VariableName属性添加到列表中。

也许我应该展示我的所有代码。除了我原来的问题，我相信我的代码至少可以用于单个TStringLists。直到我决定要做什么重新命名问题我还没有测试过多个Stringlists。所以下面是完整的单位。

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

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

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

查看写入字符串列表的代码，它非常破碎。您似乎在编写内存地址而不是内存的内容。但这是一个不同的问题。

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

1 个答案: