source: oup/current/FileClasses/_DataTypes.pas@ 238

unit _DataTypes;

interface

uses
  Classes, _TreeElement;

type
  TContainer = class;
  
  TDataField = class(TTreeElement)
      function GetChildCount: Integer; override;
      function GetChild(ID: Integer): TTreeElement; override;
      function GetCaption: String; override;
    protected
      FOffset: Integer;
      FName:   String;
      FDescription: String;
      FDataLength: Integer;
      FParentFile: TObject;
      FParentBlock: TContainer;
      FChanged: Boolean;
      FExtraArgs: array of TVarRec;
      function GetValueAsString: String; virtual;
    public
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); virtual;

      procedure Update(Offset, Length: Integer); virtual; abstract;

      property Offset: Integer read FOffset;
      property Name: String read FName;
      property Description: String read FDescription;
      property DataLength: Integer read FDataLength;
      property ValueAsString: String read GetValueAsString;
  end;

  TFieldType = class of TDataField;

  TContainer = class(TDataField)
    public
      function AddField(fieldtype: TFieldType; Name, Description: String;
          ExtraArgs: array of const): TDataField; virtual; abstract;
      procedure UpdateSize; virtual; abstract;
  end;

  TBlock = class(TContainer)
    private
      FDataFields: array of TDataField;
      function GetChildCount: Integer; override;
      function GetChild(ID: Integer): TTreeElement; override;
      function GetFieldByOffset(Offset: Integer): TDataField;
    public
      // ExtraArgs: Pointer auf Integer: BlockLength <- no longer
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
      property FieldByOffset[Offset: Integer]: TDataField read GetFieldByOffset;

      function AddField(fieldtype: TFieldType; Name, Description: String;
          ExtraArgs: array of const): TDataField; override;
      procedure UpdateSize; override;
  end;


  TInt = class(TDataField)
    private
      FInt: Integer;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: Pointer auf Integer: Bytes of TInt
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TFloat = class(TDataField)
    private
      FFloat: Single;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: none
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TBitSet = class(TDataField)
    private
      FBits: Byte;
      FNames: TStringList;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: Pointer auf TStringList
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TLevelID = class(TDataField)
    private
      FLevelID: Integer;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: keine
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TFileID = class(TDataField)
    private
      FFileID: Integer;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: keine
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TLinkByID = class(TDataField)
      function GetChildCount: Integer; override;
      function GetChild(ID: Integer): TTreeElement; override;
    private
      FFileID: Integer;
      FPosExts: String;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: Pointer auf String: Possible Exts
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TString = class(TDataField)
    private
      FString: String;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: Pointer auf Integer: Length
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TArray = class(TContainer)
    private
      FDataFields: array of TBlock;
      FTemplate: TBlock;
      FCounterSize: Integer;
      FBlockCount:  Integer;
      function GetChildCount: Integer; override;
      function GetChild(ID: Integer): TTreeElement; override;
      function GetFieldByOffset(Offset: Integer): TDataField;
    public
      // ExtraArgs:
      // 1. Integer: CounterSize (if 0 then 2. integer is required)
      // 2. Integer: BlockCount (for fixed-size arrays)
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;

      function AddField(fieldtype: TFieldType; Name, Description: String;
          ExtraArgs: array of const): TDataField; override;
      procedure SetCount; overload;
      procedure SetCount(n: Integer); overload;
      procedure UpdateSize; override;
  end;


  TRawLink = class(TDataField)
    private
      FRawAddress: Integer;
      function GetValueAsString: String; override;
    public
      // ExtraArgs: keine
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;


  TUnused = class(TDataField)
    private
      function GetValueAsString: String; override;
    public
      // ExtraArgs: Pointer auf Integer: Length
      constructor Create(ParentFile: TObject; ParentBlock: TContainer;
          Name, Description: String; ExtraArgs: array of const); override;
      procedure Update(Offset, Length: Integer); override;
  end;




implementation

