Binary records for byterage

I havent written that much about byterage before. I think it havent made even a dent in the delphi feeds around the world, but hopefully people will have a look at it and what it can do. To make a long story short it is a system that completely abstracts you from binary storage, allowing you to use the same methods to manipulate memory buffers, files, streams and whatever. Why is this important? Because advanced operations like insert, remove, push, poll and all the other goodies you would expect from a high-level language, simply havent been added to Delphi.

For instance, what if you want to insert 40k of data in the middle of a 10 gig file? With byterage this is a single call. What if you want to remove 40k (or whatever size) from a huge file? From the top, the middle or an offset of your choice? Once again this is a single call to a byterage method and it’s done. And it doesnt care if its a memory buffer, a stream or some other storage medium. You wont believe how easy it is to work with large files. This should have been added to TStream a long time ago.

Based on this system I have created what in Visual Studio is refered to as a “property-bag”. This is immensely useful no matter what you work with, be it databases, preferences for your app, shipping data over the internet (the list goes on). Think of it as a single record where you can add fields directly, write and read values of any datatype and save the whole shabam to file, memory, stream or whatever tickles your fancy.

You can read more about byterage here

And without further a-doo i present, the memRecord.pas (note: the byterage svn repo will be updated with all files shortly, this is just a taste):

  unit memRecord;

  interface

  uses sysutils, classes, math, contnrs,
  brage, jlElfHash;

  const
  ERR_RECORDFIELD_INVALIDNAME =
  'Invalid field name [%s] error';

  ERR_RECORDFIELD_FailedSet =
  'Writing to field buffer [%s] failed error';

  ERR_RECORDFIELD_FailedGet =
  'Reading from field buffer [%s] failed error';

  ERR_RECORDFIELD_FieldIsEmpty
  = 'Record field is empty [%s] error';

  CNT_RECORD_HEADER = $ABBABABE;

  type

  EJLRecordFieldError = Class(Exception);
  EJLRecordError      = Class(Exception);

  TJLRecordField = Class(TBRBufferMemory)
  Private
    FName:      String;
    FNameHash:  Int64;
    Procedure   SetName(Value:String);
  Protected
    Function    GetDisplayName:String;virtual;
    Procedure   BeforeReadObject;override;
    Procedure   ReadObject(Reader:TReader);override;
    Procedure   WriteObject(Writer:TWriter);override;
    Procedure   DoReleaseData;override;
  Protected
    Procedure   SignalWrite;
    Procedure   SignalRead;
    procedure   SignalRelease;
  Public
    function    asString:String;virtual;abstract;
    Property    DisplayName:String read GetDisplayName;
    Property    FieldSignature:Int64 read FNameHash;
    Property    FieldName:String read FName write SetName;
  End;

  TJLFieldBoolean = Class(TJLRecordField)
  Private
    Function    GetValue:Boolean;
    Procedure   SetValue(Const NewValue:Boolean);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Boolean read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldByte = Class(TJLRecordField)
  Private
    Function    GetValue:Byte;
    Procedure   SetValue(Const NewValue:Byte);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Byte read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldCurrency = Class(TJLRecordField)
  Private
    Function    GetValue:Currency;
    Procedure   SetValue(Const NewValue:Currency);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Currency read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldData = Class(TJLRecordField)
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Function    asString:String;override;
  End;

  TJLFieldDateTime = Class(TJLRecordField)
  Private
    Function    GetValue:TDateTime;
    Procedure   SetValue(Const NewValue:TDateTime);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:TDateTime read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldDouble = Class(TJLRecordField)
  Private
    Function    GetValue:Double;
    Procedure   SetValue(Const NewValue:Double);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Double read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldGUID = Class(TJLRecordField)
  Private
    Function    GetValue:TGUID;
    Procedure   SetValue(Const NewValue:TGUID);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:TGUID read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldInteger = Class(TJLRecordField)
  Private
    Function    GetValue:Integer;
    Procedure   SetValue(Const NewValue:Integer);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Integer read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldInt64 = Class(TJLRecordField)
  Private
    Function    GetValue:Int64;
    Procedure   SetValue(Const NewValue:Int64);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Int64 read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLFieldString = Class(TJLRecordField)
  Private
    FLength:    Integer;
    FExplicit:  Boolean;
    Function    GetValue:String;
    Procedure   SetValue(NewValue:String);
    Procedure   SetFieldLength(Value:Integer);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:String read GetValue write SetValue;
    Property    Length:Integer read FLength write SetFieldLength;
    Property    Explicit:Boolean read FExplicit write FExplicit;
    Function    asString:String;override;
    Constructor Create;virtual;
  End;

  TJLFieldLong = Class(TJLRecordField)
  Private
    Function    GetValue:Longword;
    Procedure   SetValue(Const NewValue:Longword);
  Protected
    Function    GetDisplayName:String;Override;
  Public
    Property    Value:Longword read GetValue write SetValue;
    Function    asString:String;override;
  End;

  TJLRecordFieldClass = Class of TJLRecordField;
  TJLRecordFieldArray = Array of TJLRecordFieldClass;

  TJLCustomRecord = Class(TComponent)
  Private
    FObjects:   TObjectList;
    Function    GetCount:Integer;
    Function    GetItem(const Index:Integer):TJLRecordField;
    Procedure   SetItem(const Index:Integer;
                const Value:TJLRecordField);
    Function    GetField(const AName:String):TJLRecordField;
    Procedure   SetField(const AName:String;
                const Value:TJLRecordField);
  Protected
    Property    Fields[const aName:String]:TJLRecordField
                read GetField write SetField;
    Property    Items[const index:Integer]:TJLRecordField
                read GetItem write SetItem;
    Property    Count:Integer read GetCount;
  Public
    Function    Add(const aName:String;
                Const aFieldClass:TJLRecordFieldClass):TJLRecordField;
    Function    AddInteger(const aName:String):TJLFieldInteger;
    Function    AddStr(const aName:String):TJLFieldString;
    Function    AddByte(const aName:String):TJLFieldByte;
    Function    AddBool(const aName:String):TJLFieldBoolean;
    Function    AddCurrency(const aName:String):TJLFieldCurrency;
    Function    AddData(const aName:String):TJLFieldData;
    Function    AddDateTime(const aName:String):TJLFieldDateTime;
    Function    AddDouble(const aName:String):TJLFieldDouble;
    Function    AddGUID(const aName:String):TJLFieldGUID;
    Function    AddInt64(const aName:String):TJLFieldInt64;
    Function    AddLong(const aName:String):TJLFieldLong;

    Procedure   WriteInt(const aName:String;const Value:Integer);
    procedure   WriteStr(const aName:String;const Value:String);
    Procedure   WriteByte(const aName:String;const Value:Byte);
    procedure   WriteBool(const aName:String;const Value:Boolean);
    procedure   WriteCurrency(const aName:String;const Value:Currency);
    procedure   WriteData(const aName:String;const Value:TStream);
    procedure   WriteDateTime(const aName:String;const Value:TDateTime);
    procedure   WriteDouble(const aName:String;const Value:Double);
    Procedure   WriteGUID(const aName:String;const Value:TGUID);
    Procedure   WriteInt64(const aName:String;const Value:Int64);
    Procedure   WriteLong(const aName:String;const Value:Longword);

    Procedure   Clear;virtual;

    function    toStream:TStream;virtual;
    function    toBuffer:TBRBuffer;virtual;

    Procedure   SaveToStream(Const stream:TStream);virtual;
    procedure   LoadFromStream(Const stream:TStream);virtual;

    Function    IndexOf(const aName:String):Integer;
    Function    ObjectOf(const aName:String):TJLRecordField;
    Constructor Create(AOwner:TComponent);override;
    Destructor  Destroy;Override;
  End;

  TJLRecord = Class(TJLCustomRecord)
  Public
    Property  Fields;
    property  Items;
    Property  Count;
  End;

  Procedure JLRegisterRecordField(AClass:TJLRecordFieldClass);

  Function  JLRecordFieldKnown(AClass:TJLRecordFieldClass):Boolean;

  Function  JLRecordFieldClassFromName(aName:String;
            out AClass:TJLRecordFieldClass):Boolean;

  Function  JLRecordInstanceFromName(aName:String;
            out Value:TJLRecordField):Boolean;

  function JL_StrToGUID(const Value:AnsiString):TGUID;
  Function JL_GUIDToStr(const GUID:TGUID):AnsiString;

  implementation

  Var
  _FieldClasses:  TJLRecordFieldArray;

  const
  ERR_JL_InvalidGUID = '[%s] is not a valid GUID value';

  Function JL_GUIDToStr(const GUID:TGUID):AnsiString;
  begin
    SetLength(Result, 38);
    StrLFmt(@Result[1],38,'{%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x}',
    [GUID.D1, GUID.D2, GUID.D3, GUID.D4[0], GUID.D4[1], GUID.D4[2], GUID.D4[3],
    GUID.D4[4], GUID.D4[5], GUID.D4[6], GUID.D4[7]]);
  end;

  function JL_StrToGUID(const Value:AnsiString):TGUID;
  var
    i:  Integer;
    src, dest: PAnsiChar;

    function _HexChar(Const C: AnsiChar): Byte;
    begin
      case C of
        '0'..'9': Result := Byte(c) - Byte('0');
        'a'..'f': Result := (Byte(c) - Byte('a')) + 10;
        'A'..'F': Result := (Byte(c) - Byte('A')) + 10;
      else        Raise Exception.CreateFmt(ERR_JL_InvalidGUID,[Value]);
      end;
    end;

    function _HexByte(Const P:PAnsiChar): AnsiChar;
    begin
      Result:=AnsiChar((_HexChar(p[0]) shl 4)+_HexChar(p[1]));
    end;

  begin
    If Length(Value)=38 then
    Begin
      dest := @Result;
      src := PAnsiChar(Value);
      Inc(src);

      for i := 0 to 3 do
      dest[i] := _HexByte(src+(3-i)*2);

      Inc(src, 8);
      Inc(dest, 4);
      if src[0] <> '-' then
      Raise Exception.CreateFmt(ERR_JL_InvalidGUID,[Value]);

      Inc(src);
      for i := 0 to 1 do
      begin
        dest^ := _HexByte(src+2);
        Inc(dest);
        dest^ := _HexByte(src);
        Inc(dest);
        Inc(src, 4);
        if src[0] <> '-' then
        Raise Exception.CreateFmt(ERR_JL_InvalidGUID,[Value]);
        inc(src);
      end;

      dest^ := _HexByte(src);
      Inc(dest);
      Inc(src, 2);
      dest^ := _HexByte(src);
      Inc(dest);
      Inc(src, 2);
      if src[0] <> '-' then
      Raise Exception.CreateFmt(ERR_JL_InvalidGUID,[Value]);

      Inc(src);
      for i := 0 to 5 do
      begin
        dest^:=_HexByte(src);
        Inc(dest);
        Inc(src, 2);
      end;
    end else
    Raise Exception.CreateFmt(ERR_JL_InvalidGUID,[Value]);
  end;

  Procedure JLRegisterRecordField(AClass:TJLRecordFieldClass);
  var
    FLen: Integer;
  Begin
    if (AClass<>NIL)
    and (JLRecordFieldKnown(AClass)=False) then
    Begin
      FLen:=Length(_FieldClasses);
      Setlength(_FieldClasses,FLen+1);
      _FieldClasses[FLen]:=AClass;
    end;
  end;

  Function JLRecordFieldKnown(AClass:TJLRecordFieldClass):Boolean;
  var
    x:  Integer;
  Begin
    result:=AClass<>NIl;
    if result then
    Begin
      result:=Length(_FieldClasses)>0;
      If result then
      begin
        result:=False;
        for x:=low(_FieldClasses) to high(_FieldClasses) do
        Begin
          result:=_FieldClasses[x]=AClass;
          if result then
          break;
        end;
      end;
    End;
  end;

  Function JLRecordFieldClassFromName(aName:String;
            out AClass:TJLRecordFieldClass):Boolean;
  var
    x:  Integer;
  Begin
    AClass:=NIL;
    result:=Length(_FieldClasses)>0;
    If result then
    begin
      result:=False;
      for x:=low(_FieldClasses) to high(_FieldClasses) do
      Begin
        result:=_FieldClasses[x].ClassName=aName;
        If result then
        Begin
          AClass:=_FieldClasses[x];
          break;
        end;
      end;
    end;
  end;

  Function  JLRecordInstanceFromName(aName:String;
            out Value:TJLRecordField):Boolean;
  var
    FClass: TJLRecordFieldClass;
  Begin
    result:=JLRecordFieldClassFromName(aName,FClass);
    if result then
    Value:=FClass.Create;
  end;

  //##########################################################################
  // TJLCustomRecord
  //##########################################################################

  Constructor TJLCustomRecord.Create(AOwner:TComponent);
  Begin
    inherited Create(AOwner);
    FObjects:=TObjectList.Create(True);
  end;

  Destructor TJLCustomRecord.Destroy;
  Begin
    FObjects.free;
    inherited;
  end;

  Procedure TJLCustomRecord.Clear;
  Begin
    FObjects.Clear;
  end;

  function TJLCustomRecord.toStream:TStream;
  Begin
    result:=TMemoryStream.Create;
    try
      SaveToStream(result);
      result.Position:=0;
    except
      on exception do
      Begin
        FreeAndNIL(result);
        Raise;
      end;
    end;
  end;

  function TJLCustomRecord.toBuffer:TBRBuffer;
  var
    mAdapter: TBRStreamAdapter;
  Begin
    result:=TBRBufferMemory.Create;
    try
      mAdapter:=TBRStreamAdapter.Create(result);
      try
        SaveToStream(mAdapter);
      finally
        mAdapter.Free;
      end;
    except
      on exception do
      Begin
        FreeAndNIL(result);
        Raise;
      end;
    end;
  end;

  Procedure TJLCustomRecord.SaveToStream(Const stream:TStream);
  var
    x:  Integer;
    mWriter:  TWriter;
    mHead:  Longword;
  Begin
    mWriter:=TWriter.Create(stream,1024);
    try
      mHead:=CNT_RECORD_HEADER;
      mWriter.Write(mHead,SizeOf(mHead));
      mWriter.WriteInteger(FObjects.Count);
      for x:=0 to FObjects.Count-1 do
      Begin
        mWriter.WriteString(items[x].ClassName);
        items[x].WriteObject(mWriter);
      end;
    finally
      mWriter.FlushBuffer;
      mWriter.Free;
    end;
  end;

  procedure TJLCustomRecord.LoadFromStream(Const stream:TStream);
  var
    x:  Integer;
    mReader:  TReader;
    mHead:  Longword;
    mCount: Integer;
    mName:  String;
    mField: TJLRecordField;
  Begin
    Clear;
    mReader:=TReader.Create(stream,1024);
    try
      mReader.Read(mHead,SizeOf(mHead));
      if mHead=CNT_RECORD_HEADER then
      begin
        mCount:=mReader.ReadInteger;
        for x:=0 to mCount-1 do
        Begin
          mName:=mReader.ReadString;
          if memRecord.JLRecordInstanceFromName(mName,mField) then
          Begin
            self.FObjects.Add(mField);
            mField.ReadObject(mReader);
          end else
          Raise EJLRecordError.CreateFmt
          ('Unknown field class [%s] error',[mName]);
        end;
      end else
      Raise EJLRecordError.Create('Invalid record header error');
    finally
      mReader.Free;
    end;
  end;

  Procedure TJLCustomRecord.WriteInt(const aName:String;const Value:Integer);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldInteger);
    TJLFieldInteger(mRef).Value:=Value;
  end;

  procedure TJLCustomRecord.WriteStr(const aName:String;const Value:String);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldString);
    TJLFieldString(mRef).Value:=Value;
  end;

  Procedure TJLCustomRecord.WriteByte(const aName:String;const Value:Byte);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldByte);
    TJLFieldByte(mRef).Value:=Value;
  end;

  procedure TJLCustomRecord.WriteBool(const aName:String;const Value:Boolean);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldBoolean);
    TJLFieldBoolean(mRef).Value:=Value;
  end;

  procedure TJLCustomRecord.WriteCurrency(const aName:String;
            const Value:Currency);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldCurrency);
    TJLFieldCurrency(mRef).Value:=Value;
  end;

  procedure TJLCustomRecord.WriteData(const aName:String;const Value:TStream);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldData);
    if value<>NIL then
    TJLFieldData(mRef).LoadFromStream(value);
  end;

  procedure TJLCustomRecord.WriteDateTime(const aName:String;
            const Value:TDateTime);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldDateTime);
    TJLFieldDateTime(mRef).Value:=Value;
  end;

  procedure TJLCustomRecord.WriteDouble(const aName:String;
            const Value:Double);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldDouble);
    TJLFieldDouble(mRef).Value:=Value;
  end;

  Procedure TJLCustomRecord.WriteGUID(const aName:String;
            const Value:TGUID);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldGUID);
    TJLFieldGUID(mRef).Value:=Value;
  end;

  Procedure TJLCustomRecord.WriteInt64(const aName:String;
            const Value:Int64);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldInt64);
    TJLFieldInt64(mRef).Value:=Value;
  end;

  Procedure TJLCustomRecord.WriteLong(const aName:String;
            const Value:Longword);
  var
    mRef: TJLRecordField;
  Begin
    mRef:=ObjectOf(aName);
    if mRef=NIL then
    mRef:=Add(aName,TJLFieldLong);
    TJLFieldLong(mRef).Value:=Value;
  end;

  Function TJLCustomRecord.AddInteger(const aName:String):TJLFieldInteger;
  Begin
    result:=TJLFieldInteger(Add(aName,TJLFieldInteger));
  end;

  Function TJLCustomRecord.AddStr(const aName:String):TJLFieldString;
  Begin
    result:=TJLFieldString(Add(aName,TJLFieldString));
  end;

  Function TJLCustomRecord.AddByte(const aName:String):TJLFieldByte;
  Begin
    result:=TJLFieldByte(Add(aName,TJLFieldByte));
  end;

  Function TJLCustomRecord.AddBool(const aName:String):TJLFieldBoolean;
  Begin
    result:=TJLFieldBoolean(Add(aName,TJLFieldBoolean));
  end;

  Function TJLCustomRecord.AddCurrency(const aName:String):TJLFieldCurrency;
  Begin
    result:=TJLFieldCurrency(Add(aName,TJLFieldCurrency));
  end;

  Function TJLCustomRecord.AddData(const aName:String):TJLFieldData;
  Begin
    result:=TJLFieldData(Add(aName,TJLFieldData));
  end;

  Function TJLCustomRecord.AddDateTime(const aName:String):TJLFieldDateTime;
  Begin
    result:=TJLFieldDateTime(Add(aName,TJLFieldDateTime));
  end;

  Function TJLCustomRecord.AddDouble(const aName:String):TJLFieldDouble;
  Begin
    result:=TJLFieldDouble(Add(aName,TJLFieldDouble));
  end;

  Function TJLCustomRecord.AddGUID(const aName:String):TJLFieldGUID;
  Begin
    result:=TJLFieldGUID(Add(aName,TJLFieldGUID));
  end;

  Function TJLCustomRecord.AddInt64(const aName:String):TJLFieldInt64;
  Begin
    result:=TJLFieldInt64(Add(aName,TJLFieldInt64));
  end;

  Function TJLCustomRecord.AddLong(const aName:String):TJLFieldLong;
  Begin
    result:=TJLFieldLong(Add(aName,TJLFieldLong));
  end;

  Function TJLCustomRecord.Add(const aName:String;
           Const aFieldClass:TJLRecordFieldClass):TJLRecordField;
  Begin
    result:=ObjectOf(aName);
    if result=NIL then
    Begin
      if aFieldClass<>NIL then
      Begin
        Result:=aFieldClass.Create;
        Result.FieldName:=aName;
        FObjects.Add(result);
      end else
      result:=NIL;
    end;
  end;

  Function TJLCustomRecord.GetCount:Integer;
  Begin
    result:=FObjects.Count;
  end;

  Function TJLCustomRecord.GetItem(const Index:Integer):TJLRecordField;
  Begin
    result:=TJLRecordField(FObjects[index]);
  end;

  Procedure TJLCustomRecord.SetItem(const Index:Integer;
            const value:TJLRecordField);
  Begin
    TJLRecordField(FObjects[index]).Assign(Value);
  end;

  Function TJLCustomRecord.GetField(const AName:String):TJLRecordField;
  Begin
    result:=ObjectOf(aName);
  end;

  Procedure TJLCustomRecord.SetField(const AName:String;
            const Value:TJLRecordField);
  var
    FItem: TJLRecordField;
  Begin
    FItem:=ObjectOf(aName);
    If FItem<>NIL then
    FItem.assign(Value);
  end;

  Function TJLCustomRecord.IndexOf(const aName:String):Integer;
  var
    x:  integer;
  Begin
    result:=-1;
    if length(aName)>0 then
    Begin
      for x:=0 to FObjects.Count-1 do
      Begin
        if sameText(GetItem(x).FieldName,aName) then
        Begin
          result:=x;
          Break;
        end;
      end;
    end;
  end;

  Function TJLCustomRecord.ObjectOf(const aName:String):TJLRecordField;
  var
    x:      integer;
    FItem:  TJLRecordField;
  Begin
    result:=NIL;
    if length(aName)>0 then
    Begin
      for x:=0 to FObjects.Count-1 do
      Begin
        FItem:=GetItem(x);
        if sameText(FItem.FieldName,aName) then
        Begin
          result:=FItem;
          Break;
        end;
      end;
    end;
  end;

  //##########################################################################
  // TJLFieldLong
  //##########################################################################

  Function TJLFieldLong.asString:String;
  Begin
    Result:=IntToStr(Value);
  end;

  Function TJLFieldLong.GetDisplayName:String;
  Begin
    Result:='Longword';
  end;

  Function TJLFieldLong.GetValue:Longword;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldLong.SetValue(Const NewValue:Longword);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TSRLFieldInt64
  //##########################################################################

  Function TJLFieldInt64.asString:String;
  Begin
    Result:=IntToStr(Value);
  end;

  Function TJLFieldInt64.GetDisplayName:String;
  Begin
    Result:='Int64';
  end;

  Function TJLFieldInt64.GetValue:Int64;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldInt64.SetValue(Const NewValue:Int64);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldInteger
  //##########################################################################

  Function TJLFieldInteger.asString:String;
  Begin
    Result:=IntToStr(Value);
  end;

  Function TJLFieldInteger.GetDisplayName:String;
  Begin
    Result:='Integer';
  end;

  Function TJLFieldInteger.GetValue:Integer;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldInteger.SetValue(Const NewValue:Integer);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldGUID
  //##########################################################################

  Function TJLFieldGUID.asString:String;
  Begin
    Result:=String(JL_GUIDToStr(Value));
  end;

  Function TJLFieldGUID.GetDisplayName:String;
  Begin
    Result:='GUID';
  end;

  Function TJLFieldGUID.GetValue:TGUID;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldGUID.SetValue(Const NewValue:TGUID);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldDateTime
  //##########################################################################

  Function TJLFieldDateTime.asString:String;
  Begin
    Result:=DateTimeToStr(Value);
  end;

  Function TJLFieldDateTime.GetDisplayName:String;
  Begin
    Result:='DateTime';
  end;

  Function TJLFieldDateTime.GetValue:TDateTime;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldDateTime.SetValue(Const NewValue:TDateTime);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldDouble
  //##########################################################################

  Function TJLFieldDouble.asString:String;
  Begin
    Result:=FloatToStr(Value);
  end;

  Function TJLFieldDouble.GetDisplayName:String;
  Begin
    Result:='Double';
  end;

  Function TJLFieldDouble.GetValue:Double;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RecordField_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldDouble.SetValue(Const NewValue:Double);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldData
  //##########################################################################

  Function TJLFieldData.asString:String;
  Begin
    Result:='[Binary]';
  end;

  Function TJLFieldData.GetDisplayName:String;
  Begin
    Result:='Binary';
  end;

  //##########################################################################
  // TJLFieldCurrency
  //##########################################################################

  Function TJLFieldCurrency.asString:String;
  Begin
    Result:=CurrToStr(Value);
  end;

  Function TJLFieldCurrency.GetDisplayName:String;
  Begin
    Result:='Currency';
  end;

  Function TJLFieldCurrency.GetValue:Currency;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldCurrency.SetValue(Const NewValue:Currency);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldByte
  //##########################################################################

  Function TJLFieldByte.asString:String;
  Begin
    Result:=IntToStr(Value);
  end;

  Function TJLFieldByte.GetDisplayName:String;
  Begin
    Result:='Byte';
  end;

  Function TJLFieldByte.GetValue:Byte;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldByte.SetValue(Const NewValue:Byte);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldBoolean
  //##########################################################################

  Function TJLFieldBoolean.asString:String;
  Begin
    Result:=BoolToStr(Value,True);
  end;

  Function TJLFieldBoolean.GetDisplayName:String;
  Begin
    Result:='Boolean';
  end;

  Function TJLFieldBoolean.GetValue:Boolean;
  Begin
    If not Empty then
    Begin
      If Read(0,SizeOf(Result),Result)<SizeOf(Result) then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FieldIsEmpty,[FieldName]);
  end;

  Procedure TJLFieldBoolean.SetValue(Const NewValue:Boolean);
  Begin
    If Write(0,SizeOf(NewValue),NewValue)<SizeOf(NewValue) then
    Raise EJLRecordFieldError.CreateFmt
    (ERR_RECORDFIELD_FailedSet,[FieldName]) else
    SignalWrite;
  end;

  //##########################################################################
  // TJLFieldString
  //##########################################################################

  Constructor TJLFieldString.Create;
  Begin
    inherited;
    FLength:=0;
    FExplicit:=False;
  end;

  Function TJLFieldString.asString:String;
  Begin
    Result:=Value;
  end;

  Function TJLFieldString.GetDisplayName:String;
  Begin
    Result:='String';
  end;

  Procedure TJLFieldString.SetFieldLength(Value:Integer);
  Begin
    If  FExplicit
    and (Value<>FLength) then
    Begin
      Value:=math.EnsureRange(Value,0,MAXINT-1);
      If Value>0 then
      Begin
        FLength:=Value;
        If FLength<>Size then
        Size:=FLength;
      end else
      Begin
        FLength:=0;
        Release;
      end;
    end;
  end;

  Function TJLFieldString.GetValue:String;
  Begin
    If not Empty then
    Begin
      SetLength(Result,Size);
      If Read(0,Size,pointer(@Result[1])^)<Size then
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_FailedGet,[FieldName]) else
      SignalRead;
    end else
    Result:='';
  end;

  Procedure TJLFieldString.SetValue(NewValue:String);
  var
    FLen: Integer;
  Begin
    FLen:=system.Length(NewValue);
    If FLen>0 then
    Begin
      (* cut string to length if explicit *)
      If FExplicit then
      Begin
        If FLen>FLength then
        FLen:=FLength;
      end else
      Size:=FLen * SizeOf(char);

      If FLen>0 then
      Begin
        If Write(0,Size,NewValue[1])<Size then
        Raise EJLRecordFieldError.CreateFmt
        (ERR_RECORDFIELD_FailedSet,[FieldName]) else
        SignalWrite;
      end else
      Release;

    end else
    Release;
  end;

  //##########################################################################
  // TJLRecordField
  //##########################################################################

  Function TJLRecordField.GetDisplayName:String;
  Begin
    Result:='Unknown';
  end;

  Procedure TJLRecordField.SignalWrite;
  Begin
  end;

  Procedure TJLRecordField.SignalRead;
  Begin
  end;

  Procedure TJLRecordField.SignalRelease;
  Begin
  end;

  Procedure TJLRecordField.SetName(Value:String);
  Begin
    If Value<>FName then
    Begin
      Value:=trim(Value);
      If system.Length(Value)>0 then
      Begin
        FName:=Value;
        FNameHash:=TElfHash.fromString(LowerCase(Value));
      end else
      Raise EJLRecordFieldError.CreateFmt
      (ERR_RECORDFIELD_INVALIDNAME,[Value]);
    end;
  end;

  Procedure TJLRecordField.BeforeReadObject;
  Begin
    inherited;
    FName:='';
    FNameHash:=0;
  end;

  Procedure TJLRecordField.ReadObject(Reader:TReader);
  Begin
    inherited;
    FNameHash:=Reader.ReadInt64;
    FName:=Reader.ReadString;
  end;

  Procedure TJLRecordField.WriteObject(Writer:TWriter);
  Begin
    inherited;
    Writer.WriteInteger(FNameHash);
    Writer.WriteString(FName);
  end;

  Procedure TJLRecordField.DoReleaseData;
  Begin
    inherited;
    SignalRelease;
  end;

  Initialization
  Begin
    JLRegisterRecordField(TJLFieldBoolean);
    JLRegisterRecordField(TJLFieldByte);
    JLRegisterRecordField(TJLFieldCurrency);
    JLRegisterRecordField(TJLFieldData);
    JLRegisterRecordField(TJLFieldDateTime);
    JLRegisterRecordField(TJLFieldDouble);
    JLRegisterRecordField(TJLFieldGUID);
    JLRegisterRecordField(TJLFieldInt64);
    JLRegisterRecordField(TJLFieldInteger);
    JLRegisterRecordField(TJLFieldLong);
    JLRegisterRecordField(TJLFieldString);
  end;

  Finalization
  SetLength(_FieldClasses,0);

  end.