unit AcStruc;

interface

uses
  Classes, mteTypes;

type
  TMicexObject = class
  private
    fOwner: TMicexObject;
    fName: string;
    fCaption: string;
    fDescription: string;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); virtual;
    procedure SetCaption(const aCaption: string);
    procedure ReadCaptions(var Data: PByte; const Version: Integer; const Language: string);
    function ReadCaption(var Data: PByte; const Version: Integer; const Language: string): string;
  public
    function DisplayName: string;
    property Name: string read fName;
    property Caption: string read fCaption;
    property Description: string read fDescription;
  end;

  TMicexList = class(TMicexObject)
  private
    fList: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function Count: Integer;
    function Find(const Name: string; var Index: Integer): Boolean;
    property List: TList read fList;
  end;

  TMicexEnumType = class(TMicexObject)
  private
    fConsts: TStringList;
    fSize: Integer;
    fKind: TTEEnumKind;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    constructor Create;
    destructor Destroy; override;
    function GetShortName(const Index: Integer; const Value: string = ''): string; overload;
    function GetShortName(const Value: string): string; overload;
    function GetLongName(const Index: Integer; const Value: string = ''): string; overload;
    function GetLongName(const Value: string): string; overload;
    function GetConstIndex(const Value: string): Integer;
    function GetConstCount: Integer;
    function GetConst(const Index: Integer): string;
    function GetAsText: string;
    function GetConstAndName(const Index: Integer): string;
    property Size: Integer read fSize;
    property Kind: TTEEnumKind read fKind;
  end;

  TMicexEnumTypes = class(TMicexList)
  private
    function GetEnumType(AIndex: Integer): TMicexEnumType;
    function FindType(const AName: string): TMicexEnumType;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    procedure Add(AType: TMicexEnumType);
    property Types[AIndex: Integer]: TMicexEnumType read GetEnumType; default;
  end;

  TFieldNameType = (fntNone, fntSecBoard, fntSecCode, fntUserId, fntFirmId, fntFirmUserId);

  TMicexField = class(TMicexObject)
  private
    fSize: Integer;
    fStart: Integer;
    fType: TTEFieldType;
    fIsInput: Boolean;
    fEnumType: string;
    fDefValue: string;
    fEnumPtr: TMicexEnumType;
    fNameType: TFieldNameType;
    fFlags: Integer;
    fDecimals: Integer;
    function GetIsKey: Boolean;
    function GetIsSecCode: Boolean;
    function GetIsVarBlock: Boolean;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    constructor Create(AIsInput: Boolean; AOwner: TMicexObject);
    function GetDecimalsStr: string;
    property Size: Integer read fSize;
    property Start: Integer read fStart;
    property FieldType: TTEFieldType read fType;
    property Key: Boolean read GetIsKey;
    property SecCode: Boolean read GetIsSecCode;
    property VarBlock: Boolean read GetIsVarBlock;
    property EnumType: string read fEnumType;
    property DefValue: string read fDefValue;
    property EnumPtr: TMicexEnumType read fEnumPtr;
    property NameType: TFieldNameType read fNameType;
    property Flags: Integer read fFlags;
    property Decimals: Integer read fDecimals;
  end;

  TMicexFields = class(TMicexList)
  private
    fIsInput: Boolean;
    fSumSize: Integer;
    fKeyIdx: Integer;
    function GetField(AIndex: Integer): TMicexField;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    constructor Create(AIsInput: Boolean; AOwner: TMicexObject);
    procedure Add(AField: TMicexField);
    property Fields[AIndex: Integer]: TMicexField read GetField; default;
    property IsInput: Boolean read fIsInput;
    property SumSize: Integer read fSumSize;
    property KeyIdx: Integer read fKeyIdx;
  end;

  TMicexMessage = class(TMicexObject)
  private
    fInFields: TMicexFields;
    fOutFields: TMicexFields;
    fIsTable: Boolean;
    fUpdateable: Boolean;
    fClearOnUpdate: Boolean;
    fIsOrderbook: Boolean;
    fSystemIndex: Integer;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    constructor Create(AIsTable: Boolean; AOwner: TMicexObject);
    destructor Destroy; override;
    property InFields: TMicexFields read fInFields;
    property OutFields: TMicexFields read fOutFields;
    property IsTable: Boolean read fIsTable;
    property Updateable: Boolean read fUpdateable;
    property ClearOnUpdate: Boolean read fClearOnUpdate;
    property SystemIndex: Integer read fSystemIndex;
    function IsOrderbook: Boolean;
  end;

  TMicexMessages = class(TMicexList)
  private
    fIsTable: Boolean;
    function GetMessage(AIndex: Integer): TMicexMessage;
  protected
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
  public
    constructor Create(AIsTable: Boolean; AOwner: TMicexObject);
    procedure Add(AMessage: TMicexMessage);
    property Messages[AIndex: Integer]: TMicexMessage read GetMessage; default;
    property IsTable: Boolean read fIsTable;
  end;

  TMicexIface = class(TMicexObject)
  private
    fTypes: TMicexEnumTypes;
    fTables: TMicexMessages;
    fTransactions: TMicexMessages;
    fHasDescriptions: Boolean;
    fSystemCount: Integer;
    fMsgSet: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string); override;
    property Types: TMicexEnumTypes read fTypes;
    property Tables: TMicexMessages read fTables;
    property Transactions: TMicexMessages read fTransactions;
    property HasDescriptions: Boolean read fHasDescriptions;
    property SystemCount: Integer read fSystemCount;
    property MsgSet: string read fMsgSet;
  end;