uses
  SysUtils, Dialogs, _FileTypes, ConnectionManager, StrUtils;


  

{ TDataType }

constructor TDataField.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
var
  i: Integer;
begin
  if Assigned(ParentBlock) then
    FOffset := ParentBlock.Offset + ParentBlock.DataLength
  else
    FOffset := 0;
  FName := Name;
  FDescription := Description;
  FParentFile := ParentFile;
  FParentBlock := ParentBlock;
  SetLength(FExtraArgs, Length(ExtraArgs));
  if Length(ExtraArgs) > 0 then
    for i := 0 to High(ExtraArgs) do
      FExtraArgs[i] := ExtraArgs[i];
  FConnectionID := TFile(ParentFile).ConnectionID;
end;

function TDataField.GetCaption: String;
begin
  Result := FName;
end;

function TDataField.GetChild(ID: Integer): TTreeElement;
begin
  Result := nil;
end;

function TDataField.GetChildCount: Integer;
begin
  Result := 0;
end;

function TDataField.GetValueAsString: String;
begin
  Result := '';
end;

{ TString }

constructor TString.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := ExtraArgs[0].VInteger;
end;

function TString.GetValueAsString: String;
begin
  Result := FString;
end;

procedure TString.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
  i: Integer;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  SetLength(FString, FDataLength); 
  fstream.Read(FString[1], FDataLength);
  for i := 1 to FDataLength do
    if FString[i] = Chr(0) then
    begin
      SetLength(FString, i - 1);
      Break;
    end;
end;



{ TInt }

constructor TInt.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := ExtraArgs[0].VInteger;
  FInt := 0;
end;

function TInt.GetValueAsString: String;
begin
  Result := IntToStr(FInt);
end;

procedure TInt.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FInt, FDataLength);
end;



{ TArray }

function TArray.AddField(fieldtype: TFieldType;
    Name, Description: String; ExtraArgs: array of const): TDataField;
var
  i: Integer;
begin
  Result := FTemplate.AddField(fieldtype, Name, Description, ExtraArgs);
end;

constructor TArray.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FCounterSize := ExtraArgs[0].VInteger;
  if Length(ExtraArgs) = 2 then
    FBlockCount := ExtraArgs[1].VInteger
  else
    FBlockCount := 0;
  FTemplate := TBlock.Create(ParentFile, Self, '', '', []);
end;

function TArray.GetChildCount: Integer;
begin
  Result := Length(FDataFields);
end;

function TArray.GetChild(ID: Integer): TTreeElement;
begin
  Result := FDataFields[ID];
end;

function TArray.GetFieldByOffset(Offset: Integer): TDataField;
begin
  Exit;
end;

procedure TArray.SetCount;
var
  fstream: TMemoryStream;
  arr_index: Integer;
  i: Integer;

  procedure Add(DestBlock, SrcBlock: TBlock);
  var
    fid: Integer;
    field: TDataField;
    result: TDataField;
  begin
    if Length(SrcBlock.FDataFields) > 0 then
    begin
      for fid := 0 to High(SrcBlock.FDataFields) do
      begin
        field := SrcBlock.FDataFields[fid];
        result := DestBlock.AddField(TFieldType(field.ClassType), field.Name, field.Description, field.FExtraArgs);
        if result is TBlock then
          Add(TBlock(result), TBlock(field));
      end;
    end;
  end;

begin
  if FCounterSize > 0 then
  begin
    fstream := TFile(FParentFile).FileStream;
    fstream.Seek(Offset, soFromBeginning);
    FBlockCount := 0;
    fstream.Read(FBlockCount, FCounterSize);
  end;
  FDataLength := FCounterSize;
  if FBlockCount > 0 then
  begin
    for arr_index := 0 to FBlockCount - 1 do
    begin
      SetLength(FDataFields, arr_index + 1);
      FDataFields[arr_index] := TBlock.Create(FParentFile, Self,
          '[' + IntToStr(arr_index) + ']', '', []);
      Add(FDataFields[arr_index], FTemplate);
    end;
  end;
  if Pos('[', FName) > 0 then
  begin
    if Pos(']', FName) = Length(FName) then
    begin
      i := Pos('[', ReverseString(FName));
      FName := MidStr(FName, 1, Length(FName) - i);
    end;
  end;
  FName := FName + '[' + IntToStr(FBlockCount) + ']';
  FParentBlock.UpdateSize;
