[TStringList] Problem mit einer Datei (Lädt nicht)

[marabu]

Guten Morgen,

auch die Methoden SaveToFile() und LoadFromFile() von TStrings arbeiten mit Textdateien - und mit dem Zeilentrenner CR/LF für solche Dateien. Du möchtest beliebige Zeichen (#0..#255) in deiner Datei speichern, wie man auch an deiner Musterdatei sehen kann. Kritisch sind dabei solche Zeichen wie #0 (NULL) #13 (CR) #10 (LF) und gelegentlich #26 (EOF), weil sie bei der Verarbeitung von Text als Steuerzeichen interpretiert werden.

Das Schlüsselwort PACKED kannst du mit strukturierten (record) und wiederholten (array) Feldern benutzen um die Ausrichtung einzelner Felder an Doppelwortgrenzen zu verhindern, was zwar das Laufzeitverhalten günstig beeinflusst, aber den Speicherverbrauch stark erhöht. Mir ist eine kompakte Speicherung wichtig, da ich die Matrix als Speicherblock behandeln möchte.

Wenn die Dimensionen deiner drei-dimensionalen Matrix nicht feststehen, dann musst du sie mit in die Datei schreiben, vorzugsweise als Header davor:

Delphi-Quellcode:

const
  LEVELS = 4;
  ROWS = 12;
  COLS = 12;

type
  TDimArray = array [0..3] of Byte;
  TMatrix = packed array of array of array of Byte;

procedure RedimMatrix(var m: TMatrix; dim: array of Byte);
begin
  SetLength(m, LEVELS, ROWS, COLS);
end;

procedure SaveMatrix(m: TMatrix; fn: TFileName);
var
  dwDim, dwSize: Cardinal;
begin
  dwDim := (Length(m) shl 8 + Length(m[0])) shl 8 + Length(m[0, 0]);
  dwSize := Length(m) * Length(m[0]) * Length(m[0, 0]);
  with TFileStream.Create(fn, fmCreate) do
  try
    Write(dwDim, SizeOf(dwDim));
    Write(m[0], dwSize); // korrigiert
  finally
    Free;
  end;
end;

procedure LoadMatrix(var m: TMatrix; fn: TFileName);
var
  dwDim, dwSize: Cardinal;
  dim: TDimArray absolute dwDim;
begin
  with TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite) do
  try
    Read(dwDim, SizeOf(dwDim));
    // SetLength(m, Hi(dwDim), Lo(dwDim) shr 8, dwDim and $FF); // fehlerhaft
    SetLength(m, dim[2], dim[1], dim[0]);
    dwSize := Length(m) * Length(m[0]) * Length(m[0, 0]);
    Read(m[0], dwSize); // korrigiert
  finally
    Free;
  end;
end;

{
procedure TestMatrix;  
const
  FN = 'c:\daten\dp\map.f2m';
var
  m: TMatrix;
  iLevel, iRow, iCol: Integer;
begin
  RedimMatrix(m, [LEVELS, ROWS, COLS]);
  for iLevel := Low(m) to High(m) do
    for iRow := Low(m[0]) to High(m[0]) do
      for iCol := Low(m[0, 0]) to High(m[0, 0]) do
        m[iLevel, iRow, iCol] := 48 + iLevel * 4 + iRow * iCol mod 10;
  SaveMatrix(m, fn);
  FillChar(m, SizeOf(m), 0);
  LoadMatrix(m, fn);
end;
}

procedure TestMatrix;
const
  FN = 'c:\daten\dp\map.f2m';
var
  m: TMatrix;
  iLevel, iRow, iCol: Integer;
  dwSize: Cardinal;
  okay: Boolean;
begin
  RedimMatrix(m, [LEVELS, ROWS, COLS]);
  dwSize := LEVELS * ROWS * COLS;
  for iLevel := Low(m) to High(m) do
    for iRow := Low(m[0]) to High(m[0]) do
      for iCol := Low(m[0, 0]) to High(m[0, 0]) do
        m[iLevel, iRow, iCol] := 48 + iLevel * 4 + iRow * iCol mod 10;
  SaveMatrix(m, fn);
  FillChar(m[0], dwSize, 0);
  LoadMatrix(m, fn);
  okay := True;
  for iLevel := Low(m) to High(m) do
    for iRow := Low(m[0]) to High(m[0]) do
      for iCol := Low(m[0, 0]) to High(m[0, 0]) do
        if m[iLevel, iRow, iCol] <> 48 + iLevel * 4 + iRow * iCol mod 10 then
          okay := False;
  WriteLn(IfThen(okay, 'fine', 'rats'));
end;

Freundliche Grüße