PIR/PIRSQLTables.pas - master - YakuninAV/Convertors

PIR/PIRSQLTables.pas
264 строки8 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit PIRSQLTables;
{$I Synopse.inc}
interface

uses
  SysUtils, Classes,
  SynCommons, mORMot,
  PIRIntfs, PIRTypes, PIRImportConsts;

var
  SERVER_HTTP_PORT: AnsiString = '4848';

type

  /// Документ ПИР
  TPIRDocument = class(TSQLRecordTimed)
  private
    FCypher: RawUTF8;
    FDocBase: RawUTF8;
    FDocName: RawUTF8;
    FFileName: RawUTF8;
    FTables: Variant;
    FQuotations: Variant;
    FCorrections: Variant;
    FToC: Variant;
    FAllocations: Variant;
    FUserMark: RawUTF8;
    FStates: Variant;
    FState: TPIRDocumentState;
    FStateDate: TTimeLog;
    FUserMarks: TRawUTF8DynArray;
    procedure SetCypher(const Value: RawUTF8);
    procedure SetDocName(const Value: RawUTF8);
    procedure SetFileName(const Value: RawUTF8);
    procedure SetTables(const Value: Variant);
    procedure SetToC(const Value: Variant);
    procedure SetDocBase(const Value: RawUTF8);
    procedure SetCorrections(const Value: Variant);
    procedure SetQuotations(const Value: Variant);
    procedure SetAllocations(const Value: Variant);
    function AS_UNIQUE: Boolean;
    procedure SetState(const Value: TPIRDocumentState);
    procedure SetStateDate(const Value: TTimeLog);
    procedure SetStates(const Value: Variant);
    procedure SetUserMark(const Value: RawUTF8);
    procedure SetUserMarks(const Value: TRawUTF8DynArray);
  published
    /// Имя файла источника данных
    property FileName: RawUTF8 read FFileName write SetFileName stored AS_UNIQUE;
    /// Идентификатор базы документов (МРР, СБЦП, ...)
    property DocBase: RawUTF8 read FDocBase write SetDocBase;
    /// Шифр сборника
    property Cypher: RawUTF8 read FCypher write SetCypher;
    /// Наименование документа
    property DocName: RawUTF8 read FDocName write SetDocName;
    /// Состояние документа
    property State: TPIRDocumentState read FState write SetState;
    /// Дата изменения состояния
    property StateDate: TTimeLog read FStateDate write SetStateDate;
    /// Архив состояний документа
    property States: Variant read FStates write SetStates;
    /// Отметка пользователя работавшего с документом
    property UserMark: RawUTF8 read FUserMark write SetUserMark;
    /// Архив отметок пользователей работавших с документом
    property UserMarks: TRawUTF8DynArray read FUserMarks write SetUserMarks;
    /// Оглавление документа
    property ToC: Variant read FToC write SetToC;
    /// Таблицы в документе
    property Tables: Variant read FTables write SetTables;
    /// Расценки
    property Quotations: Variant read FQuotations write SetQuotations;
    /// Поправки
    property Corrections: Variant read FCorrections write SetCorrections;
    /// Рапределение стоимости
    property Allocations: Variant read FAllocations write SetAllocations;
  public
    /// Функция возвращает массив идетификаторв таблиц
    function TablesList: TRawUTF8DynArray;
    /// Функция находит по ID таблицу и, в случае успеха, возвращает JSON-документ с таблицей
    function TableByID(const ID: RawUTF8; out Table: Variant): Boolean;
    /// Функция возвращает JSON-строку с содержимым документа
    function ToJSON: RawUTF8; inline;
    /// Функция возвращает JSON-документ с содержимым документа
    function ToDoc: Variant;
    /// Функция проверяет валидность данных
    function Valid: Boolean;
  end;

  ///
  TPIRBase = class(TSQLRecord)
  private
    FBase: RawUTF8;
    FName: RawUTF8;
    FDocQty: Integer;
    procedure SetBase(const Value: RawUTF8);
    procedure SetName(const Value: RawUTF8);
    procedure SetDocQty(const Value: Integer);
  published
    property Base: RawUTF8 read FBase write SetBase stored AS_UNIQUE;
    property Name: RawUTF8 read FName write SetName;
    property DocQty: Integer read FDocQty write SetDocQty;
  end;

function CreatePIRModel: TSQLModel;

implementation

