expertcad/SRC/SCSNormBase/U_SCSClasses.pas
2025-05-12 10:07:51 +03:00

2652 lines
73 KiB
ObjectPascal
Raw Permalink Blame History

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; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FieldType: Byte; // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Value: Integer; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
TFloatFieldInfo = record
FieldIndex: Word; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FieldType: Byte; // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Value: Double; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
TBuffFieldInfo = record
FieldIndex: Word; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FieldType: Byte; // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Size: Integer; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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}
// ############################ <20><><EFBFBD><EFBFBD><EFBFBD> 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}
// ####################### <20><><EFBFBD><EFBFBD><EFBFBD> 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}
// ####################### <20><><EFBFBD><EFBFBD><EFBFBD> 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;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
IXML := XMLDocument.DOMDocument;
IRoot := IXML.appendChild(IXML.createElement('Xml_Users'));
// <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
INode := IRoot.appendChild(IXML.createElement(fnParams));
IAttribute := IXML.createAttribute(fnLastUserID);
IAttribute.nodeValue := IntToStr(FLastUserID);
INode.attributes.setNamedItem(IAttribute);
// <20><><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
INodeUserList := IRoot.appendChild(IXML.createElement(fnUsrList));
for i := 0 to FUsersInfo.Count - 1 do
begin
UserInfo := TUserInfo(FUsersInfo[i]);
// <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
IRoot := IXML.documentElement;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to IRootChild.childNodes.length - 1 do
begin
IUsrNode := IRootChild.childNodes.item[j];
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD>
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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Read(FEndRecPos, SizeOf(FEndRecPos)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Read(FFieldCount, SizeOf(FFieldCount)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
end;
end;
function TDataStream.BeginReadTable: Boolean; //Tolik 24/06/2019 -- <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
var
// Tolik 24/06/0219 - -
//RSignature: String;
RSignature: AnsiString;
//
RVersion: Integer;
Temp: Integer;
begin
Result := false;
FStream.Seek(0, soFromBeginning);
FIsReadingTable := false;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Read(RVersion, SizeOf(FVersion));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SetLength(FTableName, 255);
FStream.Read(FTableName, 255);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Read(FTableIndex, SizeOf(FTableIndex));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Read(FRecordCount, SizeOf(FRecordCount));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(FEndRecPos, SizeOf(FEndRecPos)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(FFieldCount, SizeOf(FFieldCount)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
FRecordCount := FRecordCount + 1;
end;
end;
procedure TDataStream.BeginWriteTable(ATableName: String; ATableIndex: integer); // Tolik -- <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
begin
if FIsWritingTable then
EndWriteTable;
FIsWritingTable := true;
FTableName := ATableName;
FTableIndex := ATableIndex;
FSize := 0;
FStream.Position := 0;
FRecordCount := 0;
IncCapacity;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(PChar(guidTableStreamSignature)^, Length(guidTableStreamSignature));
FStream.Write(FVersion, Sizeof(FVersion));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(FTableName, 255);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(FTableIndex, SizeOf(FTableIndex));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FRecordCountPos := FStream.Position;
FStream.Write(FRecordCount, SizeOf(FRecordCount));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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) + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
SizeOf(Byte) + // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SizeOf(Integer) // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
;
GetMem(FIntFieldBuff, FIntFieldBuffSize);
FFloatFieldBuffSize := SizeOf(Word) + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
SizeOf(Byte) + // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SizeOf(Double) // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
;
GetMem(FFloatFieldBuff, FFloatFieldBuffSize);
FSizeFieldSize := SizeOf(Word) + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
SizeOf(Byte) + // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SizeOf(Integer) // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
;
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
// <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
FEndRecPos := FStream.Position;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Seek(FBeginRecPos, soFromBeginning);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Seek(SizeOf(FBeginRecPos), soFromCurrent);
FStream.Write(FEndRecPos, SizeOf(FEndRecPos)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(FFieldCount, SizeOf(FFieldCount)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
FStream.Position := FEndRecPos;
FIsWritingRecord := false;
end;
end;
procedure TDataStream.EndWriteTable;
var
CurrPos: Integer;
Size: Integer;
begin
if FIsWritingTable then
begin
CurrPos := FStream.Position;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Position := FRecordCountPos;
FStream.Write(FRecordCount, SizeOf(FRecordCount));
FStream.Position := CurrPos;
FSize := FStream.Position;
{// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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 -- <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FStream.Write(FieldType, SizeOf(FieldType)); // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(Value, SizeOf(Value)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
{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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FStream.Write(FieldType, SizeOf(FieldType)); // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(Value, SizeOf(Value)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
{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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FStream.Write(FieldType, SizeOf(FieldType)); // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(StrLen, SizeOf(StrLen)); // <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
FStream.Write(FieldType, SizeOf(FieldType)); // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FStream.Write(StreamSize, SizeOf(StreamSize)); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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.