const
  SSecTable = 'SECURITIES';
  SFoSecTypeTable = 'FOSECTYPES';

implementation

uses
  SysUtils;

resourcestring
  SNoEnum = 'Перечислимый тип %s не определен';

{var
  CurEnumTypes: TMicexEnumTypes;}

function ReadInt(var Data: PByte): Integer;
begin
  Result := PInteger(Data)^;
  Inc(Data, SizeOf(Integer));
end;

function ReadStr(var Data: PByte): string;
var
  Len: Integer;
begin
  Len := ReadInt(Data);
  SetString(Result, PAnsiChar(Data), Len);
  Inc(Data, Len);
end;

{ TMicexFields }

procedure TMicexFields.Add(AField: TMicexField);
begin
  FList.Add(AField);
end;

constructor TMicexFields.Create(AIsInput: Boolean; AOwner: TMicexObject);
begin
  inherited Create;
  FOwner := AOwner;
  FIsInput := AIsInput;
end;

function TMicexFields.GetField(AIndex: Integer): TMicexField;
begin
  Result := FList.Items[AIndex];
end;

procedure TMicexFields.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  Count, SumSize, Idx: Integer;
  Fld: TMicexField;
begin
  Count := ReadInt(Data);
  SumSize := 0;
  Idx := 0;
  FKeyIdx := -1;
  while Count > 0 do
  begin
    Fld := TMicexField.Create(FIsInput, Self);
    Fld.LoadFromBuf(Data, Version, Language);
    Add(Fld);
    Fld.FStart := SumSize;
    if Fld.Key then
      FKeyIdx := Idx;
    Inc(SumSize, Fld.FSize);
    Dec(Count);
    Inc(Idx);
  end;
  FSumSize := SumSize;
end;

{ TMicexMessage }

constructor TMicexMessage.Create(AIsTable: Boolean; AOwner: TMicexObject);
begin
  inherited Create;
  FOwner := AOwner;
  FIsTable := AIsTable;
  FInFields := TMicexFields.Create(True, Self);
  FOutFields := TMicexFields.Create(False, Self);
end;

destructor TMicexMessage.Destroy;
begin
  FInFields.Free;
  FOutFields.Free;
  inherited;
end;

function TMicexMessage.IsOrderbook: Boolean;
begin
  Result := fIsOrderbook or (Name = 'ORDERBOOK') or (Name = 'QUOTEBOOK');
end;