end;

procedure TArray.SetCount(n: Integer);
var
  fstream: TMemoryStream;
begin
  FBlockCount := n;
  if FCounterSize > 0 then
  begin
    fstream := TFile(FParentFile).FileStream;
    fstream.Seek(Offset, soFromBeginning);
    fstream.Write(FBlockCount, FCounterSize);
  end;
  SetCount;
end;

procedure TArray.Update(Offset, Length: Integer);
var
  i: Integer;
  field: TDataField;
begin
  if System.Length(FDataFields) > 0 then
  begin
    if Length > 0 then
    begin
      for i := 0 to High(FDataFields) do
      begin
        field := FDataFields[i];
        if ((field.Offset < Offset) and (field.Offset + field.DataLength > Offset + Length)) or
          ((field.Offset > Offset) and (field.Offset < Offset + Length)) or
          ((field.Offset + field.DataLength > Offset) and (field.Offset+field.DataLength < Offset + Length)) then
          field.Update(Offset, Length);
      end;
    end else begin
      for i := 0 to High(FDataFields) do
      begin
        FDataFields[i].Update(Offset, Length);
      end;
    end;
  end;
end;

procedure TArray.UpdateSize;
var
  i: Integer;
begin
  FDataLength := FCounterSize;
  if Length(FDataFields) > 0 then
    for i := 0 to High(FDataFields) do
      FDataLength := FDataLength + FDataFields[i].DataLength;
  FParentBlock.UpdateSize;
end;



{ TBlock }

function TBlock.AddField(fieldtype: TFieldType; Name,
    Description: String; ExtraArgs: array of const): TDataField;
begin
  SetLength(FDataFields, Length(FDataFields) + 1);
  FDataFields[High(FDataFields)] := TFieldType(fieldtype).Create(
      FParentFile, Self, Name, Description, ExtraArgs);
  Result := FDataFields[High(FDataFields)];
  FDataLength := FDataLength + Result.DataLength;
  if Assigned(FParentBlock) then
    FParentBlock.UpdateSize;
end;

constructor TBlock.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
end;

function TBlock.GetChild(ID: Integer): TTreeElement;
begin
  Result := FDataFields[ID];
end;

function TBlock.GetChildCount: Integer;
begin
  Result := Length(FDataFields);
end;

function TBlock.GetFieldByOffset(Offset: Integer): TDataField;
begin
  Exit;
end;

procedure TBlock.Update(Offset, Length: Integer);
var
  i: Integer;
  field: TDataField;
begin
  if System.Length(FDataFields) > 0 then
  begin
    if Length > 0 then
    begin
      for i := 0 to High(FDataFields) do
      begin
        field := FDataFields[i];
        if ((field.Offset < Offset) and (field.Offset + field.DataLength > Offset + Length)) or
          ((field.Offset > Offset) and (field.Offset < Offset + Length)) or
          ((field.Offset + field.DataLength > Offset) and (field.Offset+field.DataLength < Offset + Length)) then
          field.Update(Offset, Length);
      end;
    end else begin
      for i := 0 to High(FDataFields) do
      begin
        FDataFields[i].Update(Offset, Length);
      end;
    end;
  end;
end;

procedure TBlock.UpdateSize;
var
  i: Integer;
begin
  FDataLength := 0;
  if Length(FDataFields) > 0 then
    for i := 0 to High(FDataFields) do
      FDataLength := FDataLength + FDataFields[i].FDataLength;
  if Assigned(FParentBlock) then
    FParentBlock.UpdateSize;
end;



{ TLevelID }

