unit fileformat_ExtensionExample;

{$mode ObjFPC}{$H+}

// -----------------------------------------------------------------------------
//                                2024-09-12
//
//                     File Format Extension Example
//
//
//      If you create a binary file format, document what every byte means
//
// -----------------------------------------------------------------------------

interface

uses
  LCLType,
  Classes, Sysutils, Dialogs,
  fileformat_core;


// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
type                   // also works if we do not explicitly write "packed" here
  TFileHeaderExample = packed object (TFileHeaderCore)
    // --- optional .. Your choice ---------------------------------------------
    CreationDateTime : TDateTime;  // 8 Byte long, this is the Creation DateTime
                                   // of the Header / File itself, not the Data Blocks or anything else !
    ExampleCharArray : array[0..3] of char;
    Exampleshortint  : shortint;
    ExampleByte      : byte;
    CRC16            : word;   // crc of header only !
  end;


// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
type
  TIndexBlockExample = packed object (TDataBlockHeaderCore)
    // --- optional .. Your choice ---------------------------------------------
    ExampleCharArray : array[0..7] of char;
    ExampleLI        : longint;
    ExampleB         : byte;
    ExampleC         : char;
    // ...
    //CRC16            : word;   // crc of IndexBlock only !
    // .. or
    //CRC32            : longword;   // crc of IndexBlock only !
  end;


// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
type
  TDataBlockHeaderExample = packed object (TDataBlockHeaderCore)
    // --- optional .. Your choice ---------------------------------------------
    ExampleCharArray : array[0..7] of char;
    ExampleLI        : longint;
    ExampleB         : byte;
    ExampleC         : char;
    ExampleW         : word;
    // ...
    //CRC16            : word;   // crc of DataBlock only !
    // .. or
    //CRC32            : longword;   // crc of DataBlock only !
  end;



// ---- my example main function -----------------------------------------------

function UIcallTestWriteToDisk( FileName:string): boolean;



implementation


procedure TestWriteHeader( FileStream:TFileStream);
var
  FileHeaderExample : TFileHeaderExample;
begin
  // fill structure with data
  // --- mandatory -----------------------------------------------------------
  FileHeaderExample.MagicNumber      := 'TEST_+~#TEST';
  FileHeaderExample.VersionMajor     := 1;
  FileHeaderExample.VersionSub       := 0;
  FileHeaderExample.SizeOfHeader     := SizeOf( FileHeaderExample);
  // --- optional .. Your choice ---------------------------------------------
  FileHeaderExample.CreationDateTime := Now; //0;
  FileHeaderExample.ExampleCharArray := 'Test';
  FileHeaderExample.Exampleshortint  := -11;
  FileHeaderExample.ExampleByte      := 42;
  FileHeaderExample.CRC16            := 0;  // indeed: this is wrong ..
  // CRC16 needs to be a valid value, calculation missing here ..

  FileStream.Write( FileHeaderExample, SizeOf( FileHeaderExample));
end;



procedure TestWriteDataBlock( FileStream:TFileStream);
var
  DataBlockHeaderExample : TDataBlockHeaderExample;
begin
  // --- mandatory -----------------------------------------------------------
  DataBlockHeaderExample.MagicNumber      := 'DATAblok';
  DataBlockHeaderExample.SizeOfDataBlock  := SizeOf( DataBlockHeaderExample);  // indeed this is wrong, Data missing ..
  // --- optional .. Your choice ---------------------------------------------
  DataBlockHeaderExample.ExampleCharArray := 'abcdEFGH';
  DataBlockHeaderExample.ExampleLI        := 1002001;
  DataBlockHeaderExample.ExampleB         := 255;
  DataBlockHeaderExample.ExampleC         := 'c';
  DataBlockHeaderExample.ExampleW         := 1203;

  FileStream.Write( DataBlockHeaderExample, SizeOf( DataBlockHeaderExample));
end;



// --- optional .. Your choice .. if You need a EOF or not ---------------------
procedure TestWriteEOF( FileStream:TFileStream);
var
  EOF : array[0..3] of char;
begin
  EOF:= CONST_EOF;
  FileStream.Write( EOF, SizeOf( EOF));
end;


// -----------------------------------------------------------------------------
// --- internal main function --------------------------------------------------
// -----------------------------------------------------------------------------
function TestWriteToDisk( FileName:string): boolean;
var
  FileStream : TFileStream = NIL;
begin
  result:= false;

  FileStream:= TFileStream.Create( FileName, fmOpenWrite or fmCreate);
  try
    TestWriteHeader( FileStream);

    // IndexBlock - optional - depends on Your needs
    //TestWriteIndexBlock( FileStream);

    // just 1 DataBlock in this example - depends on Your needs
    TestWriteDataBlock( FileStream);

    // EOF - optional - Your Choice
    TestWriteEOF( FileStream);
  finally
    FileStream.Free;
    result:= true;
  end;
end;


// -----------------------------------------------------------------------------
// --- UI function -------------------------------------------------------------
// -----------------------------------------------------------------------------
function UIcallTestWriteToDisk( FileName:string): boolean;
begin
  try
    Result:= TestWriteToDisk( FileName);
  except
    //https://www.freepascal.org/docs-html/3.2.2/rtl/sysutils/index-8.html
    on E: EInOutError do
      MessageDlg( 'EInOutError', PChar(E.message), mtError, [mbOK], 0);
    on E: EFileNotFoundException do //just can't remember the extact class name for this error
      MessageDlg( 'EFileNotFoundException', PChar(E.message), mtError, [mbOK], 0);
    else ShowMEssage( 'Error');
  end;
end;


end.