procedure TMicexMessage.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  Flags: Integer;
begin
  FName := ReadStr(Data);
  ReadCaptions(Data, Version, Language);
  if Version and STRUCTURE_VERSION_MASK >= 2 then
    fSystemIndex := ReadInt(Data)
  else
    fSystemIndex := 0;
  if FIsTable then
  begin
    Flags := ReadInt(Data);
    FUpdateable := Flags and tfUpdateable <> 0;
    FClearOnUpdate := Flags and tfClearOnUpdate <> 0;
    FIsOrderbook := Flags and tfOrderBook <> 0;
  end;
  FInFields.LoadFromBuf(Data, Version, Language);
  if FIsTable then FOutFields.LoadFromBuf(Data, Version, Language);
end;

{ TMicexList }

function TMicexList.Count: Integer;
begin
  Result := FList.Count;
end;

constructor TMicexList.Create;
begin
  inherited;
  FList := TList.Create;
end;

destructor TMicexList.Destroy;
var
  i: Integer;
begin
  for i := 0 to fList.Count - 1 do
    TMicexObject(FList[I]).Free;
  FList.Free;
  inherited;
end;

function TMicexList.Find(const Name: string; var Index: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Count - 1 do
    if AnsiCompareText(TMicexObject(FList[I]).FName, Name) = 0 then
    begin
      Result := True;
      Index := I;
      Break;
    end;
end;

{ TMicexMessages }

procedure TMicexMessages.Add(AMessage: TMicexMessage);
begin
  FList.Add(AMessage);
end;

constructor TMicexMessages.Create(AIsTable: Boolean; AOwner: TMicexObject);
begin
  inherited Create;
  FOwner := AOwner;
  FIsTable := AIsTable;
end;

function TMicexMessages.GetMessage(AIndex: Integer): TMicexMessage;
begin
  Result := FList.Items[AIndex];
end;

procedure TMicexMessages.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  Count: Integer;
  Msg: TMicexMessage;
begin
  Count := ReadInt(Data);
  while Count > 0 do
  begin
    Msg := TMicexMessage.Create(FIsTable, Self);
    Msg.LoadFromBuf(Data, Version, Language);
    Add(Msg);
    Dec(Count);
  end;
end;

{ TMicexIface }

constructor TMicexIface.Create;
begin
  inherited Create;
  FTypes := TMicexEnumTypes.Create;
  FTypes.FOwner := Self;
  FTables := TMicexMessages.Create(True, Self);
  FTransactions := TMicexMessages.Create(False, Self);
end;

destructor TMicexIface.Destroy;
begin
  FTables.Free;
  FTransactions.Free;
  FTypes.Free;
  inherited;
end;

threadvar
  g_HasDescriptions: Boolean;

procedure TMicexIface.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);

  procedure DetectSystems(List: TMicexMessages);
  var
    i: Integer;
  begin
    for i := 0 to pred(List.Count) do
      if List[i].SystemIndex >= fSystemCount then
        fSystemCount := succ(List[i].SystemIndex);
  end;

begin
  g_HasDescriptions := False;
  fSystemCount := 0;
  FName := ReadStr(Data);
  ReadCaptions(Data, Version, Language);
  if Version and STRUCTURE_VERSION_MASK >= STRUCTURE_VERSION_4 then
    fMsgSet := ReadStr(Data);

  FTypes.LoadFromBuf(Data, Version, Language);
//  CurEnumTypes := FTypes;
  FTables.LoadFromBuf(Data, Version, Language);
  FTransactions.LoadFromBuf(Data, Version, Language);
  DetectSystems(FTables);
  DetectSystems(fTransactions);
//  CurEnumTypes := nil;
  if Version and STRUCTURE_VERSION_MASK < 2 then
    fHasDescriptions := g_HasDescriptions
  else
    fHasDescriptions := True;
end;

{ TMicexObject }

function TMicexObject.DisplayName: string;
begin
  if FCaption <> '' then Result := FCaption else
    if FName <> '' then Result := FName else
      Result := ClassName;
end;

procedure TMicexObject.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
begin

end;

function TMicexObject.ReadCaption(var Data: PByte; const Version: Integer; const Language: string): string;
var
  i, L: Integer;
  S: string;
begin
  if Version and STRUCTURE_LOCALIZATION <> 0 then begin
    L := ReadInt(Data); // number of localization constants
    for i := 0 to L - 1 do begin
      S := ReadStr(Data);
      if (i = 0) or (Copy(S, 1, 3) = Language) then Result := Copy(S, 4, MaxInt);
    end;
  end else
    Result := ReadStr(Data);