function CreatePIRModel: TSQLModel;
begin
  Result := TSQLModel.Create([TPIRDocument, TPIRBase], StringToUTF8('PIR'));
end;

{ TPIRDocument }

function TPIRDocument.AS_UNIQUE: Boolean;
begin

end;

procedure TPIRDocument.SetAllocations(const Value: Variant);
begin
  FAllocations := Value;
end;

procedure TPIRDocument.SetCorrections(const Value: Variant);
begin
  FCorrections := Value;
end;

procedure TPIRDocument.SetCypher(const Value: RawUTF8);
begin
  FCypher := Value;
end;

procedure TPIRDocument.SetDocBase(const Value: RawUTF8);
begin
  FDocBase := Value;
end;

procedure TPIRDocument.SetDocName(const Value: RawUTF8);
begin
  FDocName := Value;
end;

procedure TPIRDocument.SetFileName(const Value: RawUTF8);
begin
  FFileName := Value;
end;

procedure TPIRDocument.SetQuotations(const Value: Variant);
begin
  FQuotations := Value;
end;

procedure TPIRDocument.SetState(const Value: TPIRDocumentState);
begin
  FState := Value;
end;

procedure TPIRDocument.SetStateDate(const Value: TTimeLog);
begin
  FStateDate := Value;
end;

procedure TPIRDocument.SetStates(const Value: Variant);
begin
  FStates := Value;
end;

procedure TPIRDocument.SetTables(const Value: Variant);
begin
  FTables := Value;
end;

procedure TPIRDocument.SetToC(const Value: Variant);
begin
  FToC := Value;
end;

procedure TPIRDocument.SetUserMark(const Value: RawUTF8);
begin
  FUserMark := Value;
end;

procedure TPIRDocument.SetUserMarks(const Value: TRawUTF8DynArray);
begin
  FUserMarks := Value;
end;

function TPIRDocument.TableByID(const ID: RawUTF8; out Table: Variant): Boolean;
var p: PDocVariantData; i: Integer; r: RawUTF8;
begin
  p:=_Safe(FTables);
  Result:= (p^.Count>0) and (p^.Kind=dvArray);
  if Result then begin
    for i := 0 to p^.Count-1 do begin
      if (p^._[i].GetAsRawUTF8('id',r)) and (r=ID) then begin
        Table:= Variant(p^._[i]^);
      end;
    end;
  end;
end;

function TPIRDocument.TablesList: TRawUTF8DynArray;
var p: PDocVariantData; i:Integer; id, nm: RawUTF8;
begin
  SetLength(Result,0);
  p:=_Safe(FTables);
  if (p^.Count>0) and (p^.Kind=dvArray) then begin
    SetLength(Result,p^.Count);
    for i := Low(Result) to High(Result) do begin
      if not p^._[i].GetAsRawUTF8('id',id) then id:='';
      if not p^._[i].GetAsRawUTF8('nm',nm) then nm:='';
      Result[i]:=id+'='+nm;
    end;
  end;
end;

function TPIRDocument.ToDoc: Variant;
begin
  TDocVariant.New(Result);
  with TDocVariantData(Result) do begin
    AddValue(pirDocFileNameUTF8,FFileName);
    AddValue(pirDocBaseUTF8,FDocBase);
    AddValue(pirDocCypherUTF8,FCypher);
    AddValue(pirDocNameUTF8,FDocName);
    AddValue(pirDocToCUTF8,FToC);
    AddValue(pirDocTablesUTF8,FTables);
    AddValue(pirDocQuotationsUTF8,FQuotations);
    AddValue(pirDocCorrectionsUTF8,FCorrections);
    AddValue(pirDocAllocationsUTF8,FAllocations);
  end;
end;

function TPIRDocument.ToJSON: RawUTF8;
var v: Variant;
begin
  v:=ToDoc;
  TDocVariantData(v).ToJSON();
end;

function TPIRDocument.Valid: Boolean;
begin
  Result := (FFileName<>'') and (FCypher<>'') and (FDocBase<>'') and (FDocName<>'');
end;

{ TPIRBase }

procedure TPIRBase.SetBase(const Value: RawUTF8);
begin
  FBase := UpperCase(Value);
end;

procedure TPIRBase.SetDocQty(const Value: Integer);
begin
  FDocQty := Value;
end;

procedure TPIRBase.SetName(const Value: RawUTF8);
begin
  FName := Value;
end;

end.