mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 21:45:39 +02:00
2652 lines
73 KiB
ObjectPascal
2652 lines
73 KiB
ObjectPascal
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.
|