Как я могу передать имя списка строк в качестве параметра

Я написал блок для сохранения нескольких списков строк. Каждый элемент 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, как я могу получить имя переменной переданного списка строк, т.е. MyStringList.

Можно ли извлечь его из стандартного переданного списка строк или мне нужно разделить список строк на подклассы и добавить свойство VariableName в список.

Возможно, мне следовало показать весь мой код. Помимо моей первоначальной проблемы, я считаю, что у меня есть код, работающий по крайней мере для отдельных TStringLists. Пока я не решил, что делать с проблемой имен, я не проверял несколько списков строк. Так что ниже полный блок.

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.

1 ответ

Решение

Экземпляр списка строк не имеет имени. Имена переменных не могут быть получены программным путем, и даже если бы они могли, переменная на сайте вызова была бы потеряна к тому времени, когда вы были внутри функции. То, что вы пытаетесь сделать, невозможно.

На мой взгляд, самое чистое, что нужно сделать - это передать в вашу функцию дополнительный аргумент, содержащий имя. Вы могли бы также использовать производный класс, который добавляет имя, но это ограничило бы потребителей этого кода для использования этого производного класса.

Глядя на ваш код, который пишет список строк, он очень сломан. Вы, кажется, пишете адреса памяти, а не содержимое памяти. Но это другая проблема.

Другие вопросы по тегам