constructor TLevelID.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := 4;
  FLevelID := 0;
end;

function TLevelID.GetValueAsString: String;
begin
  Result := IntToStr(FLevelID);
end;

procedure TLevelID.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FLevelID, 4);
  FLevelID := FLevelID div 256 div 256 div 256 div 2;
end;



{ TFileID }

constructor TFileID.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := 4;
  FFileID := -1;
end;

function TFileID.GetValueAsString: String;
begin
  Result := IntToStr(FFileID);
end;

procedure TFileID.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FFileID, 4);
  if FFileID > 0 then
    FFileID := FFileID div 256
  else
    FFileID := -1;
end;



{ TLinkByID }

constructor TLinkByID.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := 4;
  case ExtraArgs[0].VType of
    vtChar: FPosExts := ExtraArgs[0].VChar;
    vtAnsiString: FPosExts := String(ExtraArgs[0].VAnsiString);
  end;
  FFileID := -1;
end;

function TLinkByID.GetChild(ID: Integer): TTreeElement;
begin
  if FFileID > 0 then
    Result := ConManager.Connection[FConnectionID].MetaData.FileById[FFileID].Child[ID]
  else
    Result := nil;
end;

function TLinkByID.GetChildCount: Integer;
begin
  if FFileID > 0 then
    Result := ConManager.Connection[FConnectionID].MetaData.FileById[FFileID].ChildCount
  else
    Result := 0;
end;

function TLinkByID.GetValueAsString: String;
begin
  if FFileID >= 0 then
    Result := IntToStr(FFileID)
  else
    Result := 'unused';
end;

procedure TLinkByID.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FFileID, 4);
  if FFileID > 0 then
    FFileID := FFileID div 256
  else
    FFileID := -1;
end;



{ TRawLink }

constructor TRawLink.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := 4;
end;

function TRawLink.GetValueAsString: String;
begin
  if FRawAddress > 0 then
    Result := '0x' + IntToHex(FRawAddress, 8)
  else
    Result := 'unused';
end;

procedure TRawLink.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FRawAddress, 4);
end;



{ TUnused }

constructor TUnused.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := ExtraArgs[0].VInteger;
end;

function TUnused.GetValueAsString: String;
begin
  Result := '';
end;

procedure TUnused.Update(Offset, Length: Integer);
begin
  Exit;
end;



{ TBitSet }

constructor TBitSet.Create(ParentFile: TObject; ParentBlock: TContainer;
    Name, Description: String; ExtraArgs: array of const);
var
  i: Integer;
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FNames := TStringList.Create;
  for i := 0 to High(ExtraArgs) do
    case ExtraArgs[i].VType of
      vtChar: FNames.Add(ExtraArgs[0].VChar);
      vtAnsiString: FNames.Add(String(ExtraArgs[0].VAnsiString));
    end;
  FDataLength := 1;
  FBits := 0;
end;

function TBitSet.GetValueAsString: String;
  function IntToBits(Int: Integer): String;
  var
    i: Integer;
  begin
    Result := '';
    for i := 0 to 7 do
    begin
      Result := IntToStr(FBits and (1 shl i) shr i) + Result;
    end;
  end;
begin
  Result := IntToBits(FBits);
end;

procedure TBitSet.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FBits, FDataLength);
end;



{ TFloat }

constructor TFloat.Create(ParentFile: TObject; ParentBlock: TContainer; Name,
  Description: String; ExtraArgs: array of const);
begin
  inherited Create(ParentFile, ParentBlock, Name, Description, ExtraArgs);
  FDataLength := 4;
  FFloat := 0;
end;

function TFloat.GetValueAsString: String;
begin
  Result := FloatToStr(FFloat);
end;

procedure TFloat.Update(Offset, Length: Integer);
var
  fstream: TMemoryStream;
begin
  fstream := TFile(FParentFile).FileStream;
  fstream.Seek(FOffset, soFromBeginning);
  fstream.Read(FFloat, FDataLength);
end;


end.