end;

procedure TMicexObject.ReadCaptions(var Data: PByte; const Version: Integer; const Language: string);
begin
  if Version and STRUCTURE_VERSION_MASK < 2 then
    SetCaption(ReadStr(Data))
  else begin
    fCaption := ReadCaption(Data, Version, Language);
    fDescription := ReadCaption(Data, Version, Language);
  end;
end;

procedure TMicexObject.SetCaption(const aCaption: string);
var
  i: Integer;
begin
  i := Pos(#0, aCaption);
  if i > 0 then
  begin
    g_HasDescriptions := True;
    fCaption := Copy(aCaption, 1, i - 1);
    fDescription := Copy(aCaption, i + 1, MaxInt);
  end
  else
    fCaption := aCaption;
end;

{ TMicexField }

constructor TMicexField.Create(AIsInput: Boolean; AOwner: TMicexObject);
begin
  inherited Create;
  FOwner := AOwner;
  FIsInput := AIsInput;
end;

function TableHasFlagField(Table: TMicexMessage): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Table.FOutFields.Count - 1 do
    if Pos('FLAG', Table.FOutFields[I].FName) > 0 then Exit;
  Result := False;
end;

function TMicexField.GetDecimalsStr: string;
begin
  Result := IntToStr(Size);
  if FieldType = ftFixed then Result := Result + '.' + IntToStr(Decimals);
end;

function TMicexField.GetIsKey: Boolean;
begin
  Result := (Flags and ffKey) <> 0;
end;

function TMicexField.GetIsSecCode: Boolean;
begin
  Result := (Flags and ffSecCode) <> 0;
end;

function TMicexField.GetIsVarBlock: Boolean;
begin
  Result := (Flags and ffVarBlock) <> 0;
end;

procedure TMicexField.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  CurEnumTypes: TMicexEnumTypes;
begin
  FName := ReadStr(Data);
  ReadCaptions(Data, Version, Language);
  FSize := ReadInt(Data);
  FType := TTEFieldType(ReadInt(Data));
  if Version and STRUCTURE_VERSION_MASK >= 2 then
    fDecimals := ReadInt(Data);
  FFlags := ReadInt(Data);
  FEnumType := ReadStr(Data);
  if Version and STRUCTURE_VERSION_MASK < 2 then
    case FType of
      ftFixed:
        begin
          if FFlags and ffFixedMask = ffFixed1 then FDecimals := 1 else
          if FFlags and ffFixedMask = ffFixed3 then FDecimals := 3 else
          if FFlags and ffFixedMask = ffFixed4 then FDecimals := 4
          else FDecimals := 2;
        end;
      ftFloat: FDecimals := -1;
    end;

  if FEnumType <> '' then
  begin
    CurEnumTypes := TMicexIface(FOwner.FOwner.FOwner.FOwner).FTypes;
    FEnumPtr := CurEnumTypes.FindType(FEnumType);
  end;
  if FIsInput then FDefValue := ReadStr(Data);

  if SecCode and not SameText(FOwner.FOwner.FName, 'SECS')
    and not SameText(FOwner.FOwner.FName, 'SECURITIES') then FNameType := fntSecCode
  else
    if SameText(FName, 'SECBOARD') or SameText(FName, 'INDEXBOARD') then
      FNameType := fntSecBoard
    else
      if ((Pos('USERID', UpperCase(FName)) > 0) or (Pos('FROMUSER', UpperCase(FName)) > 0))
        and not SameText(FOwner.FOwner.FName, 'USERS') then FNameType := fntUserId
      else
        if (Pos('FIRMID', UpperCase(FName)) > 0)
          and not SameText(FOwner.FOwner.FName, 'FIRMS') then
            FNameType := fntFirmId
        else
          if SameText(FName, 'ID') and TableHasFlagField(FOwner.FOwner as TMicexMessage) then FNameType := fntFirmUserId;
end;

{ TMicexEnumTypes }

procedure TMicexEnumTypes.Add(AType: TMicexEnumType);
begin
  FList.Add(AType);
end;

function TMicexEnumTypes.FindType(const AName: string): TMicexEnumType;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    if Types[I].FName = AName then
    begin
      Result := Types[I];
      Exit;
    end;
  raise Exception.CreateFmt(SNoEnum, [AName]);
end;

function TMicexEnumTypes.GetEnumType(AIndex: Integer): TMicexEnumType;
begin
  Result := FList.Items[AIndex];
end;

procedure TMicexEnumTypes.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  Count: Integer;
  Enm: TMicexEnumType;
begin
  Count := ReadInt(Data);
  while Count > 0 do
  begin
    Enm := TMicexEnumType.Create;
    Enm.LoadFromBuf(Data, Version, Language);
    Add(Enm);
    Dec(Count);
  end;
end;

{ TMicexEnumType }

constructor TMicexEnumType.Create;
begin
  inherited;
  FConsts := TStringList.Create;
  FConsts.CaseSensitive := True;
end;

destructor TMicexEnumType.Destroy;
begin
  FConsts.Free;
  inherited;
end;

function TMicexEnumType.GetAsText: string;
var
  I: Integer;
  S: string;
begin
  Result := '';
  for I := 0 to GetConstCount - 1 do
  begin
    S := GetConstAndName(I);
    if Result <> '' then Result := Result + '; ';
    Result := Result + S;
  end;
end;

function TMicexEnumType.GetConst(const Index: Integer): string;
begin
  if (Index >= 0) and (Index <= GetConstCount) then
    Result := Copy(FConsts[Index], 1, FSize)
  else Result := '';
end;

function TMicexEnumType.GetConstAndName(const Index: Integer): string;
begin
  if (Index >= 0) and (Index <= GetConstCount) then
    FmtStr(Result, '"%s"=%s', [GetConst(Index), GetLongName(Index)])
  else
    Result := '';
end;

function TMicexEnumType.GetConstCount: Integer;
begin
  Result := FConsts.Count;
end;

function TMicexEnumType.GetConstIndex(const Value: string): Integer;
begin
  Result := FConsts.IndexOfName(Value);
end;

function TMicexEnumType.GetLongName(const Value: string): string;
begin
  Result := GetLongName(GetConstIndex(Value), Value);
end;

function TMicexEnumType.GetLongName(const Index: Integer; const Value: string = ''): string;
var
  ZeroPos: Integer;
begin
  if (Index >= 0) and (Index < GetConstCount) then
  begin
    Result := Copy(FConsts[Index], FSize + 2, MaxInt);
    ZeroPos := Pos(#0, Result);
    if ZeroPos > 0 then Delete(Result, ZeroPos, MaxInt);
  end
  else FmtStr(Result, '<%s>', [Value]);
end;

function TMicexEnumType.GetShortName(const Value: string): string;
begin
  Result := GetShortName(GetConstIndex(Value), Value);
end;

function TMicexEnumType.GetShortName(const Index: Integer; const Value: string = ''): string;
var
  ZeroPos: Integer;
begin
  if (Index >= 0) and (Index < GetConstCount) then
  begin
    Result := Copy(FConsts[Index], FSize + 2, MaxInt);
    ZeroPos := Pos(#0, Result);
    if ZeroPos > 0 then Delete(Result, 1, ZeroPos);
  end
  else FmtStr(Result, '<%s>', [Value]);
end;

procedure TMicexEnumType.LoadFromBuf(var Data: PByte; const Version: Integer; const Language: string);
var
  Count: Integer;
begin
  FName := ReadStr(Data);
  ReadCaptions(Data, Version, Language);
  FSize := ReadInt(Data);
  FKind := TTEEnumKind(ReadInt(Data));
  Count := ReadInt(Data);
  while Count > 0 do
  begin
    if Version and STRUCTURE_VERSION_MASK < 2 then
      FConsts.Add(ReadStr(Data))
    else
      FConsts.Add(ReadStr(Data) + '=' + ReadCaption(Data, Version, Language) + #0 + ReadCaption(Data, Version, Language));
    Dec(Count);
  end;
end;

end.
