unit U_SCSClasses; interface Uses Windows, Classes, SysUtils, ComCtrls, Controls, Variants, Contnrs, idGlobal, DateUtils, RTLConsts, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, SQLMemMain, SQLMemExcept, Forms, XMLIntf, XMLDom, XMLDoc, DB, FMTBcd, U_Common_Classes, U_BaseCommon, U_SCSLists, U_FilterConfigurator{Tolik -- 19/06/2016}, U_ESCadClasess; type TBasicSCSClass = class; TComponentClass = class of TComponent; TObjectsBlobs = class; TObjectsBlob = class; TFilterInfo = class; TLineComponConnectionInfo = class; //TDataStream = class; TSCSQuery = class(TMyObject) private FOwner: TForm; FPhisicalQuery: TpFIBQuery; FMemoryQuery: TSQLMemQuery; //FRecords: TList; //FCurrRecord: TList; // properties FActive: Boolean; FQueryMode: TQueryMode; FRecordCount: Integer; FRecNo: Integer; FSQL: TStrings; // Events procedure SQLChange(Sender: TObject); protected // Setproperties procedure SetActive(Value: Boolean); procedure SetSQL(Value: TStrings); function GetRecordCount: Integer; public // Properties property Active: Boolean read FActive; property Owner: TForm read FOwner; property QueryMode: TQueryMode read FQueryMode write FQueryMode; property RecordCount: Integer read GetRecordCount; //property RecNo: Integer read FRecNo write FRecNo default -1; property SQL: TStrings read FSQL write FSQL; constructor Create(AOwner: TForm; APhisicalQuery: TpFIBQuery; AMemoryQuery: TSQLMemQuery); destructor Destroy; override; // Methods procedure ChangeProperties(AOwner: TForm; APhisicalQuery: TpFIBQuery; AMemoryQuery: TSQLMemQuery); procedure DefineQueryMode; procedure Close; function Bof: Boolean; function Eof: Boolean; procedure ExecQuery; procedure ExecMemQuery(ASQLCode: String); procedure Next; // Accessing Methods procedure SetFNAsCurrency(AFName: String; AValue: Currency); procedure SetFNAsBcd(AFName: String; AValue: TBcd); procedure SetFNAsDateTime(AFName: String; AValue: TDateTime); procedure SetFNAsDouble(AFName: String; AValue: Double); procedure SetFNAsFloat(AFName: String; AValue: Double); procedure SetFNAsInteger(AFName: String; AValue: Integer); procedure SetFNAsString(AFName: String; AValue: String); procedure SetFNAsVariant(AFName: String; AValue: Variant); procedure SetFNAsBoolean(AFName: String; AValue: Boolean); procedure SetParamAsCurrency(APName: String; AValue: Currency); procedure SetParamAsDate(APName: String; AValue: TDate); procedure SetParamAsDateTime(APName: String; AValue: TDateTime); procedure SetParamAsDouble(APName: String; AValue: Double); procedure SetParamAsFloat(APName: String; AValue: Double); procedure SetParamAsInteger(APName: String; AValue: Integer); procedure SetParamAsInteger0AsNull(APName: String; AValue: Integer); procedure SetParamAsString(APName: String; AValue: String); procedure SetParamAsTime(APName: String; AValue: TTime); procedure SetParamAsVariant(APName: String; AValue: Variant); procedure SetParamAsBoolean(APName: String; AValue: Boolean); function GetFieldIndex(AFName: String): Integer; function GetFNAsCurrency(AFName: String): Currency; function GetFNAsBcd(AFName: String): TBcd; function GetFNAsDateTime(AFName: String): TDateTime; function GetFNAsDouble(AFName: String): Double; function GetFNAsFloat(AFName: String): Double; function GetFNAsInteger(AFName: String): Integer; overload; function GetFNAsInteger(AFIndex: Integer): Integer; overload; function GetFNAsString(AFName: String): String; overload; function GetFNAsString(AFIndex: Integer): String; overload; function GetFNAsVariant(AFName: String): Variant; function GetFNAsBoolean(AFName: String): Boolean; function GetParamAsCurrency(APName: String): Currency; function GetParamAsDateTime(APName: String): TDateTime; function GetParamAsDouble(APName: String): Double; function GetParamAsFloat(APName: String): Double; function GetParamAsInteger(APName: String): Integer; function GetParamAsString(APName: String): String; function GetParamAsVariant(APName: String): Variant; function GetParamAsBoolean(APName: String): Boolean; procedure FNSaveToStream(AFName: String; AStream: TStream); procedure FNSaveToFile(AFName, AFileName: String); procedure FNLoadFromStream(AFName: String; AStream: TStream); procedure ParamSaveToStream(APName: String; AStream: TStream); procedure ParamLoadFromStream(APName: String; AStream: TStream); procedure ParamLoadFromBuffer(APName: String; var ABuffer; ABuffSize: Integer); end; //*** TBasicSCSClass TBasicSCSClass = class(TMyObject) private //FMemTable: TSQLMemTable; //FTableIndex: Integer; //FTableName: String; //17.08.2007 FQuery_Select: TSCSQuery; //FTransact_QSelect: TpFIBTransaction; //17.08.2007 FQuery_Operat: TSCSQuery; //FTransact_QOperat: TpFIBTransaction; //20.08.2007 procedure SetQueryMode(Value: TQueryMode); //20.08.2007 procedure DefineMemTable; procedure DefineQueryMode; procedure DefineQuery; {procedure QueryOptionToSelect; procedure QueryOptionToOperat;} protected FQueryMode: TQueryMode; FQSelect: TpFIBQuery; FQOperat: TpFIBQuery; FActiveForm: TForm; FParent: TBasicSCSClass; procedure SetActiveForm(Value: TForm); public SortID: Integer; constructor Create(AActiveForm: TForm); overload; //virtual; destructor Destroy; override; property ActiveForm: TForm read FActiveForm write SetActiveForm default nil; property Parent: TBasicSCSClass read FParent write FParent; property QueryMode: TQueryMode read FQueryMode write FQueryMode; //20.08.2007 procedure FreeListWithObjects(AList: TList); //20.08.2007 procedure ClearListWithObjects(AList: TList); procedure NotifyChange; end; TSCSObjectList = class(TMyObject) protected //FItems: TObjectList; FItems: TMyObjectList; FOwnsObjects: Boolean; function GetCount: Integer; function GetItem(Index: Integer): TObject; procedure SetItem(Index: Integer; AObject: TObject); public constructor Create(AOwnsObjects: Boolean); destructor Destroy; override; function Add(AObject: TObject): Integer; procedure Assign(ListA: TSCSObjectList; AOperator: TListAssignOp = laCopy; ListB: TSCSObjectList = nil); procedure AddItems(AItems: TSCSObjectList); procedure Clear; procedure Delete(Index: Integer); procedure DeleteLastCount(ACount: Integer); procedure Exchange(AIndex1, AIndex2: Integer); function IndexOf(AObject: TObject): Integer; procedure Pack; function Remove(AObject: TObject): Integer; procedure RemoveByList(AObjectList: TSCSObjectList); procedure Rotate; procedure SortBySortID; procedure SortByField(AItem: TObject; AFieldAdress: Pointer); function ToRapList: TRapList; property Count: Integer read GetCount; property Items[Index: Integer]: TObject read GetItem write SetItem; default; //property FItemList: TObjectList read FItems write FItems; //10.02.2011 property FItemList: TMyObjectList read FItems write FItems; //10.02.2011 property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects; //property List: TObjectList read FItems; property List: TMyObjectList read FItems; end; TObjectsBlobs = class(TBasicSCSClass) private FObjectsBlobs: TSCSObjectList; public property ObjectsBlobs: TSCSObjectList read FObjectsBlobs write FObjectsBlobs; procedure AddObjectsBlob(AObjectsBlob: TObjectsBlob); procedure Assign(AObjectsBlobs: TObjectsBlobs); procedure Clear; constructor Create(FActiveForm: TForm); overload; procedure DeleteObjectsBlob(AObjectsBlob: TObjectsBlob); destructor Destroy; override; end; TObjectsBlob = class(TBasicSCSClass) private FOwner: TObjectsBlobs; FID: Integer; FTableKind: integer; FObjIDs: TIntList; FDataKind: Integer; FObjectData: TMemoryStream; public property Owner: TObjectsBlobs read FOwner; property ID: Integer read FID write FID; property TableKind: integer read FTableKind write FTableKind; property ObjIDs: TIntList read FObjIDs write FObjIDs; property DataKind: Integer read FDataKind write FDataKind; property ObjectData: TMemoryStream read FObjectData write FObjectData; procedure Assign(AObjectsBlob: TObjectsBlob); procedure Clear; constructor Create(AActiveForm: TForm); overload; destructor Destroy; override; procedure LoadObjIDsFromStream(AStream: TStream); procedure SaveObjIDsToStream(AStream: TStream); procedure SaveToMemTable(AMakeEdit: TMakeEdit); procedure LoadFromMemTable; end; TFilterInfo = class(TMyObject) private FID: Integer; FFilterType: ShortInt; FFilterValue: String; FUseInCAD: Boolean; procedure SetFilterValue(Value: String); protected FFilterBlock: TFilterBlock; procedure DefineFilterBlock; public property ID: Integer read FID write FID; property FilterBlock: TFilterBlock read FFilterBlock write FFilterBlock; property FilterType: ShortInt read FFilterType write FFilterType; property FilterValue: String read FFilterValue write SetFilterValue; property UseInCAD: Boolean read FUseInCAD write FUseInCAD; constructor Create; destructor Destroy; override; end; TFilterParams = class(TMyObject) private FDBKind: TDBKind; public IsUseFilter: Boolean; FFilterBlock: TFilterBlock; FFilterType: TFilterType; FavoriteGuids: TStringList; TopGuids: TStringList; procedure Assign(AFilterParams: TFilterParams); constructor Create(ADBKind: TDBKind); destructor Destroy; override; procedure DefineIsUseFilterField; end; TUserInfo = class(TMyObject) private FID: Integer; FName: String; FPass: string; FRightsPM: Integer; FRightsNB: Integer; public property ID: Integer read FID write FID; property Name: String read FName write FName; property Pass: string read FPass write FPass; property RightsPM: Integer read FRightsPM write FRightsPM; property RightsNB: Integer read FRightsNB write FRightsNB; procedure Assign(AUserInfo: TUserInfo); procedure Clear; constructor Create; destructor Destroy; end; TUsersInfo = class(TMyObject) private FLastUserID: Integer; FLoggedUserInfo: TUserInfo; protected FUsersInfo: TObjectList; function GenUserInfoID: Integer; public function AddNewUserInfo(AName, APass: String; ARightsPM, ARightsNB: Integer): TUserInfo; procedure Clear; constructor Create; Destructor Destroy; override; function GetXML: string; function GetUserInfoByName(AName: string): TUserInfo; function IsDefAdminUser: Boolean; function LoadFromStream(AStream: TStream): Boolean; function LoadFromXML(AXml: string): Boolean; procedure SaveToStream(AStream: TStream); property LoggedUserInfo: TUserInfo read FLoggedUserInfo write FLoggedUserInfo; property UsersInfo: TObjectList read FUsersInfo; end; TTempFilesInfo = class(TMyObject) private FActive: Boolean; FFiles: TStringList; procedure SetActive(Value: Boolean); public property Active: Boolean read FActive write SetActive; property Files: TStringList read FFiles write FFiles; constructor Create; destructor Destroy; override; procedure Add(const AFile: String); function CheckIntegrity(const AMsgIfFail: String=''): Boolean; function CheckFilesIntegrity(AFiles: TStringList; const AMsgIfFail: String=''): Boolean; procedure Clear; end; TIntFieldInfo = record FieldIndex: Word; // Индекс поля FieldType: Byte; // Тип данных Value: Integer; // значение end; TFloatFieldInfo = record FieldIndex: Word; // Индекс поля FieldType: Byte; // Тип данных Value: Double; // значение end; TBuffFieldInfo = record FieldIndex: Word; // Индекс поля FieldType: Byte; // Тип данных Size: Integer; // размер в байтах end; TDataStream = class(TMyObject) private FStream: TStream; FVersion: Integer; FIsReadingBlob: Boolean; FIsReadingRecord: Boolean; FIsReadingTable: Boolean; FIsWritingRecord: Boolean; FIsWritingTable: Boolean; FIntFieldInfo: TIntFieldInfo; FIntFieldBuff: Pointer; FIntFieldBuffSize: Integer; FFloatFieldInfo: TFloatFieldInfo; FFloatFieldBuff: Pointer; FFloatFieldBuffSize: Integer; FBuffFieldInfo: TBuffFieldInfo; FSizeFieldBuff: Pointer; FSizeFieldSize: Integer; FBeginRecPos: Integer; FEndRecPos: Integer; FFieldCount: Integer; FTableName: String[255]; FTableIndex: Integer; FRecordCount: Integer; FRecordCountPos: Integer; FBeginDataPos: Integer; FSize: integer; FReadFieldIndex: Word; FReadFieldFieldType: Byte; FReadFieldSize: Integer; FReadFloatValue: Double; FReadIntValue: Integer; FReadStr: String; FWriteBuffPos: Integer; procedure AfterCreate; procedure IncCapacity; procedure SkipNoReadedBlob; private FMemoryAllocBy: Integer; public property FieldCount: integer read FFieldCount; property MemoryAllocBy: Integer read FMemoryAllocBy write FMemoryAllocBy; property ReadFieldIndex: Word read FReadFieldIndex; property ReadFieldFieldType: Byte read FReadFieldFieldType; property ReadFieldSize: Integer read FReadFieldSize; property ReadFloatValue: Double read FReadFloatValue; property ReadIntValue: Integer read FReadIntValue; property ReadStr: String read FReadStr; property RecordCount: Integer read FRecordCount; property Size: Integer read FSize; constructor Create; overload; constructor Create(const FileName: string; Mode: Word); overload; // Tolik 16/01/2020 -- //destructor Destroy; destructor Destroy; override; // procedure ReadBlobField(ADestStream: TStream); procedure ReadField; Procedure WriteFloatField(FieldIndex: Word; const Value: Double); Procedure WriteIntField(FieldIndex: Word; const Value: integer); Procedure WriteStrField(FieldIndex: Word; const Value: String); Procedure WriteStreamField(FieldIndex: Word; const Value: TStream); procedure BeginReadRecord; function BeginReadTable: Boolean; procedure BeginWriteRecord; procedure BeginWriteTable(ATableName: String; ATableIndex: integer); procedure EndReadRecord; procedure EndReadTable; procedure EndWriteRecord; procedure EndWriteTable; end; // Tolik -- 16/05/2016 -- TLineComponConnectionInfo = class(TMyObject) Protected Public ComponId: Integer; ComponSide: Integer; ComponCatalogID: Integer; ConnectedComponList: TList; isLineConnection: Boolean; PointToPointConnection: Boolean; FirstPointObject, LastPointObject: TConnectorObject; constructor Create(CanCreateList: Boolean = False); destructor Destroy; end; // procedure TComponentLoadFromFile(Component: TComponent; const AFileName: String); procedure TComponentLoadFromStream(Component: TComponent; AStream: TStream); procedure TComponentSaveToFile(Component: TComponent; const AFileName: String); procedure TComponentSaveToStream(Component: TComponent; AStream: TStream); implementation uses U_SCSComponent, U_Main, Unit_DM_SCS, U_Common, U_ProtectionCommon, U_ProtectionBase; {TSCSQuery} // ############################ Класс TSCSQuery ################################ // ############################################################################# // constructor TSCSQuery.Create(AOwner: TForm; APhisicalQuery: TpFIBQuery; AMemoryQuery: TSQLMemQuery); begin inherited create; try FMemoryQuery := nil; FPhisicalQuery := nil; inherited Create; ChangeProperties(AOwner, APhisicalQuery, AMemoryQuery); FSQL := TStringList.Create; TStringList(FSQL).OnChange := SQLChange; except on E: Exception do AddExceptionToLog('TSCSQuery.Create: '+E.Message); end; end; destructor TSCSQuery.Destroy; begin FreeAndNil(FSQL); Inherited; end; procedure TSCSQuery.SQLChange(Sender: TObject); begin {TStringList(FSQL).OnChange := nil; SQL := TStrings(Sender); TStringList(FSQL).OnChange := SQLChange;} TStringList(FSQL).OnChange := nil; //FSQL.Clear; FSQL.Text := TStrings(Sender).Text; case FQueryMode of qmPhisical: FPhisicalQuery.SQL.Text := TStrings(Sender).Text; qmMemory: begin FMemoryQuery.SQL.Text := ''; FMemoryQuery.SQL.Text := TStrings(Sender).Text; end; end; TStringList(FSQL).OnChange := SQLChange; end; procedure TSCSQuery.SetActive(Value: Boolean); begin {try if FActive = Value then Exit; ////// EXIT ////// if Value then Open else Close; except on E: Exception do AddExceptionToLog('TSCSQuery.SetActive', E.Message); end;} end; procedure TSCSQuery.SetSQL(Value: TStrings); begin //FSQL.Text := Value.Text; //FSQL.Assign(Value); case FQueryMode of qmPhisical: FPhisicalQuery.SQL.Text := Value.Text; qmMemory: FMemoryQuery.SQL.Text := Value.Text; end; end; function TSCSQuery.GetRecordCount: Integer; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.RecordCount; qmMemory: Result := FMemoryQuery.RecordCount; end; end; procedure TSCSQuery.ExecMemQuery(ASQLCode: String); var Tables: TList; QueryOparetion: TQueryOperation; IdentifyKind :TSQLIdentifyKind; SQLLength: Integer; LastPos: Integer; PuntoChars: Set of Char; SQLWords: TStringList; FieldNames: TStringList; TableNames: TStringList; Values: TStringList; FilterCommands: TStringList; TableName: String; CurrFilter: String; CanIncI: Boolean; OneWord: String; i: Integer; InProcess: Boolean; WordReady: Boolean; begin end; procedure TSCSQuery.ChangeProperties(AOwner: TForm; APhisicalQuery: TpFIBQuery; AMemoryQuery: TSQLMemQuery); begin FOwner := AOwner; // Default QueryMode by GDBMode DefineQueryMode; FPhisicalQuery := APhisicalQuery; FMemoryQuery := AMemoryQuery; //Close; end; procedure TSCSQuery.DefineQueryMode; begin if TF_Main(FOwner).GDBMode = bkNormBase then FQueryMode := qmPhisical else FQueryMode := qmMemory; end; procedure TSCSQuery.Close; begin try if FActive then FActive := false; case FQueryMode of qmPhisical: if FPhisicalQuery.Open then FPhisicalQuery.Close; qmMemory: if Assigned(FMemoryQuery) then if FMemoryQuery.Active then FMemoryQuery.Close; end; except on E: Exception do AddExceptionToLog('TSCSQuery.Close: '+E.Message); end; end; function TSCSQuery.Bof: Boolean; begin Result := false; try case FQueryMode of qmPhisical: Result := FPhisicalQuery.Bof; qmMemory: Result := FMemoryQuery.Bof; end; except on E: Exception do AddExceptionToLog('TSCSQuery.Bof: '+E.Message); end; end; function TSCSQuery.Eof: Boolean; begin Result := false; try case FQueryMode of qmPhisical: Result := FPhisicalQuery.Eof; qmMemory: Result := FMemoryQuery.Eof; end; except on E: Exception do AddExceptionToLog('TSCSQuery.Bof: '+E.Message); end; end; procedure TSCSQuery.ExecQuery; begin try //if Not FActive then // begin case FQueryMode of qmPhisical: begin FPhisicalQuery.ExecQuery; FActive := true; end; qmMemory: if TF_Main(FOwner).DM.FMemBaseActive = true then try FActive := false; FMemoryQuery.Close; FMemoryQuery.Open; //FMemoryQuery.ExecSQL; FActive := true; except on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin FMemoryQuery.Active := false; FActive := false; raise; end; end else begin FMemoryQuery.Active := false; FActive := false; raise; end; end; end; // end; except on E: Exception do AddExceptionToLog('TSCSQuery.ExcecQuery: '+E.Message); end; end; procedure TSCSQuery.Next; begin try case FQueryMode of qmPhisical: if FPhisicalQuery.Open then FPhisicalQuery.Next; qmMemory: if FMemoryQuery.Active then FMemoryQuery.Next; end; except on E: Exception do AddExceptionToLog('TSCSQuery.Next: '+E.Message); end; end; procedure TSCSQuery.SetFNAsCurrency(AFName: String; AValue: Currency); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsCurrency := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsCurrency := AValue; end; end; procedure TSCSQuery.SetFNAsBcd(AFName: String; AValue: TBcd); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsBcd := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsBcd := AValue; end; end; procedure TSCSQuery.SetFNAsDateTime(AFName: String; AValue: TDateTime); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsDateTime := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsDateTime := AValue; end; end; procedure TSCSQuery.SetFNAsDouble(AFName: String; AValue: Double); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsDouble := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsFloat := AValue; end; end; procedure TSCSQuery.SetFNAsFloat(AFName: String; AValue: Double); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsFloat := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsFloat := AValue; end; end; procedure TSCSQuery.SetFNAsInteger(AFName: String; AValue: Integer); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsInteger := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsInteger := AValue; end; end; procedure TSCSQuery.SetFNAsString(AFName: String; AValue: String); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsString := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsString := AValue; end; end; procedure TSCSQuery.SetFNAsVariant(AFName: String; AValue: Variant); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsVariant := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsVariant := AValue; end; end; procedure TSCSQuery.SetFNAsBoolean(AFName: String; AValue: Boolean); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).AsBoolean := AValue; qmMemory: FMemoryQuery.FieldByName(AFName).AsBoolean := AValue; end; end; //************************************** procedure TSCSQuery.SetParamAsCurrency(APName: String; AValue: Currency); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsCurrency := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsCurrency := AValue; end; end; procedure TSCSQuery.SetParamAsDate(APName: String; AValue: TDate); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsDate := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsDate := AValue; end; end; procedure TSCSQuery.SetParamAsDateTime(APName: String; AValue: TDateTime); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsDateTime := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsDateTime := AValue; end; end; procedure TSCSQuery.SetParamAsDouble(APName: String; AValue: Double); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsDouble := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsFloat := AValue; end; end; procedure TSCSQuery.SetParamAsFloat(APName: String; AValue: Double); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsFloat := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsFloat := AValue; end; end; procedure TSCSQuery.SetParamAsInteger(APName: String; AValue: Integer); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsInteger := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsInteger := AValue; end; end; procedure TSCSQuery.SetParamAsInteger0AsNull(APName: String; AValue: Integer); begin if AValue <> 0 then case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsInteger := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsInteger := AValue; end else SetParamAsVariant(APName, Null); end; procedure TSCSQuery.SetParamAsString(APName: String; AValue: String); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsString := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsString := AValue; end; end; procedure TSCSQuery.SetParamAsTime(APName: String; AValue: TTime); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsTime := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsTime := AValue; end; end; procedure TSCSQuery.SetParamAsVariant(APName: String; AValue: Variant); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).Value := AValue; qmMemory: FMemoryQuery.ParamByName(APName).Value := AValue; end; end; procedure TSCSQuery.SetParamAsBoolean(APName: String; AValue: Boolean); begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).AsBoolean := AValue; qmMemory: FMemoryQuery.ParamByName(APName).AsBoolean := AValue; end; end; //************************************ function TSCSQuery.GetFieldIndex(AFName: String): Integer; begin Result := -1; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).Index; qmMemory: Result := FMemoryQuery.FieldByName(AFName).Index; end; end; function TSCSQuery.GetFNAsCurrency(AFName: String): Currency; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsCurrency; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsCurrency; end; end; function TSCSQuery.GetFNAsBcd(AFName: String): TBcd; begin Result.Precision := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsBcd; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsBcd; end; end; function TSCSQuery.GetFNAsDateTime(AFName: String): TDateTime; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsDateTime; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsDateTime; end; end; function TSCSQuery.GetFNAsDouble(AFName: String): Double; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsDouble; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsFloat; end; end; function TSCSQuery.GetFNAsFloat(AFName: String): Double; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsFloat; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsFloat; end; end; function TSCSQuery.GetFNAsInteger(AFName: String): Integer; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsInteger; qmMemory: if FMemoryQuery.Fields.Count = 0 then Result := 0 else Result := FMemoryQuery.FieldByName(AFName).AsInteger; end; end; function TSCSQuery.GetFNAsInteger(AFIndex: Integer): Integer; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.Fields[AFIndex].AsInteger; qmMemory: if FMemoryQuery.Fields.Count = 0 then Result := 0 else Result := FMemoryQuery.Fields[AFIndex].AsInteger; end; end; function TSCSQuery.GetFNAsString(AFName: String): String; begin Result := ''; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsString; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsString; end; end; function TSCSQuery.GetFNAsString(AFIndex: Integer): String; begin Result := ''; case FQueryMode of qmPhisical: Result := FPhisicalQuery.Fields[AFIndex].AsString; qmMemory: Result := FMemoryQuery.Fields[AFIndex].AsString; end; end; function TSCSQuery.GetFNAsVariant(AFName: String): Variant; begin Result := ''; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsVariant; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsVariant; end; end; function TSCSQuery.GetFNAsBoolean(AFName: String): Boolean; begin Result := false; case FQueryMode of qmPhisical: Result := FPhisicalQuery.FN(AFName).AsBoolean; qmMemory: Result := FMemoryQuery.FieldByName(AFName).AsBoolean; end; end; //************************************* function TSCSQuery.GetParamAsCurrency(APName: String): Currency; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsCurrency; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsCurrency; end; end; function TSCSQuery.GetParamAsDateTime(APName: String): TDateTime; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsDateTime; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsDateTime; end; end; function TSCSQuery.GetParamAsDouble(APName: String): Double; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsDouble; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsFloat; end; end; function TSCSQuery.GetParamAsFloat(APName: String): Double; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsDouble; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsFloat; end; end; function TSCSQuery.GetParamAsInteger(APName: String): Integer; begin Result := 0; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsInteger; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsInteger; end; end; function TSCSQuery.GetParamAsString(APName: String): String; begin Result := ''; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsString; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsString; end; end; function TSCSQuery.GetParamAsVariant(APName: String): Variant; begin Result := -1; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).Value; qmMemory: Result := FMemoryQuery.ParamByName(APName).Value; end; end; function TSCSQuery.GetParamAsBoolean(APName: String): Boolean; begin Result := false; case FQueryMode of qmPhisical: Result := FPhisicalQuery.ParamByName(APName).AsBoolean; qmMemory: Result := FMemoryQuery.ParamByName(APName).AsBoolean; end; end; //********************************* procedure TSCSQuery.FNSaveToStream(AFName: String; AStream: TStream); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).SaveToStream(AStream); qmMemory: TBlobField(FMemoryQuery.FieldByName(AFName)).SaveToStream(AStream); end; end; procedure TSCSQuery.FNSaveToFile(AFName, AFileName: String); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).SaveToFile(AFileName); qmMemory: TBlobField(FMemoryQuery.FieldByName(AFName)).SaveToFile(AFileName); end; end; procedure TSCSQuery.FNLoadFromStream(AFName: String; AStream: TStream); begin case FQueryMode of qmPhisical: FPhisicalQuery.FN(AFName).LoadFromStream(AStream); qmMemory: TBlobField(FMemoryQuery.FieldByName(AFName)).LoadFromStream(AStream); end; end; procedure TSCSQuery.ParamSaveToStream(APName: String; AStream: TStream); var Buffer: Pointer; begin case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).SaveToStream(AStream); //qmMemory: TBlobField(FMemoryQuery.ParamByName(APName)).SaveToStream(AStream); qmMemory: begin AStream.Position := 0; GetMem(Buffer, AStream.Size); FMemoryQuery.ParamByName(APName).SetBlobData(Buffer, AStream.Size); FreeMem(Buffer, AStream.Size); end; end; end; procedure TSCSQuery.ParamLoadFromStream(APName: String; AStream: TStream); var StreamSize: Integer; begin if AStream = nil then Exit; //// EXIT //// AStream.Position := 0; StreamSize := AStream.Size; if StreamSize > 0 then case FQueryMode of qmPhisical: FPhisicalQuery.ParamByName(APName).LoadFromStream(AStream); //qmMemory: TBlobField(FMemoryQuery.ParamByName(APName)).LoadFromStream(AStream); qmMemory: FMemoryQuery.ParamByName(APName).LoadFromStream(AStream, ftBlob); end; end; procedure TSCSQuery.ParamLoadFromBuffer(APName: String; var ABuffer; ABuffSize: Integer); var //BuffSize: Integer; Stream: TStream; begin //BuffSize := SizeOf(ABuffer); Stream := TMemoryStream.Create; Stream.WriteBuffer(ABuffer, ABuffSize); Stream.Position := 0; ParamLoadFromStream(APName, Stream); Stream.Free; end; {TBasicSCSClass} // ####################### Класс TBasicSCSClass #################################### // ############################################################################# // constructor TBasicSCSClass.Create(AActiveForm: TForm); begin inherited Create; FParent := nil; //FMemTable := nil; //17.08.2007 //FQuery_Select := nil; //FQuery_Operat := nil; //if AActiveForm <> nil then // with TF_Main(AActiveForm).DM do // begin // FQuery_Select := TSCSQuery.Create(AActiveForm, Query_TSCSSelect, qSQL_QueryTSCSSelect); // FQuery_Operat := TSCSQuery.Create(AActiveForm, Query_TSCSOperat, qSQL_QueryTSCSOperat); // end; ActiveForm := AActiveForm; end; destructor TBasicSCSClass.Destroy; begin //17.08.2007 //FTableIndex := -1; //FTableName := ''; //if FActiveForm <> nil then //begin // FQuery_Select.Close; // FQuery_Operat.Close; // // FQuery_Select.Free; // FQuery_Operat.Free; //end; inherited; //Destroy; end; procedure TBasicSCSClass.SetActiveForm(Value: TForm); begin FActiveForm := Value; if FActiveForm <> nil then begin DefineQueryMode; DefineQuery; end; end; {20.08.2007 procedure TBasicSCSClass.SetQueryMode(Value: TQueryMode); begin FQueryMode := Value; //17.08.2007 //FQuery_Select.QueryMode := Value; //FQuery_Operat.QueryMode := Value; end;} {20.08.2007 procedure TBasicSCSClass.DefineMemTable; begin //FMemTable := nil; //FMemTable := TF_Main(ActiveForm).DM.GetSQLMemTableByIndex(FTableIndex); //FMemTable := GetSQLMemTableByName(FTableName); end; } procedure TBasicSCSClass.DefineQueryMode; begin if TF_Main(FActiveForm).GDBMode = bkNormBase then FQueryMode := qmPhisical else FQueryMode := qmMemory; end; // ##### ##### procedure TBasicSCSClass.DefineQuery; {procedure AtiveTransact(ATransaction: TpFIBTransaction); begin if TF_Main(ActiveForm).DM.Transaction_TSCSCompon.Active = false then TF_Main(ActiveForm).DM.Transaction_TSCSCompon.Active := true; end;} begin with TF_Main(ActiveForm).DM do begin { FQuery_Select.ChangeProperties(ActiveForm, Query_Select, qSQL_QuerySelect); FQuery_Operat.ChangeProperties(ActiveForm, Query_Operat, qSQL_QueryOperat); if Query_Select.Database.Connected then if TF_Main(ActiveForm).DM.Transac_QR_Select.Active = false then TF_Main(ActiveForm).DM.Transac_QR_Select.Active := true; if Query_Operat.Database.Connected then if TF_Main(ActiveForm).DM.Transac_QR_Operat.Active = false then TF_Main(ActiveForm).DM.Transac_QR_Operat.Active := true; } {17.08.2007 DefineMemTable; if Assigned(FQuery_Select) then FQuery_Select.ChangeProperties(ActiveForm, Query_TSCSSelect, qSQL_QueryTSCSSelect); if Assigned(FQuery_Operat) then FQuery_Operat.ChangeProperties(ActiveForm, Query_TSCSOperat, qSQL_QueryTSCSOperat); } FQSelect := Query_TSCSSelect; FQOperat := Query_TSCSOperat; if Assigned(Query_TSCSSelect) then if Query_TSCSSelect.Database.Connected then if TF_Main(ActiveForm).DM.Transac_TSCSSelect.Active = false then TF_Main(ActiveForm).DM.Transac_TSCSSelect.Active := true; if Assigned(Query_TSCSSelect) then if Query_TSCSOperat.Database.Connected then if TF_Main(ActiveForm).DM.Transac_TSCSOperat.Active = false then TF_Main(ActiveForm).DM.Transac_TSCSOperat.Active := true; end; end; {20.08.2007 procedure TBasicSCSClass.ClearListWithObjects(AList: TList); var i: Integer; ListObject: TObject; begin if AList = nil then Exit; ///// EXIT ///// for i := 0 to AList.Count - 1 do begin ListObject := AList.items[i]; if Listobject <> nil then begin FreeAndNil(ListObject); //FreeAndNil(ListObject^); AList.items[i] := nil; end; end; AList.Clear; end;} {20.08.2007 procedure TBasicSCSClass.FreeListWithObjects(AList: TList); var i: Integer; ListObject: TObject; begin if AList = nil then Exit; ///// EXIT ///// for i := 0 to AList.Count - 1 do begin ListObject := AList.items[i]; if ListObject <> nil then begin FreeAndNil(ListObject); AList.items[i] := nil; end; end; FreeAndNil(AList); end;} procedure TBasicSCSClass.NotifyChange; begin if FActiveForm <> nil then if (TF_Main(FActiveForm).GDBMode = bkProjectManager) and ((FQueryMode = qmMemory) or ((Self is TSCSCatalog) and (TSCSCatalog(Self).ItemType = itProject))) then begin if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(true); end; end; { procedure TBasicSCSClass.QueryOptionToOperat; begin FQuery.Close; FQuery.Options := FQuery.Options + [ qoStartTransaction, qoAutoCommit]; FQuery.Transaction.Active := true; end; procedure TBasicSCSClass.QueryOptionToSelect; begin FQuery.Close; FQuery.GoToFirstRecordOnExecute := true; FQuery.Options := FQuery.Options - [ qoStartTransaction, qoAutoCommit]; FQuery.Transaction.Active := true; end; } {TSCSObjectList} // ####################### Класс TSCSObjectList #################################### // ############################################################################# // constructor TSCSObjectList.Create(AOwnsObjects: Boolean); begin inherited Create; //FItems := TObjectList.Create(false); FItems := TMyObjectList.Create(false); FOwnsObjects := AOwnsObjects; end; destructor TSCSObjectList.Destroy; begin // Tolik 16/12/2019 -- if FOwnsObjects then Clear; FreeAndNil(FItems); //Tolik inherited; // end; // Tolik 16/12/2019 -- function TSCSObjectList.Add(AObject: TObject): Integer; begin Result := FItems.Add(AObject); end; {function TSCSObjectList.Add(AObject: TObject): Integer; begin Result := FItems.Add(AObject); end;} // procedure TSCSObjectList.Assign(ListA: TSCSObjectList; AOperator: TListAssignOp = laCopy; ListB: TSCSObjectList = nil); //var LAItems: TObjectList; // LBItems: TObjectList; var LAItems: TMyObjectList; LBItems: TMyObjectList; begin LAItems := nil; LBItems := nil; if Assigned(ListA) then LAItems := ListA.FItems; if Assigned(ListB) then LBItems := ListB.FItems; FItems.Assign(LAItems, AOperator, LBItems); end; procedure TSCSObjectList.AddItems(AItems: TSCSObjectList); var i: Integer; begin if Assigned(AItems) then for i := 0 to AItems.Count - 1 do FItems.Add(AItems.FItems[i]); end; procedure TSCSObjectList.Clear; var i: Integer; DelObject: TObject; // Tolik 17/12/2019 -- //BufList: TObjectList; BufList: TMyObjectList; // begin if FItems.Count > 0 then //Tolik 19/11/2019 -- begin if FOwnsObjects then begin //BufList := TObjectList.Create(false); BufList := TMyObjectList.Create(false); BufList.Assign(FItems); i := 0; while i <= BufList.Count - 1 do begin DelObject := BufList[i]; if Assigned(DelObject) then begin FreeAndNil(DelObject); BufList[i] := nil; //FItems[i] := nil; end; Inc(i); end; //for i := 0 to BufList.Count - 1 do //begin // DelObject := BufList[i]; // if Assigned(DelObject) then // begin // FreeAndNil(DelObject); // BufList[i] := nil; // //FItems[i] := nil; // end; //end; FreeAndNil(BufList); end; FItems.Clear; end; end; procedure TSCSObjectList.Delete(Index: Integer); begin FItems.Delete(Index); end; procedure TSCSObjectList.DeleteLastCount(ACount: Integer); var LastCount: Integer; begin LastCount := ACount; if LastCount > FItems.Count then LastCount := FItems.Count; while LastCount > 0 do begin FItems.Delete(FItems.Count - 1); Dec(LastCount); end; end; function TSCSObjectList.GetItem(Index: Integer): TObject; begin Result := FItems[Index]; end; procedure TSCSObjectList.Exchange(AIndex1, AIndex2: Integer); var TempObject: TObject; begin //FItems.Move(AIndex1, AIndex2); TempObject := FItems[AIndex1]; FItems[AIndex1] := FItems[AIndex2]; FItems[AIndex2] := TempObject; end; function TSCSObjectList.IndexOf(AObject: TObject): Integer; var i: Integer; begin Result := -1; for i := 0 to FItems.Count - 1 do if FItems.List^[i] = AObject then begin Result := i; Break; //// BREAK //// end; end; procedure TSCSObjectList.Pack; begin FItems.Pack; end; function TSCSObjectList.Remove(AObject: TObject): Integer; begin Result := FItems.Remove(AObject); end; procedure TSCSObjectList.RemoveByList(AObjectList: TSCSObjectList); var i: Integer; begin for i := 0 to AObjectList.Count - 1 do Remove(AObjectList[i]); end; procedure TSCSObjectList.Rotate; var BuffItems: TObjectList; i: Integer; begin BuffItems := TObjectList.Create(false); BuffItems.Assign(FItems); for i := 0 to BuffItems.Count - 1 do FItems[i] := BuffItems[BuffItems.Count-1 - i]; FreeAndNil(BuffItems); end; procedure TSCSObjectList.SetItem(Index: Integer; AObject: TObject); begin FItems[Index] := AObject; end; procedure TSCSObjectList.SortBySortID; var i, j: Integer; LastMaxSortID: Integer; ObjectI: TObject; ObjectJ: TObject; begin LastMaxSortID := -1; for i := 0 to FItems.Count - 1 do begin ObjectI := FItems.List^[i]; if Assigned(ObjectI) then if ObjectI is TBasicSCSClass then for j := i to FItems.Count - 1 do begin ObjectJ := FItems.List^[j]; if Assigned(ObjectJ) then if TBasicSCSClass(ObjectJ).SortID < TBasicSCSClass(ObjectI).SortID then begin Exchange(i, j); //FItems.Move(i, j); ExchangeObjects(ObjectI, ObjectJ); end; end; end; end; procedure TSCSObjectList.SortByField(AItem: TObject; AFieldAdress: Pointer); begin //SortListByObjItemField(FItems, AItem, AFieldAdress); end; function TSCSObjectList.GetCount: Integer; begin Result := FItems.Count; end; function TSCSObjectList.ToRapList: TRapList; var i: Integer; begin Result := TRapList.Create; for i := 0 to FItems.Count - 1 do Result.Add(FItems[i]); end; { TObjectsBlob } procedure TObjectsBlob.Assign(AObjectsBlob: TObjectsBlob); begin FID := AObjectsBlob.FID; FTableKind := AObjectsBlob.FTableKind; FObjIDs.Assign(AObjectsBlob.FObjIDs); FDataKind := AObjectsBlob.FDataKind; CopyStream(FObjectData, AObjectsBlob.FObjectData); end; procedure TObjectsBlob.Clear; begin FID := 0; FTableKind := 0; FObjIDs.Clear; FDataKind := 0; FObjectData.Clear; end; constructor TObjectsBlob.Create(AActiveForm: TForm); begin inherited Create(AActiveForm); FOwner := nil; FObjIDs := TIntList.Create; FObjectData := TMemoryStream.Create; Clear; end; destructor TObjectsBlob.Destroy; begin Clear; FreeAndNil(FObjIDs); FreeAndNil(FObjectData); inherited; end; procedure TObjectsBlob.LoadFromMemTable; var Stream: TMemoryStream; begin with TF_Main(FActiveForm).DM do begin Self.FID := tSQL_ObjectsBlobs.FieldByName(fnID).AsInteger; Self.FTableKind := tSQL_ObjectsBlobs.FieldByName(fnTableKind).AsInteger; Self.FDataKind := tSQL_ObjectsBlobs.FieldByName(fnDataKind).AsInteger; Stream := TMemoryStream.Create; TBlobField(tSQL_ObjectsBlobs.FieldByName(fnObjIDs)).SaveToStream(Stream); LoadObjIDsFromStream(Stream); Stream.Free; Self.FObjectData.Clear; Self.FObjectData.Position := 0; TBlobField(tSQL_ObjectsBlobs.FieldByName(fnObjectData)).SaveToStream(Self.FObjectData); Self.FObjectData.Position := 0; end; end; procedure TObjectsBlob.LoadObjIDsFromStream(AStream: TStream); begin AStream.Position := 0; LoadIntListFromStream(AStream, FObjIDs); AStream.Position := 0; end; procedure TObjectsBlob.SaveObjIDsToStream(AStream: TStream); begin AStream.Position := 0; SaveIntListToStream(AStream, FObjIDs); AStream.Position := 0; end; procedure TObjectsBlob.SaveToMemTable(AMakeEdit: TMakeEdit); var Stream: TMemoryStream; begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_ObjectsBlobs.Append; meEdit: if tSQL_ObjectsBlobs.Locate(fnID, Self.ID, []) then tSQL_ObjectsBlobs.Edit; end; if tSQL_ObjectsBlobs.State <> dsBrowse then begin tSQL_ObjectsBlobs.FieldByName(fnID).AsInteger := Self.FID; tSQL_ObjectsBlobs.FieldByName(fnTableKind).AsInteger := Self.FTableKind; tSQL_ObjectsBlobs.FieldByName(fnDataKind).AsInteger := Self.FDataKind; Stream := TMemoryStream.Create; SaveObjIDsToStream(Stream); TBlobField(tSQL_ObjectsBlobs.FieldByName(fnObjIDs)).LoadFromStream(Stream); Stream.Free; Self.FObjectData.Position := 0; TBlobField(tSQL_ObjectsBlobs.FieldByName(fnObjectData)).LoadFromStream(Self.FObjectData); Self.FObjectData.Position := 0; tSQL_ObjectsBlobs.Post; end; end; end; { TObjectsBlobs } procedure TObjectsBlobs.AddObjectsBlob(AObjectsBlob: TObjectsBlob); begin if FObjectsBlobs.IndexOf(AObjectsBlob) = -1 then begin AObjectsBlob.FOwner := Self; FObjectsBlobs.Add(AObjectsBlob); end; end; procedure TObjectsBlobs.Assign(AObjectsBlobs: TObjectsBlobs); var NewObjectsBlob: TObjectsBlob; SrcObjectsBlob: TObjectsBlob; i: integer; begin FObjectsBlobs.Clear; for i := 0 to AObjectsBlobs.FObjectsBlobs.Count - 1 do begin SrcObjectsBlob := TObjectsBlob(AObjectsBlobs.FObjectsBlobs[i]); NewObjectsBlob := TObjectsBlob.Create(FActiveForm); NewObjectsBlob.Assign(SrcObjectsBlob); AddObjectsBlob(NewObjectsBlob); //FObjectsBlobs.Add(NewObjectsBlob); end; end; procedure TObjectsBlobs.Clear; begin FObjectsBlobs.Clear; end; constructor TObjectsBlobs.Create(FActiveForm: TForm); begin inherited Create(FActiveForm); FObjectsBlobs := TSCSObjectList.Create(True); Clear; end; procedure TObjectsBlobs.DeleteObjectsBlob(AObjectsBlob: TObjectsBlob); var IndexObject: Integer; begin IndexObject := FObjectsBlobs.IndexOf(AObjectsBlob); if IndexObject <> -1 then begin FObjectsBlobs.Delete(IndexObject); FreeAndNil(AObjectsBlob); end; end; destructor TObjectsBlobs.Destroy; begin Clear; FreeAndNil(FObjectsBlobs); //************************************************************************************************ inherited; end; { TFilterInfo } constructor TFilterInfo.Create; begin inherited; FilterBlock := TFilterBlock.Create(nil, btBlock); end; procedure TFilterInfo.DefineFilterBlock; begin FilterBlock.Clear; FilterBlock.LoadFromStr(FFilterValue, nil); end; destructor TFilterInfo.Destroy; begin FreeAndNil(FFilterBlock); inherited; end; procedure TFilterInfo.SetFilterValue(Value: String); begin if FFilterValue <> Value then begin FFilterValue := Value; DefineFilterBlock; end; end; { TFilterParams } procedure TFilterParams.Assign(AFilterParams: TFilterParams); begin FDBKind := AFilterParams.FDBKind; IsUseFilter := AFilterParams.IsUseFilter; if FFilterBlock <> nil then FFilterBlock.Assign(AFilterParams.FFilterBlock); FFilterType := AFilterParams.FFilterType; FavoriteGuids.Assign(AFilterParams.FavoriteGuids); TopGuids.Assign(AFilterParams.TopGuids); end; constructor TFilterParams.Create(ADBKind: TDBKind); begin inherited create; FDBKind := ADBKind; IsUseFilter := false; FFilterBlock := nil; FFilterType := fltNone; FavoriteGuids := TStringList.Create; TopGuids := TStringList.Create; end; destructor TFilterParams.Destroy; begin if FFilterBlock <> nil then FreeAndNil(FFilterBlock); if FavoriteGuids <> nil then FreeAndNil(FavoriteGuids); if TopGuids <> nil then FreeAndNil(TopGuids); inherited; end; procedure TFilterParams.DefineIsUseFilterField; begin IsUseFilter := FFilterBlock.IsOn; FFilterBlock.IsOn := true; end; { TUserInfo } procedure TUserInfo.Assign(AUserInfo: TUserInfo); begin if AUserInfo <> nil then begin FID := AUserInfo.FID; FName := AUserInfo.FName; FPass := AUserInfo.FPass; FRightsPM := AUserInfo.FRightsPM; FRightsNB := AUserInfo.FRightsNB; end; end; procedure TUserInfo.Clear; begin FID := 0; FName := ''; FPass := ''; FRightsPM := rwrReadWrite; FRightsNB := rwrReadWrite; end; constructor TUserInfo.Create; begin inherited; Clear; end; destructor TUserInfo.Destroy; // Tolik 12/12/2019 -- begin inherited; end; { TUsersInfo } function TUsersInfo.AddNewUserInfo(AName, APass: String; ARightsPM, ARightsNB: Integer): TUserInfo; begin Result := TUserInfo.Create; Result.FID := GenUserInfoID; Result.FName := AName; Result.FPass := APass; Result.FRightsPM := ARightsPM; Result.FRightsNB := ARightsNB; FUsersInfo.Add(Result); end; procedure TUsersInfo.Clear; begin FLastUserID := 0; FLoggedUserInfo := nil; FUsersInfo.Clear; end; constructor TUsersInfo.Create; begin inherited; FUsersInfo := TObjectList.Create(true); Clear; end; destructor TUsersInfo.Destroy; begin FUsersInfo.Free; inherited; end; function TUsersInfo.GenUserInfoID: Integer; begin Inc(FLastUserID); Result := FLastUserID; end; function TUsersInfo.GetXML: string; var XMLDocument: TXMLDocument; IXML: IDOMDocument; IRoot, INode, INodeUserList, IAttribute: IDOMNode; i: Integer; UserInfo: TUserInfo; begin Result := ''; XMLDocument := TXMLDocument.Create(nil); try XMLDocument.Active := false; XMLDocument.XML.Text := ''; XMLDocument.Active := true; //Корень IXML := XMLDocument.DOMDocument; IRoot := IXML.appendChild(IXML.createElement('Xml_Users')); // Узел с параметрами таблици INode := IRoot.appendChild(IXML.createElement(fnParams)); IAttribute := IXML.createAttribute(fnLastUserID); IAttribute.nodeValue := IntToStr(FLastUserID); INode.attributes.setNamedItem(IAttribute); // Узел - Список пользователей INodeUserList := IRoot.appendChild(IXML.createElement(fnUsrList)); for i := 0 to FUsersInfo.Count - 1 do begin UserInfo := TUserInfo(FUsersInfo[i]); // Узел с пользователем INode := INodeUserList.appendChild(IXML.createElement('Usr_'+IntToStr(i+1))); IAttribute := IXML.createAttribute(fnID); IAttribute.nodeValue := IntToStr(UserInfo.FID); INode.attributes.setNamedItem(IAttribute); IAttribute := IXML.createAttribute(fnName); IAttribute.nodeValue := UserInfo.FName; INode.attributes.setNamedItem(IAttribute); IAttribute := IXML.createAttribute(fnPass); IAttribute.nodeValue := UserInfo.FPass; INode.attributes.setNamedItem(IAttribute); IAttribute := IXML.createAttribute(fnRightsPM); IAttribute.nodeValue := IntToStr(UserInfo.FRightsPM); INode.attributes.setNamedItem(IAttribute); IAttribute := IXML.createAttribute(fnRightsNB); IAttribute.nodeValue := IntToStr(UserInfo.FRightsNB); INode.attributes.setNamedItem(IAttribute); end; Result := FormatXMLData(XMLDocument.XML.Text); finally XMLDocument.Free; end; end; function TUsersInfo.GetUserInfoByName(AName: string): TUserInfo; var Userinfo: TUserInfo; i: Integer; NameUpper: string; begin Result := nil; NameUpper := AnsiUpperCase(AName); for i := 0 to FUsersInfo.Count - 1 do begin Userinfo := TUserInfo(FUsersInfo[i]); if AnsiUpperCase(Userinfo.FName) = NameUpper then begin Result := Userinfo; Break; //// BREAK //// end; end; end; function TUsersInfo.IsDefAdminUser: Boolean; begin Result := (FUsersInfo.Count = 1) and (TUserInfo(FUsersInfo[0]).FName = unAdmin) and (TUserInfo(FUsersInfo[0]).FPass = GetHash(unAdmin)); end; function TUsersInfo.LoadFromStream(AStream: TStream): Boolean; var StringStream: TStringSTream; begin Result := false; StringStream := TStringSTream.Create(''); try UnPakStream(AStream, StringStream); Result := LoadFromXML(StringStream.DataString); finally FreeAndNil(StringStream); end; end; function TUsersInfo.LoadFromXML(AXml: string): Boolean; var XMLDocument: TXMLDocument; IXML: IDOMDocument; tmpObj: TUsersInfo; tmpUsetInfo: TUserInfo; IRoot, IRootChild, IUsrNode, IAttrNode: IDOMNode; //IXMLNode; i, j, k: Integer; begin Result := false; if AXml <> '' then begin tmpObj := TUsersInfo.Create; XMLDocument := TXMLDocument.Create(nil); try XMLDocument.LoadFromXML(AXml); if Not XMLDocument.Active then XMLDocument.Active := true; IXML := XMLDocument.DOMDocument; // Определить главный узел IRoot := IXML.documentElement; // Пробежаться по узлам-секциям for i := 0 to IRoot.ChildNodes.length - 1 do begin IRootChild := IRoot.childNodes.item[i]; if IRootChild.NodeName = fnParams then begin for j := 0 to IRootChild.attributes.length - 1 do begin IAttrNode := IRootChild.attributes.item[j]; if IAttrNode.nodeName = fnLastUserID then tmpObj.FLastUserID := StrToInt(IAttrNode.NodeValue); end; end else if IRootChild.NodeName = fnUsrList then begin // вычитать список пользователей for j := 0 to IRootChild.childNodes.length - 1 do begin IUsrNode := IRootChild.childNodes.item[j]; // вычитать инфу о юзере tmpUsetInfo := TUserInfo.Create; for k := 0 to IUsrNode.attributes.length - 1 do begin IAttrNode := IUsrNode.attributes.item[k]; if IAttrNode.nodeName = fnID then tmpUsetInfo.FID := StrToInt(IAttrNode.nodeValue) else if IAttrNode.nodeName = fnName then tmpUsetInfo.FName := IAttrNode.nodeValue else if IAttrNode.nodeName = fnPass then tmpUsetInfo.FPass := IAttrNode.nodeValue else if IAttrNode.nodeName = fnRightsPM then tmpUsetInfo.FRightsPM := StrToInt(IAttrNode.nodeValue) else if IAttrNode.nodeName = fnRightsNB then tmpUsetInfo.FRightsNB := StrToInt(IAttrNode.nodeValue); end; tmpObj.FUsersInfo.Add(tmpUsetInfo); end; end; end; XMLDocument.Active := false; Clear; FLastUserID := tmpObj.FLastUserID; tmpObj.FUsersInfo.OwnsObjects := false; FUsersInfo.Assign(tmpObj.FUsersInfo); finally XMLDocument.Free; tmpObj.Free; end; end; end; procedure TUsersInfo.SaveToStream(AStream: TStream); var XmlStr: String; StringStream: TStringSTream; StreamSize: Integer; begin StringStream := TStringSTream.Create(GetXML); try StreamSize := StringStream.Size; PakStream(StringStream, AStream{, clBetter}); StreamSize := AStream.Size; finally FreeAndNil(StringStream); end; end; procedure TComponentLoadFromFile(Component: TComponent; const AFileName: String); var Stream: TFileStream; begin Stream := TFileStream.Create(AFileName, fmOpenRead); try TComponentLoadFromStream(Component, Stream); finally Stream.Free; end; end; procedure TComponentLoadFromStream(Component: TComponent; AStream: TStream); var MemStream: TMemoryStream; begin MemStream := TMemoryStream.Create; ObjectTextToBinary(AStream, MemStream); MemStream.Position := 0; MemStream.ReadComponent(Component); MemStream.Free; end; procedure TComponentSaveToFile(Component: TComponent; const AFileName: String); var Stream: TFileStream; begin Stream := TFileStream.Create(AFileName, fmCreate); try TComponentSaveToStream(Component, Stream); finally Stream.Free; end; end; procedure TComponentSaveToStream(Component: TComponent; AStream: TStream); var MemStream: TMemoryStream; begin MemStream := TMemoryStream.Create; MemStream.WriteComponent(Component); MemStream.Position := 0; ObjectBinaryToText(MemStream, AStream); MemStream.Free; end; { TTempFilesInfo } procedure TTempFilesInfo.Clear; begin FFiles.Clear; end; constructor TTempFilesInfo.Create; begin inherited; FActive := false; FFiles := TStringList.Create; end; destructor TTempFilesInfo.Destroy; begin FFiles.Free; inherited; end; procedure TTempFilesInfo.Add(const AFile: String); begin If FActive and (FFiles.IndexOf(AFile) = -1) then FFiles.Add(AFile); end; function TTempFilesInfo.CheckIntegrity(const AMsgIfFail: String=''): Boolean; begin Result := CheckFilesIntegrity(FFiles, AMsgIfFail); end; function TTempFilesInfo.CheckFilesIntegrity(AFiles: TStringList; const AMsgIfFail: String=''): Boolean; var i: Integer; begin Result := true; for i := 0 to AFiles.Count - 1 do begin if Not FileExists(AFiles[i]) then begin Result := false; if AMsgIfFail <> '' then AddExceptionToLog(AMsgIfFail, true); Break; //// BREAK //// end; end; end; procedure TTempFilesInfo.SetActive(Value: Boolean); begin if Value <> FActive then begin FActive := Value; Clear; end; end; { TDataStream } procedure TDataStream.BeginReadRecord; begin if FIsReadingTable then begin if FIsReadingRecord then EndReadRecord; FIsReadingRecord := true; FStream.Read(FBeginRecPos, SizeOf(FBeginRecPos)); // начальная позиция FStream.Read(FEndRecPos, SizeOf(FEndRecPos)); // Конечная позиция FStream.Read(FFieldCount, SizeOf(FFieldCount)); // Количество полей end; end; function TDataStream.BeginReadTable: Boolean; //Tolik 24/06/2019 -- Не юзается, можно не напрягаться var // Tolik 24/06/0219 - - //RSignature: String; RSignature: AnsiString; // RVersion: Integer; Temp: Integer; begin Result := false; FStream.Seek(0, soFromBeginning); FIsReadingTable := false; // вычитываем сигнатуру if FStream.Size > Length(guidTableStreamSignature) then begin SetLength(RSignature, Length(guidTableStreamSignature)); // Tolik 24/06/2019 -- //FStream.Read(PChar(RSignature)^, Length(guidTableStreamSignature)); FStream.Read(RSignature[1], Length(guidTableStreamSignature)); //if RSignature = guidTableStreamSignature then if String(RSignature) = guidTableStreamSignature then // begin Result := true; // вычитываем версию FStream.Read(RVersion, SizeOf(FVersion)); // вычитать имя таблици SetLength(FTableName, 255); FStream.Read(FTableName, 255); // вычитать индекс таблици FStream.Read(FTableIndex, SizeOf(FTableIndex)); // вычитать количества записей FStream.Read(FRecordCount, SizeOf(FRecordCount)); // вычитать позицию с данными FStream.Read(FBeginDataPos, SizeOf(FBeginDataPos)); Temp := FStream.Position; FStream.Position := FBeginDataPos; end; end; FIsReadingTable := Result; end; procedure TDataStream.BeginWriteRecord; begin if FIsWritingTable then begin if FIsWritingRecord then EndWriteRecord; //FStream := AStream; FIsWritingRecord := true; IncCapacity; FBeginRecPos := FStream.Position; FEndRecPos := 0; FFieldCount := 0; FStream.Write(FBeginRecPos, SizeOf(FBeginRecPos)); // начальная позиция FStream.Write(FEndRecPos, SizeOf(FEndRecPos)); // Конечная позиция FStream.Write(FFieldCount, SizeOf(FFieldCount)); // Количество полей FRecordCount := FRecordCount + 1; end; end; procedure TDataStream.BeginWriteTable(ATableName: String; ATableIndex: integer); // Tolik -- эта функция не используется ниде begin if FIsWritingTable then EndWriteTable; FIsWritingTable := true; FTableName := ATableName; FTableIndex := ATableIndex; FSize := 0; FStream.Position := 0; FRecordCount := 0; IncCapacity; // записать сигнатуру FStream.Write(PChar(guidTableStreamSignature)^, Length(guidTableStreamSignature)); FStream.Write(FVersion, Sizeof(FVersion)); // записать имя таблици FStream.Write(FTableName, 255); // записать индекс таблици FStream.Write(FTableIndex, SizeOf(FTableIndex)); // записать количества записей FRecordCountPos := FStream.Position; FStream.Write(FRecordCount, SizeOf(FRecordCount)); // Записать позицию с данными FBeginDataPos := FStream.Position + SizeOf(FBeginDataPos); FStream.Write(FBeginDataPos, SizeOf(FBeginDataPos)); end; constructor TDataStream.Create; begin inherited; FStream := TMemoryStream.Create; AfterCreate; end; constructor TDataStream.Create(const FileName: string; Mode: Word); begin inherited create; FStream := TFileStream.Create(FileName, Mode); AfterCreate; end; procedure TDataStream.AfterCreate; begin FVersion := 01; FIsReadingBlob := false; FIsReadingRecord := false; FIsReadingTable := false; FIsWritingRecord := false; FIsWritingTable := false; FIntFieldBuffSize := SizeOf(Word) + // Индекс поля SizeOf(Byte) + // Тип данных SizeOf(Integer) // значение ; GetMem(FIntFieldBuff, FIntFieldBuffSize); FFloatFieldBuffSize := SizeOf(Word) + // Индекс поля SizeOf(Byte) + // Тип данных SizeOf(Double) // значение ; GetMem(FFloatFieldBuff, FFloatFieldBuffSize); FSizeFieldSize := SizeOf(Word) + // Индекс поля SizeOf(Byte) + // Тип данных SizeOf(Integer) // значение ; GetMem(FSizeFieldBuff, FSizeFieldSize); end; procedure TDataStream.IncCapacity; var Pos: Integer; Size: Integer; begin if FMemoryAllocBy > 0 then begin Pos := FStream.Position; Size := FStream.Size; //if (Size - Pos) < FMemoryAllocBy then if (Size - Pos) <= 0 then FStream.Size := FStream.Size + FMemoryAllocBy; end; end; destructor TDataStream.Destroy; begin FreeAndNil(FStream); FreeMem(FIntFieldBuff); FreeMem(FFloatFieldBuff); FreeMem(FSizeFieldBuff); inherited; end; procedure TDataStream.EndReadRecord; begin SkipNoReadedBlob; FIsReadingRecord := false; end; procedure TDataStream.EndReadTable; begin FIsReadingTable := false; end; procedure TDataStream.EndWriteRecord; //var // CurrPos: Integer; // PosValue: integer; begin if FIsWritingTable then begin // В начало блока записываем количество полей FEndRecPos := FStream.Position; // переходим вначало FStream.Seek(FBeginRecPos, soFromBeginning); // пропускаем запись с начальной позицией FStream.Seek(SizeOf(FBeginRecPos), soFromCurrent); FStream.Write(FEndRecPos, SizeOf(FEndRecPos)); // Конечная позиция FStream.Write(FFieldCount, SizeOf(FFieldCount)); // Количество полей FStream.Position := FEndRecPos; FIsWritingRecord := false; end; end; procedure TDataStream.EndWriteTable; var CurrPos: Integer; Size: Integer; begin if FIsWritingTable then begin CurrPos := FStream.Position; // Записываем количество записей FStream.Position := FRecordCountPos; FStream.Write(FRecordCount, SizeOf(FRecordCount)); FStream.Position := CurrPos; FSize := FStream.Position; {// Очищаем лишнюю выделенную память Size := FStream.Size; if Size > CurrPos then FStream.Size := CurrPos;} FIsWritingTable := false; end; end; procedure TDataStream.ReadBlobField(ADestStream: TStream); begin if FReadFieldFieldType = dtBlob then begin ADestStream.Position := 0; if FReadFieldSize > 0 then ADestStream.CopyFrom(FStream, FReadFieldSize); ADestStream.Position := 0; FIsReadingBlob := false; end; end; procedure TDataStream.ReadField; // Tolik -- 24/06/2019 -- Не юзается, можно не напрягаться begin SkipNoReadedBlob; FStream.Read(FReadFieldIndex, Sizeof(FReadFieldIndex)); FStream.Read(FReadFieldFieldType, SizeOf(FReadFieldFieldType)); case FReadFieldFieldType of dtFloat: FStream.Read(FReadFloatValue, SizeOf(FReadFloatValue)); dtInteger: FStream.Read(FReadIntValue, SizeOf(FReadIntValue)); dtString, dtBlob: begin FStream.Read(FReadFieldSize, SizeOf(FReadFieldSize)); if FReadFieldFieldType = dtString then begin SetLength(FReadStr, FReadFieldSize); FStream.Read(PChar(FReadStr)^, FReadFieldSize); end else FIsReadingBlob := true; end; else begin //Beep; end; end; end; Procedure TDataStream.WriteFloatField(FieldIndex: Word; const Value: Double); //var //FieldType: Byte; begin {FieldType := dtFloat; FStream.Write(FieldIndex, SizeOf(FieldIndex)); // Индекс поля FStream.Write(FieldType, SizeOf(FieldType)); // Тип данных FStream.Write(Value, SizeOf(Value)); // значение} {FFloatFieldInfo.FieldIndex := FieldIndex; FFloatFieldInfo.FieldType := dtFloat; FFloatFieldInfo.Value := Value; FStream.Write(FFloatFieldInfo, SizeOf(FFloatFieldInfo));} FWriteBuffPos := 0; Word(FFloatFieldBuff^) := FieldIndex; FWriteBuffPos := FWriteBuffPos + SizeOf(Word); Byte(Pointer(Integer(FFloatFieldBuff) + FWriteBuffPos)^) := dtFloat; FWriteBuffPos := FWriteBuffPos + SizeOf(Byte); Double(Pointer(Integer(FFloatFieldBuff) + FWriteBuffPos)^) := Value; FStream.Write(FFloatFieldBuff^, FFloatFieldBuffSize); FFieldCount := FFieldCount + 1; end; procedure TDataStream.WriteIntField(FieldIndex: Word; const Value: Integer); var FieldType: Byte; begin {FieldType := dtInteger; FStream.Write(FieldIndex, SizeOf(FieldIndex)); // Индекс поля FStream.Write(FieldType, SizeOf(FieldType)); // Тип данных FStream.Write(Value, SizeOf(Value)); // значение} {FIntFieldInfo.FieldIndex := FieldIndex; FIntFieldInfo.FieldType := dtInteger; FIntFieldInfo.Value := Value; FStream.Write(FIntFieldInfo, SizeOf(FIntFieldInfo));} FWriteBuffPos := 0; Word(FIntFieldBuff^) := FieldIndex; FWriteBuffPos := FWriteBuffPos + SizeOf(Word); Byte(Pointer(Integer(FIntFieldBuff) + FWriteBuffPos)^) := dtInteger; FWriteBuffPos := FWriteBuffPos + SizeOf(Byte); Integer(Pointer(Integer(FIntFieldBuff) + FWriteBuffPos)^) := Value; FStream.Write(FIntFieldBuff^, FIntFieldBuffSize); FFieldCount := FFieldCount + 1; end; Procedure TDataStream.WriteStrField(FieldIndex: Word; Const Value: String); //var //FieldType: Byte; //StrLen: Integer; begin {FieldType := dtString; StrLen := Length(Value); FStream.Write(FieldIndex, SizeOf(FieldIndex)); // Индекс поля FStream.Write(FieldType, SizeOf(FieldType)); // Тип данных FStream.Write(StrLen, SizeOf(StrLen)); // Длина строки FStream.Write(PChar(Value)^, StrLen);} {FBuffFieldInfo.FieldIndex := FieldIndex; FBuffFieldInfo.FieldType := dtString; FBuffFieldInfo.Size := Length(Value); FStream.Write(FBuffFieldInfo, SizeOf(FBuffFieldInfo)); FStream.Write(PChar(Value)^, FBuffFieldInfo.Size);} FWriteBuffPos := 0; Word(FSizeFieldBuff^) := FieldIndex; FWriteBuffPos := FWriteBuffPos + SizeOf(Word); Byte(Pointer(Integer(FSizeFieldBuff) + FWriteBuffPos)^) := dtString; FWriteBuffPos := FWriteBuffPos + SizeOf(Byte); Integer(Pointer(Integer(FSizeFieldBuff) + FWriteBuffPos)^) := Length(Value); FStream.Write(FSizeFieldBuff^, FSizeFieldSize); FStream.Write(PChar(Value)^, Length(Value)); FFieldCount := FFieldCount + 1; end; Procedure TDataStream.WriteStreamField(FieldIndex: Word; const Value: TStream); //var //FieldType: Byte; //StreamSize: Integer; begin {FieldType := dtBlob; Value.Seek(0, soFromBeginning); StreamSize := Value.Size; FStream.Write(FieldIndex, SizeOf(FieldIndex)); // Индекс поля FStream.Write(FieldType, SizeOf(FieldType)); // Тип данных FStream.Write(StreamSize, SizeOf(StreamSize)); // размер потока FStream.CopyFrom(Value, 0);} FBuffFieldInfo.FieldIndex := FieldIndex; {FBuffFieldInfo.FieldType := dtBlob; FBuffFieldInfo.Size := Value.Size; FStream.Write(FBuffFieldInfo, SizeOf(FBuffFieldInfo)); Value.Seek(0, soFromBeginning); FStream.CopyFrom(Value, 0);} FWriteBuffPos := 0; Word(FSizeFieldBuff^) := FieldIndex; FWriteBuffPos := FWriteBuffPos + SizeOf(Word); Byte(Pointer(Integer(FSizeFieldBuff) + FWriteBuffPos)^) := dtBlob; FWriteBuffPos := FWriteBuffPos + SizeOf(Byte); Integer(Pointer(Integer(FSizeFieldBuff) + FWriteBuffPos)^) := Value.Size; FStream.Write(FSizeFieldBuff^, FSizeFieldSize); Value.Seek(0, soFromBeginning); FStream.CopyFrom(Value, 0); FFieldCount := FFieldCount + 1; end; procedure TDataStream.SkipNoReadedBlob; begin if FIsReadingBlob then begin FStream.Seek(FReadFieldSize, soFromCurrent); FIsReadingBlob := false; end; end; // Tolik constructor TLineComponConnectionInfo.Create(CanCreateList: Boolean = False); begin inherited create; ComponCatalogID := -1; FirstPointObject := nil; LastPointObject := nil; PointToPointConnection := False; if CanCreateList then ConnectedComponList := TList.Create else ConnectedComponList := Nil; isLineConnection := True; end; destructor TLineComponConnectionInfo.Destroy; var i: Integer; begin if ConnectedComponList <> nil then begin for i := ConnectedComponList.Count - 1 downto 0 do TLineComponConnectionInfo(ConnectedComponList[i]).Destroy; ConnectedComponList.Clear; FreeAndNil(ConnectedComponList); end; inherited; end; // end.