unit U_BaseUpdate; interface Uses Forms, Windows, SysUtils, Controls, Variants, Contnrs, Dialogs, ibase, FIBDatabase, pFIBDatabase, FIBDataSet, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, {pFIBScript,} ExtCtrls, IB_Services, StdCtrls, Classes, ComCtrls, idGlobal, DB, U_Common_Classes, U_BaseCommon, U_BaseConstants, U_Common, U_SCSLists, U_SCSComponent; const TempDBName = 'Temp.dat'; ParamUserName = 'user_name=SYSDBA'; ParamPassword = 'password=masterkey'; bpnUserName = 'user_name'; bpnPassword = 'password'; constPageSize = 4096; //8192; //4096; // TableType ttNone = 0; ttUsual = 1; ttTree = 2; // RelationType rtNone = 0; rtDetail = 1; rtDirectory = 2; // Action Limit Table altNone = 0; altUpdate = 1; altInsert = 2; // Action Limit Row alrNone = 0; alrSkip = 1; alrInsIfNoExist = 2; //alrUpdAllow = 3; //27.01.2013 - строка только на обновление type TUpdateInfo = class; TUpdateInfoItem = class; TUpdateStructInfo = class; TUpdateStructInfoItem = class; TBase = class(TMyObject) private //FActive: Boolean; FMCurrency: TCurrency; //FSettings: TNBSettingRecord; FConnectParams: TBaseConnectParams; // Methods function CreateQuery(ATransaction: TpFIBTransaction): TpFIBQuery; function CreateTransaction: TpFIBTransaction; function GetSettingsAsDefault: TNBSettingRecord; procedure SetActiveToTransaction(AActive: Boolean); // Methods for Properies function GetActive: Boolean; protected FDataBase: TpFIBDataBase; FCreatedDBase: Boolean; FQInsert: TpFIBQuery; FQOperat: TpFIBQuery; FQSelect: TpFIBQuery; FQSelectA: TpFIBQuery; FQSelectGen: TpFIBQuery; FQSelectGenA: TpFIBQuery; FQUpdate: TpFIBQuery; FTInsert: TpFIBTransaction; FTOperat: TpFIBTransaction; FTSelect: TpFIBTransaction; FTSelectA: TpFIBTransaction; FTSelectGen: TpFIBTransaction; FTSelectGenA: TpFIBTransaction; FTUpdate: TpFIBTransaction; FOnUpdateStructureItem: TNotifyEvent; public FSettings: TNBSettingRecord; property Active: Boolean read GetActive; property ConnectParams: TBaseConnectParams read FConnectParams write FConnectParams; property DataBase: TpFIBDataBase read FDataBase write FDataBase; property OnUpdateStructureItem: TNotifyEvent read FOnUpdateStructureItem write FOnUpdateStructureItem; property QOperat: TpFIBQuery read FQOperat write FQOperat; property QSelect: TpFIBQuery read FQSelect write FQSelect; property TOperat: TpFIBTransaction read FTOperat write FTOperat; property TSelect: TpFIBTransaction read FTSelect write FTSelect; property Settings: TNBSettingRecord read FSettings write FSettings; constructor Create(AConnectParams: TBaseConnectParams; ADataBase: TpFIBDataBase=nil); destructor Destroy; override; function BackUpBase(ADBName, ABackUpName: string; AConnectParams: TBaseConnectParams): Boolean; procedure ClearTable(ATableName: String); procedure ClearTables(ATablesInfo: TUpdateInfo); procedure Close; // Корректировка структуры procedure CorrectStructure; function ExistsIntFieldValue(ATableName, AFieldName: String; AIntValue: Integer): Boolean; function GetComponentNewCypher: String; function GetCountryCurrency: TCurrency; function GetCurrencyByID(ACurrencyID: Integer): TCurrency; function GetCurrencyByType(ACurrencyType: Integer; AFromDefCurrency: Boolean): TCurrency; function GetUpdateInfo: TUpdateInfo; function GetUpdStructInfo: TUpdateStructInfo; function LoadSettings: TNBSettingRecord; procedure MakeEmptyCopy(ACopyName: String); procedure Open(ADBName: String); function PackBase(ADBName: String; AConnectParams: TBaseConnectParams; ARestoreDBName: String = ''): Boolean; function RestoreBase(ABackUpName, ADBName: string; AConnectParams: TBaseConnectParams; AShowExeption: Boolean): Boolean; procedure SaveSettings; function SelectTableRecordByGUID(const ATableName, AGUID: String): Boolean; procedure UpdateStructure(AUpdStructInfo: TUpdateStructInfo); end; TBUProgressEvent = procedure(Sender: TObject; AStepIndex, AStepCount: Integer) of object; TBaseUpdateBasic = class(TMyObject) private FSrcBase: TBase; FDestBase: TBase; FUpdateInfoItems: TUpdateInfo; FPrewProgressStepIndex: Integer; FProgressStepIndex: Integer; FProgressStepCount: Integer; ProgressStepCountPerPercent: Integer; // Events FOnEndProgress: TBUProgressEvent; FOnProgress: TBUProgressEvent; FOnStartProgress: TBUProgressEvent; procedure IncProgressIndex(AIncValue: Integer=1); public property SrcBase: TBase read FSrcBase write FSrcBase; property DestBase: TBase read FDestBase write FDestBase; property OnEndProgress: TBUProgressEvent read FOnEndProgress write FOnEndProgress; property OnProgress: TBUProgressEvent read FOnProgress write FOnProgress; property OnStartProgress: TBUProgressEvent read FOnStartProgress write FOnStartProgress; procedure Clear; virtual; constructor Create; destructor Destroy; override; end; TBaseUpdater = class(TBaseUpdateBasic) private FProgressTitle: String; FUpdateBaseParams: TUpdateBaseParams; procedure CorrectCurrencyInSrcBase; procedure CorrectNDSInSrcBase; procedure DefineSortID; function GetSrcCurrencyByType(AType: Integer): TCurrency; public //property ProgressTitle: String read FProgressTitle write FProgressTitle; procedure AddNewNodeToCatalogTable(ANodeTableName: String; AUpdateBaseParams: TUpdateBaseParams); function ControlForExistingNodeRecord(ANodeTableName: String; var AUpdateBaseParams: TUpdateBaseParams): TUpdateNodeResult; function GenUniqueIDBetweenBases(AUpdateTableInfo: TUpdateInfoItem; ATrgTableID: Integer; ASrcTableIDs: TIntList): integer; procedure InsertSrcTableToDest(AUpdateTableInfo: TUpdateInfoItem; AUpdateBaseParams: TUpdateBaseParams); procedure InsertSrcBaseToDest(AUpdateBaseParams: TUpdateBaseParams); procedure SetCatalogForOutComponents(ASrcDBName, ANodeTableName: String; AUpdateBaseParams: TUpdateBaseParams); procedure SetSrcBaseIDs; procedure SetSrcTableIDs(AUpdateTableInfo: TUpdateInfoItem); function UpdateBase(const ASrcDBName, ASrcDBNameOriginal, ADestDBName: String; var AUpdateBaseParams: TUpdateBaseParams; ASetBusyParams: Boolean; ABusyType: Integer; ACreateSrcTmp: Boolean): TUpdateBaseResults; procedure DestBaseUpdateStructure(Sender: TObject); procedure UpdEndProgress(Sender: TObject; AStepIndex, AStepCount: Integer); procedure UpdProgress(Sender: TObject; AStepIndex, AStepCount: Integer); procedure UpdStartProgress(Sender: TObject; AStepIndex, AStepCount: Integer); end; TUpdateMakerMode = (ummNone, ummDate, ummID); TMakeUpdateParams = class(TMyObject) DBType: Integer; // Тип создаваемого обновления (обычное, папка, компонент) ObjectID: Integer; ObjectGUID: String[40]; // GUID обэекта (папка, компонент), если DBType = (папка, компонент) Mode: TUpdateMakerMode; FldFrom, FldTo: Variant; FUpdateInfoItems: TUpdateInfo; constructor Create; destructor Destroy; override; end; TBaseUpdateMaker = class(TBaseUpdateBasic) private FMakeUpdateParams: TMakeUpdateParams; FTreeTableNames: TStringList; procedure DefinePrices; procedure SetUOM; public procedure Clear; override; constructor Create; destructor Destroy; override; procedure InsertSrcBaseToDest; procedure InsertSrcTableToDest(AUpdateTableInfo: TUpdateInfoItem); procedure SelectAllGuidesForTable(AUpdateTableInfo: TUpdateInfoItem); procedure SelectGuidesForRelations(AUpdateInfoItem: TUpdateInfoItem); procedure SelectGuidsByFromAndTo(AMode: TUpdateMakerMode; AFrom, ATo: Variant); procedure SelectGuidsForTableByFromAndTo(AUpdateTableInfo: TUpdateInfoItem; AMode: TUpdateMakerMode; AFrom, ATo: Variant); procedure SetSrcBaseIDs; procedure SetSrcTableIDs(AUpdateTableInfo: TUpdateInfoItem); function MakeUpdate(ASrcDBName, AEmptyDBName, ADestDBName: String; AMakeUpdateParams: TMakeUpdateParams; APackDest: Boolean): TUpdateBaseResults; end; TUpdateInfo = class(TObjectList) protected function GetItem(Index: Integer): TUpdateInfoItem; procedure SetItem(Index: Integer; AUpdateInfoItem: TUpdateInfoItem); public RecordCount: Integer; constructor Create; overload; destructor Destroy; override; function Add(AUpdateInfoItem: TUpdateInfoItem): Integer; procedure Assign(ASrc: TUpdateInfo); procedure DefineRelUpdInfoItems; function GetItemByTableName(ATableName: String): TUpdateInfoItem; function GetItemsCountByUpdAllDataFld: Integer; function Remove(AUpdateInfoItem: TUpdateInfoItem): Integer; procedure RemoveItemsByUpdAllDataFld; function IndexOf(AUpdateInfoItem: TUpdateInfoItem): Integer; procedure Insert(Index: Integer; AUpdateInfoItem: TUpdateInfoItem); function LoadRecordCount: Integer; property Items[index: integer]: TUpdateInfoItem read GetItem write SetItem; default; end; TUpdateInfoItem = class(TMyObject) private FBase: TBase; FUpdateInfoRelation: TObjectList; FIDListToMakeUpdate: TIntList; FIDListToMakeUpdateSorted: TIntList; FGUIDListToMakeUpdate: TStringList; FGUIDListToMakeUpdateSorted: TStringList; FGUIDListDisabled: TStringList; FLookedIDs: TIntList; FNewIDs: TIntList; public ID: Integer; IsOn: Integer; TableName: String[200]; GeneratorName: String[200]; TableType: Integer; UpdateAllData: Integer; IsDirectory: Integer; IsMainTable: Boolean; SortID: Integer; RecordCountInTable: Integer; ActLimit: ShortInt; // ограниченное действие (0-нет огр, 1-только) FieldsToUpdate: TStringList; property IDListToMakeUpdate: TIntList read FIDListToMakeUpdate write FIDListToMakeUpdate; property IDListToMakeUpdateSorted: TIntList read FIDListToMakeUpdateSorted write FIDListToMakeUpdateSorted; property GUIDListToMakeUpdate: TStringList read FGUIDListToMakeUpdate write FGUIDListToMakeUpdate; property GUIDListToMakeUpdateSorted: TStringList read FGUIDListToMakeUpdateSorted write FGUIDListToMakeUpdate; property LookedIDs: TIntList read FLookedIDs write FLookedIDs; function AddIDGuid(AID: Integer; const AGuid: String): Integer; constructor Create(ABase: TBase); destructor Destroy; override; function HaveNoLookedIDs: Boolean; procedure LoadRecordCount; procedure LoadUpdateInfoRel; procedure SortByID; end; TUpdateInfoRel = class(TMyObject) public ID: Integer; IDUpdateInfo: Integer; RelationType: Integer; RelTableName: String; RelFieldName: String; SortID: Integer; RelUpdateInfoItem: TUpdateInfoItem; constructor Create; destructor destroy; override;// Tolik 13/12/2019 -- end; TUpdateStructInfo = class(TObjectList) protected function GetItem(Index: Integer): TUpdateStructInfoItem; procedure SetItem(Index: Integer; AUpdateStructInfoItem: TUpdateStructInfoItem); public constructor Create; overload; destructor Destroy; override; function Add(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; function Remove(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; function IndexOf(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; procedure Insert(Index: Integer; AUpdateStructInfoItem: TUpdateStructInfoItem); property Items[index: integer]: TUpdateStructInfoItem read GetItem write SetItem; default; end; TUpdateStructInfoItem = class(TMyObject) protected FScript: TStringList; public ID: Integer; DateEntry: TDate; BuildID: Integer; SortID: Integer; Separator: String; property Script: TStringList read FScript write FScript; constructor Create; destructor Destroy; override; end; //procedure UpdEndProgress(Sender: TObject; AStepIndex, AStepCount: Integer); //procedure UpdProgress(Sender: TObject; AStepIndex, AStepCount: Integer); //procedure UpdStartProgress(Sender: TObject; AStepIndex, AStepCount: Integer); function MakeUpdate(ADestBaseName: String; AMakeUpdateParams: TMakeUpdateParams; APackDest: Boolean): Boolean; function UpdateNormBase(const ASrcBasePath, ASrcDBNameOriginal, ADestBasePath: String; var AUpdateBaseParams: TUpdateBaseParams; ABusyType: Integer; ACreateSrcTmp: Boolean): TUpdateBaseResults; implementation Uses U_Main, U_BaseSettings, U_ProtectionCommon, U_UpdateNormBaseDialog; { TBase } function TBase.BackUpBase(ADBName, ABackUpName: string; AConnectParams: TBaseConnectParams): Boolean; var DestDirName: String; DBLocalPath: String; BackUpLocalPath: String; //LogList: TStringList; //LogFile: String; DBServerName: String; BackUpServerName: String; Protocol: TProtocol; BackUpService: TpFIBBackupService; begin Result := false; try ExtractServerName(ADBName, DBServerName, DBLocalPath); ExtractServerName(ABackUpName, BackUpServerName, BackUpLocalPath); if DBServerName = BackUpServerName then begin Protocol := TCP; if DBServerName = '' then Protocol := Local; DestDirName := ExtractFileDir(ABackUpName); //*** Резервирование BackUpService := TpFIBBackupService.Create(nil); try BackUpService.ServerName := DBServerName; BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(GetBaseParam(bpnUserName, AConnectParams.UserName)); BackUpService.Params.Add(GetBaseParam(bpnPassword, AConnectParams.Pass)); BackUpService.Protocol := Protocol; BackUpService.Active := true; BackUpService.DatabaseName := DBLocalPath; BackUpService.BackupFile.Add(BackUpLocalPath); BackUpService.Options := [NoGarbageCollection]; BackUpService.Verbose := true; BackUpService.ServiceStart; if BackUpService.Verbose then begin //LogList := TStringList.Create; try while Not BackUpService.Eof do try BackUpService.GetNextLine; //LogList.Add(BackUpService.GetNextLine); except on E: Exception do AddExceptionToLogEx('', E.Message); end; //if DBServerName = '' then // LogList.SaveToFile(DestDirName+'\'+fnLogBackupDB); finally //LogList.Free; end; Result := true; end; BackUpService.Active := false; finally BackUpService.Free; end; end; except on E: Exception do AddExceptionToLogEx('TBase.BackUpBase', E.Message); end; end; procedure TBase.ClearTable(ATableName: String); begin try SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtDelete, ATableName, '', nil, '')); except end; end; procedure TBase.ClearTables(ATablesInfo: TUpdateInfo); var i: Integer; begin if Assigned(ATablesInfo) then for i := ATablesInfo.Count - 1 downto 0 do ClearTable(ATablesInfo[i].TableName); end; procedure TBase.Close; begin SetActiveToTransaction(false); //FDataBase.Close; FDataBase.Connected := false; //Application.ProcessMessages; end; constructor TBase.Create(AConnectParams: TBaseConnectParams; ADataBase: TpFIBDataBase=nil); var TransactParamsOperat: String; TransactParamsSelect: String; begin inherited Create; FConnectParams := AConnectParams; FCreatedDBase := false; if ADataBase <> nil then FDataBase := ADataBase else begin FDataBase := TpFIBDatabase.Create(Application); FDataBase.ConnectParams.CharSet := 'WIN1251'; FDataBase.ConnectParams.Password := 'masterkey'; FDataBase.ConnectParams.UserName := 'SYSDBA'; FDataBase.SQLDialect := 3; //FDataBase.CacheSchemaOptions.ValidateAfterLoad := false; FCreatedDBase := true; end; {FSecurityService := TpFIBSecurityService.Create(nil); FSecurityService.LoginPrompt := false; FSecurityService.Params.Add('user_name=SYSDBA'); FSecurityService.Params.Add('password=masterkey');} TransactParamsOperat := 'write'+#13+#10+'concurrency'+#13+#10+'nowait'; TransactParamsSelect := 'read'+#13+#10+'read_committed'+#13+#10+'rec_version'+#13+#10+'nowait'; // транзакции FTInsert := CreateTransaction; FTInsert.TRParams.Text := TransactParamsOperat; FTOperat := CreateTransaction; FTOperat.TRParams.Text := TransactParamsOperat; FTUpdate := CreateTransaction; FTUpdate.TRParams.Text := TransactParamsOperat; FTSelect := CreateTransaction; FTSelect.TRParams.Text := TransactParamsSelect; FTSelectA := CreateTransaction; FTSelectA.TRParams.Text := TransactParamsSelect; FTSelectGen := CreateTransaction; FTSelectGen.TRParams.Text := TransactParamsSelect; FTSelectGenA := CreateTransaction; FTSelectGenA.TRParams.Text := TransactParamsSelect; // Запросы FQInsert := CreateQuery(FTInsert); FQInsert.Options := FQInsert.Options + [qoAutoCommit]; FQOperat := CreateQuery(FTOperat); FQOperat.Options := FQOperat.Options + [qoAutoCommit]; FQUpdate := CreateQuery(FTUpdate); FQUpdate.Options := FQUpdate.Options + [qoAutoCommit]; FQSelect := CreateQuery(FTSelect); FQSelectA := CreateQuery(FTSelectA); FQSelectGen := CreateQuery(FTSelectGen); FQSelectGenA := CreateQuery(FTSelectGenA); FOnUpdateStructureItem := nil; end; function TBase.CreateQuery(ATransaction: TpFIBTransaction): TpFIBQuery; begin Result := TpFIBQuery.Create(F_NormBase); Result.Database := FDataBase; Result.Transaction := ATransaction; Result.GoToFirstRecordOnExecute := true; Result.Options := [qoStartTransaction, qoTrimCharFields]; end; function TBase.CreateTransaction: TpFIBTransaction; begin Result := TpFIBTransaction.Create(F_NormBase); Result.DefaultDatabase := FDataBase; end; destructor TBase.Destroy; begin if FCreatedDBase then if Active then Close; FreeAndNil(FQInsert); FreeAndNil(FQSelect); FreeAndNil(FQSelectA); FreeAndNil(FQSelectGen); FreeAndNil(FQSelectGenA); FreeAndNil(FQOperat); FreeAndNil(FQUpdate); FreeAndNil(FTInsert); FreeAndNil(FTSelect); FreeAndNil(FTSelectA); FreeAndNil(FTSelectGen); FreeAndNil(FTSelectGenA); FreeAndNil(FTOperat); FreeAndNil(FTUpdate); if FCreatedDBase then FreeAndNil(FDataBase); inherited; end; procedure TBase.CorrectStructure; var BuildID: Integer; begin try BuildID := FSettings.BuildID; //*** Догнать до 11 while BuildID < 11 do begin Inc(BuildID); if BuildID = 11 then begin Inc(BuildID); try SetSQLToFIBQuery(FQOperat, 'DROP TRIGGER NORM_RESOURCE_REL_BD0'); except end; FQOperat.Close; try SetSQLToFIBQuery(FQOperat, 'CREATE TRIGGER NORM_RESOURCE_REL_AD0 FOR NORM_RESOURCE_REL '+ 'ACTIVE AFTER DELETE POSITION 0 '+ 'AS '+ 'begin '+ ' /* Удуаление ресурса */ '+ ' delete from resources '+ ' where id = old.id_resource; '+ 'end'); except end; FQOperat.Close; try SetSQLToFIBQuery(FQOperat, 'alter table NORM_RESOURCE_REL add constraint FK_NORM_RESOURCE_REL foreign key (ID_RESOURCE) '+ 'references RESOURCES(ID) on delete CASCADE on update CASCADE'); except end; end; end; //*** определить индивидуалные комплектующие для каждой компоненты отдельно while BuildID < 19 do begin Inc(BuildID); if BuildID = 19 then begin try SetSQLToFIBQuery(FQOperat, 'ALTER TABLE COMPONENT_RELATION ADD ID_TOP_COMPON INTEGER'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'alter table COMPONENT_RELATION add constraint FKCOMPO_REL_IDTOPCOMPON foreign key (ID_TOP_COMPON) '+ 'references COMPONENT(ID) on delete CASCADE on update CASCADE'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'ALTER TABLE COMPONENT_RELATION ADD ID_PARENTCOMPREL INTEGER'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'alter table COMPONENT_RELATION add constraint FKCOMP_REL_IDPARENTCOMPREL foreign key (ID_PARENTCOMPREL) '+ 'references COMPONENT_RELATION(ID) on delete CASCADE on update CASCADE'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'ALTER TABLE COMPONENT_RELATION ADD KOL_SUB_COMPLECT INTEGER DEFAULT 0'); FQOperat.Close; DefineIndividualComplectsByEmptyIDTopCompon(FQSelect, FQOperat); except end; end; end; //*** Коррекция поля IDItemType с null в ноль while BuildID < 20 do begin Inc(BuildID); if BuildID = 20 then begin try SetSQLToFIBQuery(FQOperat, 'UPDATE KATALOG SET '+ 'ID_ITEM_TYPE = 0 '+ 'WHERE ID_ITEM_TYPE IS NULL'); except end; end; end; while BuildID < 38 do begin Inc(BuildID); if BuildID = 38 then begin try SetSQLToFIBQuery(FQOperat, 'ALTER TABLE COMPONENT ADD ISMARK_IN_CAPTIONS SMALLINT DEFAULT 0'); FQOperat.Close; try SetSQLToFIBQuery(FQOperat, 'ALTER TABLE component ALTER ismark_in_captions POSITION 13'); FQOperat.Close; except end; SetSQLToFIBQuery(FQOperat, 'UPDATE COMPONENT SET ISMARK_IN_CAPTIONS = 1 WHERE ID IN (SELECT ID_COMPONENT FROM INTERFACE_RELATION WHERE ISPORT = 1)'); FQOperat.Close; except end; end; end; while BuildID < 40 do begin Inc(BuildID); if BuildID = 40 then begin try SetSQLToFIBQuery(FQOperat, 'ALTER TABLE NB_NORMS ADD LABOR_TIME INTEGER DEFAULT 0'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'ALTER TABLE NB_NORMS ADD PRICE_PER_TIME FLOAT DEFAULT 0'); FQOperat.Close; try SetSQLToFIBQuery(FQOperat, 'alter table NB_NORMS alter LABOR_TIME position 6'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'alter table NB_NORMS alter PRICE_PER_TIME position 7'); FQOperat.Close; except end; SetSQLToFIBQuery(FQOperat, 'ALTER TABLE NORMS ADD LABOR_TIME INTEGER DEFAULT 0'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'ALTER TABLE NORMS ADD PRICE_PER_TIME FLOAT DEFAULT 0'); FQOperat.Close; try SetSQLToFIBQuery(FQOperat, 'alter table NORMS alter LABOR_TIME position 17'); FQOperat.Close; SetSQLToFIBQuery(FQOperat, 'alter table NORMS alter PRICE_PER_TIME position 18'); FQOperat.Close; except end; except end; end; end; except on E: Exception do AddExceptionToLogEx('TBase.CorrectStructure', E.Message); end; end; function TBase.ExistsIntFieldValue(ATableName, AFieldName: String; AIntValue: Integer): Boolean; var strSQL: String; begin Result := false; strSQL := GetSQLByParams(qtSelect, ATableName, AFieldName+' = :'+AFieldName, nil, fnCount+'('+AFieldName+')'); FQSelect.Close; if FQSelect.SQL.Text <> strSQL then FQSelect.SQL.Text := strSQL; FQSelect.ParamByName(AFieldName).AsInteger := AIntValue; FQSelect.ExecQuery; //SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, ATableName, AFieldName+' = '''+IntToStr(AIntValue)+'''', nil, fnCount+'('+AFieldName+')'), true); if FQSelect.FN(fnCount).AsInteger > 0 then Result := true; end; function TBase.GetActive: Boolean; begin Result := false; if Assigned(FDataBase) then Result := FDataBase.Connected; end; function TBase.GetComponentNewCypher: String; begin //Result := GenNewComponentCypher(FQSelectGen, FQSelect); Result := GenNewComponentCypher(FQSelectGen, FQSelectGenA); end; function TBase.GetCountryCurrency: TCurrency; begin Result := U_BaseCommon.GetCountryCurrency(FQSelect); end; function TBase.GetCurrencyByID(ACurrencyID: Integer): TCurrency; begin Result := U_BaseCommon.GetCurrencyByID(ACurrencyID, FQSelect); end; function TBase.GetCurrencyByType(ACurrencyType: Integer; AFromDefCurrency: Boolean): TCurrency; var ptrObjectCurrency: PObjectCurrencyRel; IDObjectCurencies: Integer; begin ZeroMemory(@Result, SizeOf(TCurrency)); if (FSettings.BuildID < 11) or AFromDefCurrency then Result := U_BaseCommon.GetCurrencyByType(ACurrencyType, FQSelect) else begin IDObjectCurencies := 0; ptrObjectCurrency := GetObjectCurrencyByMainFld(IDObjectCurencies, ACurrencyType, FQSelect); if ptrObjectCurrency <> nil then begin Result := ptrObjectCurrency.Data; FreeMem(ptrObjectCurrency); end; end; end; function TBase.LoadSettings: TNBSettingRecord; begin {ZeroMemory(@Result, SizeOf(TNBSettingRecord)); try FQSelect.Close; FQSelect.SQL.Text := 'select count(*) from '+ tnSettings; FQSelect.ExecQuery; if FQSelect.FN(fnCount).AsInteger > 0 then begin FQSelect.Close; FQSelect.SQL.Text := 'select * from '+ tnSettings; FQSelect.ExecQuery; Result.DBName := FQSelect.FN(fnDBName).AsString; Result.BuildID := FQSelect.FN(fnBuildID).AsInteger; Result.NDS := FQSelect.FN(fnNDS).AsFloat; end; FQSelect.Close; except end;} Result := U_BaseCommon.GetNBSettings(FQSelect); FSettings := Result; end; function TBase.GetSettingsAsDefault: TNBSettingRecord; begin Result.DBName := bnNB; Result.BuildID := CurrentNBBuildID; Result.NDS := 20; end; function TBase.GetUpdateInfo: TUpdateInfo; var DefDirecroryTables: TStringList; UpdateInfoItem: TUpdateInfoItem; Stream: TMemoryStream; i: Integer; begin Result := nil; try if Active then begin Result := TUpdateInfo.Create; DefDirecroryTables := TStringList.Create; DefDirecroryTables.Add('OBJECT_ICONS'); DefDirecroryTables.Add('CURRENCY'); DefDirecroryTables.Add('NET_TYPE'); DefDirecroryTables.Add('NB_NORMS'); DefDirecroryTables.Add('NB_RESOURCES'); DefDirecroryTables.Add('NB_NORM_RESOURCE_REL'); DefDirecroryTables.Add('INTERFACE'); DefDirecroryTables.Add('COMPONENT_TYPES'); DefDirecroryTables.Add('PRODUCERS'); DefDirecroryTables.Add('PROPERTIES'); DefDirecroryTables.Add('SUPPLIER'); DefDirecroryTables.Add('SUPPLIES_KINDS'); DefDirecroryTables.Add('COMP_TYPE_PROP_RELATION'); DefDirecroryTables.Add('INTERFACE_ACCORDANCE'); DefDirecroryTables.Add('INTERFACE_NORMS'); DefDirecroryTables.Add('DIRECTORY_TYPE'); DefDirecroryTables.Add('DIRECTORY_TYPE_REL'); SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnUpdateInfo, fnIsOn+' = '''+IntToStr(biTrue)+'''', nil, fnAll)); while Not FQSelect.Eof do begin UpdateInfoItem := TUpdateInfoItem.Create(Self); UpdateInfoItem.ID := FQSelect.FN(fnID).AsInteger; UpdateInfoItem.IsOn := FQSelect.FN(fnIsOn).AsInteger; UpdateInfoItem.TableName := FQSelect.FN(fnTableName).AsString; UpdateInfoItem.GeneratorName := FQSelect.FN(fnGeneratorName).AsString; UpdateInfoItem.TableType := FQSelect.FN(fnTableType).AsInteger; UpdateInfoItem.UpdateAllData := FQSelect.FN(fnUpdateAllData).AsInteger; UpdateInfoItem.SortID := FQSelect.FN(fnSortID).AsInteger; if FSettings.BuildID < 11 then begin if DefDirecroryTables.IndexOf(UpdateInfoItem.TableName) <> -1 then UpdateInfoItem.IsDirectory := biTrue; end else UpdateInfoItem.IsDirectory := FQSelect.FN(fnIsDirectory).AsInteger; if FQSelect.FieldIndex[fnActLimit] <> -1 then UpdateInfoItem.ActLimit := FQSelect.FN(fnActLimit).AsInteger; if FQSelect.FieldIndex[fnFieldsToUpdate] <> -1 then begin Stream := TMemoryStream.Create; FQSelect.FN(fnFieldsToUpdate).SaveToStream(Stream); Stream.Position := 0; UpdateInfoItem.FieldsToUpdate.Clear; UpdateInfoItem.FieldsToUpdate.LoadFromStream(Stream); FreeAndNil(Stream); end; Result.Add(UpdateInfoItem); FQSelect.Next; end; FQSelect.Close; for i := 0 to Result.Count - 1 do Result[i].LoadUpdateInfoRel; Result.LoadRecordCount; Result.DefineRelUpdInfoItems; FreeAndNil(DefDirecroryTables); end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TBase.GetUpdateInfo), E.Message); end; end; function TBase.GetUpdStructInfo: TUpdateStructInfo; var SqlTxt: String; UpdateStructInfoItem: TUpdateStructInfoItem; Stream: TMemoryStream; IdxID, IdxDateEntry, IdxBuildID, IdxSortID, IdxSeparator: Integer; begin Result := nil; if Active then begin Result := TUpdateStructInfo.Create; SqlTxt := GetSQLByParams(qtSelect, tnUpdateStructInfo, '', nil, fnAll); SqlTxt := SqlTxt + ' order by '+fnSortID; SetSQLToFIBQuery(FQSelect, SqlTxt); if Not FQSelect.Eof then begin IdxID :=FQSelect.FieldIndex[fnID]; IdxDateEntry := FQSelect.FieldIndex[fnDateEntry]; IdxBuildID := FQSelect.FieldIndex[fnBuildID]; IdxSortID := FQSelect.FieldIndex[fnSortID]; IdxSeparator := FQSelect.FieldIndex[fnSeparator]; while Not FQSelect.Eof do begin UpdateStructInfoItem := TUpdateStructInfoItem.Create; //27.01.2013 //UpdateStructInfoItem.ID := FQSelect.FN(fnID).AsInteger; //UpdateStructInfoItem.DateEntry := FQSelect.FN(fnDateEntry).AsDate; //UpdateStructInfoItem.BuildID := FQSelect.FN(fnBuildID).AsInteger; //UpdateStructInfoItem.SortID := FQSelect.FN(fnSortID).AsInteger; UpdateStructInfoItem.ID := FQSelect.Fields[IdxID].AsInteger; UpdateStructInfoItem.DateEntry := FQSelect.Fields[IdxDateEntry].AsDate; UpdateStructInfoItem.BuildID := FQSelect.Fields[IdxBuildID].AsInteger; UpdateStructInfoItem.SortID := FQSelect.Fields[IdxSortID].AsInteger; if IdxSeparator <> -1 then UpdateStructInfoItem.Separator := FQSelect.Fields[IdxSeparator].AsString; Stream := TMemoryStream.Create; try FQSelect.FN(fnScript).SaveToStream(Stream); Stream.Position := 0; UpdateStructInfoItem.Script.LoadFromStream(Stream); finally FreeAndNil(Stream); end; Result.Add(UpdateStructInfoItem); FQSelect.Next; end; end; FQSelect.Close; end; end; procedure TBase.MakeEmptyCopy(ACopyName: String); var SavedConnected: Boolean; NewBase: TBase; UpdateInfo: TUpdateInfo; begin SavedConnected := FDataBase.Connected; if FDataBase.Connected then FDataBase.Close; try //*** создать копию путем создания GBK файла и восстановления из него новой базы if PackBase(FDataBase.DBName, FConnectParams, ACopyName) then begin NewBase := TBase.Create(FConnectParams); NewBase.Open(ACopyName); try UpdateInfo := NewBase.GetUpdateInfo; try NewBase.ClearTables(UpdateInfo); finally UpdateInfo.Free; end; finally NewBase.Close; end; PackBase(ACopyName, FConnectParams); end; finally if SavedConnected then FDataBase.Open; end; {if FDataBase.Connected then FDataBase.Close; try if CopyBase(FDataBase.DBName, ACopyName) then begin NewBase := TBase.Create; NewBase.Open(ACopyName); try UpdateInfo := NewBase.GetUpdateInfo; try NewBase.ClearTables(UpdateInfo); finally UpdateInfo.Free; end; finally NewBase.Close; end; PackBase(ACopyName); end; finally if SavedConnected then FDataBase.Open; end;} end; procedure TBase.Open(ADBName: String); begin if FDataBase.Connected then FDataBase.Connected := false; FDataBase.AliasName := ADBName; FDataBase.DBName := ADBName; FDataBase.ConnectParams.UserName := FConnectParams.UserName; FDataBase.ConnectParams.Password := FConnectParams.Pass; //FDataBase.Open; FDataBase.Connected := true; //Application.ProcessMessages; SetActiveToTransaction(true); //SetSQLToFIBQuery(FQSelect, 'select rdb$relation_name, RDB$FIELD_ID, RDB$OWNER_NAME from rdb$relations where (rdb$system_flag = 0) and (rdb$view_source is null) order by RDB$FIELD_ID'); //SetSQLToFIBQuery(FQSelect, 'select RDB$OWNER_NAME from rdb$relations '); //while Not FQSelect.Eof do //begin //FQSelect.Next; //end; end; function TBase.PackBase(ADBName: String; AConnectParams: TBaseConnectParams; ARestoreDBName: String = ''): Boolean; var BackUpFile: String; //BackUpDir: String; SrcDirName: String; DestDirName: String; DBNameToBackUp: String; DBNameToRestore: String; LogList: TStringList; LogFile: String; ServerName: String; Protocol: TProtocol; BackUpService: TpFIBBackupService; RestoreService: TpFIBRestoreService; TmpStr: String; begin Result := false; try //Exit; ///// EXIT ///// ExtractServerName(ADBName, ServerName, DBNameToBackUp); Protocol := TCP; if ServerName = '' then Protocol := Local; DBNameToRestore := DBNameToBackUp; if ARestoreDBName <> '' then begin ExtractServerName(ARestoreDBName, TmpStr, DBNameToRestore); if ServerName = '' then DeleteFile(DBNameToRestore); end; //DBNameToRestore := ARestoreDBName; //if DBNameToRestore = '' then // DBNameToRestore := ADBName; SrcDirName := ExtractFileDir(DBNameToBackUp); DestDirName := ExtractFileDir(DBNameToRestore); //BackUpFile := DestDirName + '\' + fnNBBackup; //{'C:\'+fnNBBackup; //}DestDirName + '\' + fnNBBackup; if (DBNameToBackUp <> '') and (DBNameToBackUp[1] <> '/') then BackUpFile := DestDirName + '\' + ExtractFileNameOnly(DBNameToBackUp) + enGbk else if (DBNameToBackUp <> '') and (DBNameToBackUp[1] = '/') then BackUpFile := ExtractFileNameOnly(DBNameToBackUp) + enGbk; //ServerName := 'FILESERVER'; //Protocol := TCP; //*** Резервирование BackUpService := TpFIBBackupService.Create(nil); try {Начальный код BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(ParamUserName); BackUpService.Params.Add(ParamPassword); BackUpService.Protocol := Local; BackUpService.DatabaseName := ADBName; BackUpService.ServerName := ''; BackUpService.BackupFile.Text := BackUpFile; BackUpService.Options := [NoGarbageCollection]; BackUpService.Verbose := true; BackUpService.Active := true; BackUpService.ServiceStart; } { НЕ РАБОТАЕТ BackUpService.ServerName := 'localhost'; BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(ParamUserName); BackUpService.Params.Add(ParamPassword); BackUpService.Protocol := Protocol; BackUpService.Active := true; BackUpService.DatabaseName := ServerName +':'+ 'E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb.dat'; BackUpService.BackupFile.Clear; //BackUpService.BackupFile.Add('E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb.gbk'); BackUpService.BackupFile.Add('C:\Projects\nb.gbk'); BackUpService.Options := [NoGarbageCollection, IgnoreLimbo]; BackUpService.Verbose := true; BackUpService.ServiceStart; } { РАБОТАЕТ BackUpService.ServerName := ServerName; BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(ParamUserName); BackUpService.Params.Add(ParamPassword); BackUpService.Protocol := Protocol; BackUpService.Active := true; BackUpService.DatabaseName := 'E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb.dat'; BackUpService.BackupFile.Clear; BackUpService.BackupFile.Add('E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb.gbk'); //BackUpService.BackupFile.Add('localhost:'+'C:\Projects\nb.gbk'); BackUpService.Options := [NoGarbageCollection]; BackUpService.Verbose := true; BackUpService.ServiceStart;} BackUpService.ServerName := ServerName; BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(GetBaseParam(bpnUserName, AConnectParams.UserName)); BackUpService.Params.Add(GetBaseParam(bpnPassword, AConnectParams.Pass)); BackUpService.Protocol := Protocol; BackUpService.Active := true; BackUpService.DatabaseName := DBNameToBackUp; BackUpService.BackupFile.Add(BackUpFile); BackUpService.Options := [NoGarbageCollection]; BackUpService.Verbose := true; BackUpService.ServiceStart; if BackUpService.Verbose then begin LogList := TStringList.Create; try while Not BackUpService.Eof do begin //try LogList.Add(BackUpService.GetNextLine); //except // on E: Exception do AddExceptionToLogEx('', E.Message); //end; end; if ServerName = '' then LogList.SaveToFile(DestDirName+'\'+fnLogBackupDB); //LogList.SaveToFile(BackUpDir+fnLogBackupDB); finally LogList.Free; end; end; BackUpService.Active := false; finally BackUpService.Free; end; { тест BackUpService := TpFIBBackupService.Create(nil); try BackUpService.LoginPrompt := false; BackUpService.Params.Clear; BackUpService.Params.Add(ParamUserName); BackUpService.Params.Add(ParamPassword); BackUpService.Active := true; BackUpService.DatabaseName := ADBName; BackUpService.BackupFile.Text := BackUpFile; BackUpService.Options := [NoGarbageCollection]; BackUpService.Verbose := true; //BackUpService.ServerName := 'server'; //BackUpService.Detach; BackUpService.ServiceStart; if BackUpService.Verbose then begin LogList := TStringList.Create; try while Not BackUpService.Eof do //BackUpService.Detach; try LogList.Add(BackUpService.GetNextLine); except end; LogList.SaveToFile(CurrDirName+'\'+fnLogBackupDB); finally LogList.Free; end; end; BackUpService.Active := false; finally BackUpService.Free; end; } //*** Востановление RestoreService := TpFIBRestoreService.Create(nil); try { Начальный код RestoreService.LoginPrompt := false; RestoreService.Params.Clear; RestoreService.Params.Add(ParamUserName); RestoreService.Params.Add(ParamPassword); RestoreService.BackupFile.Text := BackUpFile; RestoreService.DatabaseName.Text := DBNameToRestore; RestoreService.PageSize := 4096; RestoreService.Options := [OneRelationAtATime, Replace]; RestoreService.Verbose := true; RestoreService.Active := true; RestoreService.ServiceStart; } { РАБОТАЕТ RestoreService.ServerName := ServerName; RestoreService.LoginPrompt := false; RestoreService.Params.Clear; RestoreService.Params.Add(ParamUserName); RestoreService.Params.Add(ParamPassword); RestoreService.Protocol := Protocol; RestoreService.Active := true; RestoreService.BackupFile.Add('E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb.gbk'); RestoreService.DatabaseName.Add('E:\! ПАПКА ОБМЕНА\Oleg\SCS\nb2.dat'); RestoreService.PageSize := 4096; RestoreService.Options := [OneRelationAtATime, Replace]; RestoreService.Verbose := true; RestoreService.Active := true; RestoreService.ServiceStart; } RestoreService.ServerName := ServerName; RestoreService.LoginPrompt := false; RestoreService.Params.Clear; RestoreService.Params.Add(GetBaseParam(bpnUserName, AConnectParams.UserName)); RestoreService.Params.Add(GetBaseParam(bpnPassword, AConnectParams.Pass)); RestoreService.Protocol := Protocol; RestoreService.Active := true; RestoreService.DatabaseName.Add(DBNameToRestore); RestoreService.BackupFile.Add(BackUpFile); RestoreService.PageSize := constPageSize; RestoreService.Options := [OneRelationAtATime, Replace]; RestoreService.Verbose := true; RestoreService.Active := true; RestoreService.ServiceStart; if RestoreService.Verbose then begin LogList := TStringList.Create; try while Not RestoreService.Eof do LogList.Add(RestoreService.GetNextLine); if ServerName = '' then begin //LogFile := BackUpDir + fnLogRestoreDB; LogFile := DestDirName+'\'+fnLogRestoreDB; if FileExists(LogFile) then DeleteFile(LogFile); LogList.SaveToFile(LogFile); end; finally LogList.Free; end; end; RestoreService.Active := false; finally RestoreService.Free; end; Result := true; except on E: Exception do AddExceptionToLog('TBase.PackBase: '+E.Message); end; end; function TBase.RestoreBase(ABackUpName, ADBName: string; AConnectParams: TBaseConnectParams; AShowExeption: Boolean): Boolean; var DestDirName: String; BackUpServerName: String; BackUpLocalPath: String; DBNameToRestore: String; //LogList: TStringList; //LogFile: String; ServerName: String; Protocol: TProtocol; RestoreService: TpFIBRestoreService; begin Result := false; try ExtractServerName(ABackUpName, BackUpServerName, BackUpLocalPath); ExtractServerName(ADBName, ServerName, DBNameToRestore); Protocol := TCP; if ServerName = '' then Protocol := Local; DestDirName := ExtractFileDir(DBNameToRestore); RestoreService := TpFIBRestoreService.Create(nil); try RestoreService.ServerName := ServerName; RestoreService.LoginPrompt := false; RestoreService.Params.Clear; RestoreService.Params.Add(GetBaseParam(bpnUserName, AConnectParams.UserName)); RestoreService.Params.Add(GetBaseParam(bpnPassword, AConnectParams.Pass)); RestoreService.Protocol := Protocol; RestoreService.Active := true; RestoreService.DatabaseName.Add(DBNameToRestore); RestoreService.BackupFile.Add(BackUpLocalPath); RestoreService.PageSize := constPageSize; RestoreService.Options := [OneRelationAtATime, Replace]; RestoreService.Verbose := true; RestoreService.Active := true; RestoreService.ServiceStart; if RestoreService.Verbose then begin //LogList := TStringList.Create; //try while Not RestoreService.Eof do RestoreService.GetNextLine; //LogList.Add(RestoreService.GetNextLine); //if ServerName = '' then //begin // LogFile := DestDirName+'\'+fnLogRestoreDB; // if FileExists(LogFile) then // DeleteFile(LogFile); // LogList.SaveToFile(LogFile); //end; //finally //LogList.Free; //end; Result := true; end; RestoreService.Active := false; finally RestoreService.Free; end; except on E: Exception do AddExceptionToLogEx('TBase.RestoreBase', E.Message, AShowExeption); end; end; procedure TBase.SaveSettings; //var // FieldList: TStringList; begin U_BaseCommon.SetNBSettings(FSettings, FQOperat); { FieldList := TStringList.Create; FieldList.Add(fnBuildID); FieldList.Add(fnNDS); FieldList.Add(fnDBName); try SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtDelete, tnSettings, '', nil, '')); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnSettings, '', FieldList, ''), false); FQOperat.ParamByName(fnBuildID).AsInteger := FSettings.BuildID; FQOperat.ParamByName(fnNDS).AsFloat := FSettings.NDS; FQOperat.ParamByName(fnDBName).AsString := FSettings.DBName; FQOperat.ExecQuery; FQOperat.Close; finally FieldList.Free; end; } end; function TBase.SelectTableRecordByGUID(const ATableName, AGUID: String): Boolean; var strSQL: String; begin Result := false; if (ATableName <> '') and (AGuid <> '') then begin strSQL := GetSQLByParams(qtSelect, ATableName, fnGUID+' = :'+fnGUID, nil, fnGUID+', '+ fnID); FQSelect.Close; if FQSelect.SQL.Text <> strSQL then FQSelect.SQL.Text := strSQL; FQSelect.Params[0].AsString := AGUID; //fnGUID FQSelect.ExecQuery; //SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, ATableName, fnGUID+' = '''+AGUID+'''', nil, fnGUID+', '+ fnID)); if FQSelect.Fields[0].AsString = AGUID then Result := true; FQSelect.Close; end; end; procedure TBase.UpdateStructure(AUpdStructInfo: TUpdateStructInfo); var i, j: Integer; UpdStructInfoItem: TUpdateStructInfoItem; BuildID: integer; GUIDList: TStringList; SubScripts: TStringList; SavedParamCheck: Boolean; //FIBScript: TpFIBScript; begin LoadSettings; FQSelect.Close; //FIBScript := TpFIBScript.Create(nil); //FIBScript.Database := FDataBase; //FIBScript.Transaction := TpFIBTransaction(FQOperat.Transaction); //FQOperat.Options := FQOperat.Options - [qoAutoCommit, qoStartTransaction]; SavedParamCheck := FQOperat.ParamCheck; FQOperat.ParamCheck := false; try for i := 0 to AUpdStructInfo.Count - 1 do begin UpdStructInfoItem := AUpdStructInfo[i]; if UpdStructInfoItem.BuildID > FSettings.BuildID then begin try FDataBase.Close; FDataBase.Open; if UpdStructInfoItem.Separator = '' then begin FQOperat.Close; FQOperat.SQL.Text := ''; FQOperat.SQL.Text := UpdStructInfoItem.FScript.Text; FQOperat.ExecQuery; end else begin SubScripts := SplitString(UpdStructInfoItem.FScript.Text, UpdStructInfoItem.Separator, false); for j := 0 to SubScripts.Count - 1 do begin if SubScripts[j] <> #$D#$A then begin try FQOperat.Close; FQOperat.SQL.Text := ''; FQOperat.SQL.Text := SubScripts[j]; FQOperat.ExecQuery; except on E: Exception do AddExceptionToLog('TBase.UpdateStructure: '+E.Message); end; end; end; SubScripts.Free; end; except on E: Exception do AddExceptionToLog('TBase.UpdateStructure: '+E.Message); end; end; if Assigned(FOnUpdateStructureItem) then FOnUpdateStructureItem(Self); end; FQOperat.Close; finally FQOperat.ParamCheck := SavedParamCheck; //FQOperat.Options := FQOperat.Options + [qoAutoCommit, qoStartTransaction]; end; BuildID := FSettings.BuildID; while BuildID < 14 do begin inc(BuildID); if BuildID = 14 then begin try DefineSpavIDsBySpravGUIDs(tnNorms, tnNBNorms, fnIDNB, fnGuidNB, FQSelect, FQOperat); DefineSpavIDsBySpravGUIDs(tnResources, tnNBResources, fnIDNB, fnGuidNB, FQSelect, FQOperat); except on E: Exception do AddExceptionToLogEx('TBase.UpdateStructure', E.Message); end; end; end; while BuildID < 18 do begin inc(BuildID); if BuildID = 18 then try StoreGuidsInReservGuidTable(FDataBase, 0); except on E: Exception do AddExceptionToLogEx('TBase.UpdateStructure', E.Message); end; end; if BuildID < 19 then begin inc(BuildID); DefineIndividualComplectsByEmptyIDTopCompon(FQSelect, FQOperat); end; //FreeAndNil(FIBScript); end; procedure TBase.SetActiveToTransaction(AActive: Boolean); begin FTInsert.Active := AActive; FTOperat.Active := AActive; FTUpdate.Active := AActive; FTSelect.Active := AActive; FTSelectA.Active := AActive; FTSelectGen.Active := AActive; FTSelectGenA.Active := AActive; end; { TBaseUpdateBasic } procedure TBaseUpdateBasic.Clear; begin if Assigned(FSrcBase) then FreeAndNil(FSrcBase); if Assigned(FDestBase) then FreeAndNil(FDestBase); if Assigned(FUpdateInfoItems) then FreeAndNil(FUpdateInfoItems); FPrewProgressStepIndex := 0; FProgressStepIndex := 0; FProgressStepCount := 0; ProgressStepCountPerPercent := 0; end; constructor TBaseUpdateBasic.Create; begin inherited; FSrcBase := nil; FDestBase := nil; FUpdateInfoItems := nil end; destructor TBaseUpdateBasic.Destroy; begin Clear; inherited; end; procedure TBaseUpdateBasic.IncProgressIndex(AIncValue: Integer); var CanOnProgress: Boolean; begin FPrewProgressStepIndex := FProgressStepIndex; //Inc(FProgressStepIndex); FProgressStepIndex := FProgressStepIndex + AIncValue; if Assigned(FOnProgress) then begin CanOnProgress := true; if (FPrewProgressStepIndex > 0) and (Round(FPrewProgressStepIndex / FProgressStepCount * 100) = Round(FProgressStepIndex / FProgressStepCount * 100)) then CanOnProgress := false; if CanOnProgress then FOnProgress(Self, FProgressStepIndex, FProgressStepCount); end; end; { TBaseUpdater } procedure TBaseUpdater.CorrectCurrencyInSrcBase; var DestObjectID: Integer; DestObjectLevelID: Integer; DstBaseCurrency: TCurrency; DstBaseCurrencyS: TCurrency; SrcBaseCurrency: TCurrency; SrcBaseCurrencyFromDst: TCurrency; ptrObjectCurrencyRel: PObjectCurrencyRel; begin DestObjectID := 0; //if FSrcBase.FSettings.BuildID >= 11 then begin if FUpdateBaseParams.DestObjectGUID <> '' then DestObjectID := GetIntFromTableByGUID(tnCatalog, fnID, FUpdateBaseParams.DestObjectGUID, FDestBase.FQSelect); ZeroMemory(@DstBaseCurrency, SizeOf(TCurrency)); ZeroMemory(@DstBaseCurrencyS, SizeOf(TCurrency)); ZeroMemory(@SrcBaseCurrency, SizeOf(TCurrency)); ZeroMemory(@SrcBaseCurrencyFromDst, SizeOf(TCurrency)); SrcBaseCurrency := GetSrcCurrencyByType(ctMain); //FSrcBase.GetCurrencyByType(ctMain); if SrcBaseCurrency.GUID <> '' then begin //*** Загрузить баз. валюту, и баз. валюту исх. базы из обновляемой базы для обновляемой папки if (DestObjectID > 0) and ((dbtCatalog in FUpdateBaseParams.RequiredDBTypes) or (dbtComponent in FUpdateBaseParams.RequiredDBTypes)) then begin DestObjectLevelID := GetParentCatalogIDByLevel(DestObjectID, dirCurrencyLevel, FDestBase.FQSelect); if DestObjectLevelID > 0 then begin // DstBaseCurrency ptrObjectCurrencyRel := GetObjectCurrencyByMainFld(DestObjectLevelID, ctMain, FDestBase.FQSelect); if ptrObjectCurrencyRel <> nil then begin DstBaseCurrency := ptrObjectCurrencyRel.Data; FreeMem(ptrObjectCurrencyRel); end; // DstBaseCurrencyS ptrObjectCurrencyRel := GetObjectCurrencyByMainFld(DestObjectLevelID, ctSecond, FDestBase.FQSelect); if ptrObjectCurrencyRel <> nil then begin DstBaseCurrencyS := ptrObjectCurrencyRel.Data; FreeMem(ptrObjectCurrencyRel); end; // SrcBaseCurrencyFromDst ptrObjectCurrencyRel := GetObjectCurrencyByGUIDCurrency(DestObjectLevelID, SrcBaseCurrency.GUID, FDestBase.FQSelect); if ptrObjectCurrencyRel <> nil then begin SrcBaseCurrencyFromDst := ptrObjectCurrencyRel.Data; FreeMem(ptrObjectCurrencyRel); end; end; end; //*** Если для папки не удалось найти валюты, то берем валюты по умолчанию if DstBaseCurrency.GUID = '' then DstBaseCurrency := FDestBase.GetCurrencyByType(ctMain, true); if DstBaseCurrencyS.GUID = '' then DstBaseCurrencyS := FDestBase.GetCurrencyByType(ctSecond, true); if SrcBaseCurrencyFromDst.GUID = '' then SrcBaseCurrencyFromDst := GetCurrencyByGUID(SrcBaseCurrency.GUID, FDestBase.FQSelect); if (DstBaseCurrency.GUID <> '') and (SrcBaseCurrencyFromDst.GUID <> '') then ChengeCurrencyRatiosWithPrices(SrcBaseCurrencyFromDst, DstBaseCurrency, DstBaseCurrencyS, FSrcBase.FQSelect, FSrcBase.FQOperat); end; end; end; { procedure TBaseUpdater.CorrectCurrencyInSrcBase; var DestBaseCurrency: TCurrency; SrcBaseCurrency: TCurrency; SrcBaseSecondCurrency: TCurrency; SrcBaseNewCurrency: TCurrency; begin DestBaseCurrency := FDestBase.GetCurrencyByType(ctMain); SrcBaseCurrency := FSrcBase.GetCurrencyByType(ctMain); if DestBaseCurrency.GUID <> SrcBaseCurrency.GUID then begin //*** Проверить - существует ли такая валюта в FSrcBase как тек. в FDestBase SrcBaseNewCurrency := GetCurrencyByGUID(DestBaseCurrency.GUID, FSrcBase.FQSelect); //*** В базе FSrcBase преобразовать глваную валюту в такую как в FDestBase if SrcBaseNewCurrency.GUID <> '' then begin SrcBaseSecondCurrency := GetCurrencyByType(ctSecond, FSrcBase.FQSelect); if SrcBaseSecondCurrency.GUID = '' then SrcBaseSecondCurrency := SrcBaseNewCurrency; ChengeCurrencyRatiosWithPrices(SrcBaseCurrency, SrcBaseNewCurrency, SrcBaseSecondCurrency, FSrcBase.FQSelect, FSrcBase.FQOperat); end; end; end;} procedure TBaseUpdater.CorrectNDSInSrcBase; begin if FDestBase.FSettings.BuildID = 0 then FDestBase.LoadSettings; if FSrcBase.FSettings.BuildID = 0 then FSrcBase.LoadSettings; if Abs(FDestBase.FSettings.NDS - FSrcBase.FSettings.NDS) > cnstCmpNDSDelta then ChangePricesByNDS(FSrcBase.FSettings.NDS, FDestBase.FSettings.NDS, FSrcBase.FQSelect, FSrcBase.FQOperat); end; procedure TBaseUpdater.DefineSortID; var DestIDCatalog: Integer; NewSortID: Integer; begin try DestIDCatalog := GetIntFromTableByGUID(tnCatalog, fnID, FUpdateBaseParams.DestObjectGUID, FDestBase.FQSelect); if DestIDCatalog > 0 then begin NewSortID := 0; case FSrcBase.FSettings.DBType of dbtCatalog: NewSortID := GenCatalogSortIDByIDParent(DestIDCatalog, FDestBase.FQSelect); dbtComponent: NewSortID := GenComponSortIDByIDCatalog(DestIDCatalog, FDestBase.FQSelect); end; if NewSortID > 0 then begin SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, FUpdateBaseParams.SrcTableName, fnGUID+' = :'+fnGUID, nil, fnSortID), false); FDestBase.FQOperat.ParamByName(fnGuid).AsString := FUpdateBaseParams.SrcObjectGUID; FDestBase.FQOperat.ParamByName(fnSortID).AsInteger := NewSortID; FDestBase.FQOperat.ExecQuery; end; end; except on E: Exception do AddExceptionToLogEx('TBaseUpdater.DefineSortID', E.Message); end; end; function TBaseUpdater.GetSrcCurrencyByType(AType: Integer): TCurrency; var ptrObjectCurrency: PObjectCurrencyRel; IDObjectCurencies: Integer; begin ZeroMemory(@Result, SizeOf(TObjectCurrencyRel)); if FSrcBase.FSettings.BuildID < 11 then Result := U_BaseCommon.GetCurrencyByType(AType, FSrcBase.FQSelect) else begin IDObjectCurencies := 0; if dbtCatalog in FUpdateBaseParams.RequiredDBTypes then begin //*** Найти Есть ли в исходной папки валюты if GetObjectCurrencyCount(FUpdateBaseParams.SrcObjectID, FSrcBase.FQSelect) > 0 then IDObjectCurencies := FUpdateBaseParams.SrcObjectID; end; ptrObjectCurrency := GetObjectCurrencyByMainFld(IDObjectCurencies, AType, FSrcBase.FQSelect); if ptrObjectCurrency <> nil then begin Result := ptrObjectCurrency.Data; FreeMem(ptrObjectCurrency); end; end; end; procedure TBaseUpdater.InsertSrcTableToDest(AUpdateTableInfo: TUpdateInfoItem; AUpdateBaseParams: TUpdateBaseParams); var SrcFieldNames: TStringList; DestFieldNames: TStringList; i: Integer; GuidWithNoChangeField: String; NoChangeFieldName: String; NoChangeValue: Variant; CanChangeCurrField: Boolean; FieldValue: Variant; IsComponentTable: Boolean; //FComponCyphers: TStringList; FSrcIndexGUID: Integer; FSrcIndexID: Integer; FTrgIndexID: Integer; FSrcFNIndexes: TStringList; FSrcFNIndex: Integer; FTrgParamIndexes: TStringList; FTrgParamIndex: Integer; StringIndex: Integer; SrcActRowLimit: Integer; SrcActRowLimitIndex: Integer; OldTick, CurrTick: Cardinal; RecNo: integer; strSQLGetComponCypherByGUID: String; IsLoadedSQLGetComponCypherByGUID: Boolean; ProcName: String; SavedQOperatOptions: TpFIBQueryOptions; IsCompPropRelation: Boolean; WasItemExcept: Boolean; begin try ProcName := 'TBaseUpdater.InsertSrcTableToDest'; IsComponentTable := AUpdateTableInfo.TableName = tnComponent; IsCompPropRelation := AUpdateTableInfo.TableName = tnCompPropRelation; IsLoadedSQLGetComponCypherByGUID := false; strSQLGetComponCypherByGUID := ''; if IsComponentTable then begin strSQLGetComponCypherByGUID := GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGuid+' = :'+fnGuid, nil, fnCypher+', '+fnUpdateType); end; SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, '', nil, fnAll)+ 'order by '+fnID); FSrcIndexGUID := FSrcBase.FQSelect.FieldIndex[fnGUID]; FSrcIndexID := FSrcBase.FQSelect.FieldIndex[fnID]; SrcActRowLimitIndex := -1; SrcFieldNames := nil; if AUpdateTableInfo.FieldsToUpdate.Count = 0 then SrcFieldNames := GetFieldNamesFromFIBQuery(FSrcBase.FQSelect) else begin SrcFieldNames := TStringList.Create; SrcFieldNames.AddStrings(AUpdateTableInfo.FieldsToUpdate); end; DestFieldNames := GetTableFieldsNames(AUpdateTableInfo.TableName, FDestBase.FQSelect); //*** Убрать поля, которых нет в обновляемой базе FDestBase RemoveNoAssignedStrings(SrcFieldNames, DestFieldNames); RemoveFromStringList(SrcFieldNames, fnID); RemoveFromStringList(SrcFieldNames, fnDateIn); RemoveFromStringList(SrcFieldNames, fnDateMod); RemoveFromStringList(SrcFieldNames, fnUpdateType); GuidWithNoChangeField := ''; NoChangeFieldName := ''; NoChangeValue := null; //*** Если загрузка из файла папки, которая уже существует, то // Определить поле с GUID-ом, которое нельзя поменять if (AUpdateTableInfo.TableName = tnCatalog) and (AUpdateBaseParams.SrcDBType = dbtCatalog) and (AUpdateBaseParams.UpdateNodeResult = unrUpdate) then begin GuidWithNoChangeField := AUpdateBaseParams.SrcObjectGUID; NoChangeFieldName := fnParentID; end; // Определить не изменяемое значение if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then begin SetSQlToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGUID+' = '''+GuidWithNoChangeField+'''', nil, NoChangeFieldName)); NoChangeValue := FDestBase.FQSelect.Fields[0].Value; end; FSrcFNIndexes := CreateStringListSorted; FTrgParamIndexes := CreateStringListSorted; WasItemExcept := false; try if FSrcBase.FQSelect.RecordCount > 0 then begin RecNo := 0; //SavedQOperatOptions := FDestBase.FQOperat.Options; //FDestBase.FQOperat.Options := FDestBase.FQOperat.Options - [qoAutoCommit, qoStartTransaction]; //try SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnID+' = :'+fnID, SrcFieldNames, ''), false); //FDestBase.FQOperat.Transaction.StartTransaction; FTrgIndexID := FDestBase.FQOperat.ParamByName(fnID).Index; // for i := 0 to FSrcBase.FQSelect.FieldCount - 1 do StringIndex := FSrcFNIndexes.AddObject(FSrcBase.FQSelect.Fields[i].Name, TObject(i)); // for i := 0 to FDestBase.FQOperat.ParamCount - 1 do FTrgParamIndexes.AddObject(FDestBase.FQOperat.Params[i].Name, TObject(i)); while Not FSrcBase.FQSelect.Eof do begin RecNo := RecNo + 1; if (FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString <> '') and (AUpdateTableInfo.FGUIDListDisabled.IndexOf(FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString) = -1) then begin // Определяем значение поля fnActRowLimit SrcActRowLimit := alrNone; if SrcActRowLimitIndex = -1 then begin SrcActRowLimitIndex := FSrcFNIndexes.IndexOf(fnActRowLimit); if SrcActRowLimitIndex <> -1 then SrcActRowLimitIndex := Integer(FSrcFNIndexes.Objects[SrcActRowLimitIndex]) else SrcActRowLimitIndex := -100; end; if SrcActRowLimitIndex >= 0 then SrcActRowLimit := FSrcBase.FQSelect.Fields[SrcActRowLimitIndex].AsInteger; if SrcActRowLimit <> alrSkip then begin try FDestBase.FQOperat.Close; FDestBase.FQOperat.Params[FTrgIndexID].AsInteger := FSrcBase.FQSelect.Fields[FSrcIndexID].AsInteger; {$IF Not Defined(FINAL_SCS)} {if RecNo = 1898 then if IsCompPropRelation then begin EmptyProcedure; Break; //// BREAK //// end;} {$IFEND} for i := 0 to SrcFieldNames.Count - 1 do begin //*** Сущесьвует ли поле в обновляемой базе FTrgParamIndex := FTrgParamIndexes.IndexOf(SrcFieldNames[i]); if FTrgParamIndex <> -1 then FTrgParamIndex := Integer(FTrgParamIndexes.Objects[FTrgParamIndex]); if FTrgParamIndex <> -1 then begin FSrcFNIndex := FSrcFNIndexes.IndexOf(SrcFieldNames[i]); if FSrcFNIndex <> -1 then FSrcFNIndex := Integer(FSrcFNIndexes.Objects[FSrcFNIndex]); //*** Определить может ли менятся значение поля CanChangeCurrField := true; if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then if FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString = GuidWithNoChangeField then if SrcFieldNames[i] = NoChangeFieldName then begin FDestBase.FQOperat.Params[FTrgParamIndex].Value := NoChangeValue; CanChangeCurrField := false; end; if CanChangeCurrField then if FSrcBase.FQSelect.Fields[FSrcFNIndex].SQLType = SQL_BLOB then CopyBlobFromFNToParamInQuery(FDestBase.FQOperat, FSrcBase.FQSelect, SrcFieldNames[i], SrcFieldNames[i]) else begin //if FSrcBase.FQSelect.FN(FieldNames[i]).Value <> null then FieldValue := FSrcBase.FQSelect.Fields[FSrcFNIndex].Value; //*** Учет шыфра компоненты if IsComponentTable and (SrcFieldNames[i] = fnCypher) then begin //*** Проверить, есть ли такой шифр в других компонентах if CheckStrValueInTable(AUpdateTableInfo.TableName, fnCypher, FSrcBase.FQSelect.Fields[FSrcFNIndex].AsString, FSrcBase.FQSelect.Fields[FSrcIndexID].AsInteger, FDestBase.FQSelect) then begin //*** Определить тип обновления записи (новая, или обновление) // Если тип записи "обновдение", то оставить старое значение //SetSQLToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, // fnGuid+' = '''+FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString+'''', nil, fnCypher+', '+fnUpdateType), false); //02.03.2009 strSQL := GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, //02.03.2009 fnGuid+' = :'+fnGuid, nil, fnCypher+', '+fnUpdateType); //02.03.2009 FDestBase.FQSelectA.Close; //02.03.2009 if Not((FDestBase.FQSelectA.SQL.Count = 1) and (FDestBase.FQSelectA.SQL[0] = strSQL)) then //02.03.2009 SetSQLToFIBQuery(FDestBase.FQSelectA, strSQL, false); FDestBase.FQSelectA.Close; if Not IsLoadedSQLGetComponCypherByGUID then begin SetSQLToFIBQuery(FDestBase.FQSelectA, strSQLGetComponCypherByGUID, false); IsLoadedSQLGetComponCypherByGUID := true; end; // fnGuid FDestBase.FQSelectA.Params[0].AsString := FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString; FDestBase.FQSelectA.ExecQuery; if FDestBase.FQSelectA.RecordCount > 0 then begin if FDestBase.FQSelectA.Fields[1].AsInteger = urtUpdate then // fnUpdateType FieldValue := FDestBase.FQSelectA.Fields[0].AsString // fnCypher else if FDestBase.FQSelectA.Fields[1].AsInteger = urtInsert then // fnUpdateType FieldValue := FDestBase.GetComponentNewCypher; end else FieldValue := FDestBase.GetComponentNewCypher; end; end; //*** Занесть знеачение в обновляемую таблицу //if (AUpdateTableInfo.SkipNullValues = biFalse) or (FieldValue <> null) then FDestBase.FQOperat.Params[FTrgParamIndex].Value := FieldValue end; end; end; FDestBase.FQOperat.ExecQuery; {$IF Not Defined(FINAL_SCS)} {if RecNo = 1897 then if IsCompPropRelation then begin EmptyProcedure; //Break; //// BREAK //// end;} {$IFEND} except on E: Exception do begin if Not WasItemExcept then AddExceptionToLogEx(ProcName, E.Message); WasItemExcept := true; end; end; end; end; FSrcBase.FQSelect.Next; IncProgressIndex; end; //FDestBase.FQOperat.Transaction.Commit; FDestBase.FQOperat.Close; //finally // FDestBase.FQOperat.Options := SavedQOperatOptions; //end; end; finally FSrcFNIndexes.Free; FTrgParamIndexes.Free; SrcFieldNames.Free; DestFieldNames.Free; end; except on E: Exception do AddExceptionToLog(ProcName+': '+E.Message); end; end; {//04.03.2009 procedure TBaseUpdater.InsertSrcTableToDest(AUpdateTableInfo: TUpdateInfoItem; AUpdateBaseParams: TUpdateBaseParams); var SrcFieldNames: TStringList; DestFieldNames: TStringList; i: Integer; GuidWithNoChangeField: String; NoChangeFieldName: String; NoChangeValue: Variant; CanChangeCurrField: Boolean; FieldValue: Variant; IsComponentTable: Boolean; FSrcIndexGUID: Integer; FSrcIndexID: Integer; RecNo: integer; strSQLGetComponCypherByGUID: String; IsLoadedSQLGetComponCypherByGUID: Boolean; ProcName: String; begin try ProcName := 'TBaseUpdater.InsertSrcTableToDest'; IsComponentTable := AUpdateTableInfo.TableName = tnComponent; IsLoadedSQLGetComponCypherByGUID := false; strSQLGetComponCypherByGUID := ''; if IsComponentTable then strSQLGetComponCypherByGUID := GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGuid+' = :'+fnGuid, nil, fnCypher+', '+fnUpdateType); SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, '', nil, fnAll)+ 'order by '+fnID); FSrcIndexGUID := FSrcBase.FQSelect.FieldIndex[fnGUID]; FSrcIndexID := FSrcBase.FQSelect.FieldIndex[fnID]; SrcFieldNames := nil; if AUpdateTableInfo.FieldsToUpdate.Count = 0 then SrcFieldNames := GetFieldNamesFromFIBQuery(FSrcBase.FQSelect) else begin SrcFieldNames := TStringList.Create; SrcFieldNames.AddStrings(AUpdateTableInfo.FieldsToUpdate); end; DestFieldNames := GetTableFieldsNames(AUpdateTableInfo.TableName, FDestBase.FQSelect); //*** Убрать поля, которых нет в обновляемой базе FDestBase RemoveNoAssignedStrings(SrcFieldNames, DestFieldNames); RemoveFromStringList(SrcFieldNames, fnID); RemoveFromStringList(SrcFieldNames, fnDateIn); RemoveFromStringList(SrcFieldNames, fnDateMod); RemoveFromStringList(SrcFieldNames, fnUpdateType); GuidWithNoChangeField := ''; NoChangeFieldName := ''; NoChangeValue := null; //*** Если загрузка из файла папки, которая уже существует, то // Определить поле с GUID-ом, которое нельзя поменять if (AUpdateTableInfo.TableName = tnCatalog) and (AUpdateBaseParams.SrcDBType = dbtCatalog) and (AUpdateBaseParams.UpdateNodeResult = unrUpdate) then begin GuidWithNoChangeField := AUpdateBaseParams.SrcObjectGUID; NoChangeFieldName := fnParentID; end; // Определить не изменяемое значение if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then begin SetSQlToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGUID+' = '''+GuidWithNoChangeField+'''', nil, NoChangeFieldName)); NoChangeValue := FDestBase.FQSelect.FN(NoChangeFieldName).Value; end; try RecNo := 0; SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnID+' = :'+fnID, SrcFieldNames, ''), false); while Not FSrcBase.FQSelect.Eof do begin RecNo := RecNo + 1; if FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString <> '' then begin try FDestBase.FQOperat.Close; FDestBase.FQOperat.ParamByName(fnID).AsInteger := FSrcBase.FQSelect.Fields[FSrcIndexID].AsInteger; for i := 0 to SrcFieldNames.Count - 1 do //*** Сущесьвует ли поле в обновляемой базе if FDestBase.FQOperat.ParamByName(SrcFieldNames[i]) <> nil then begin //*** Определить может ли менятся значение поля CanChangeCurrField := true; if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then if FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString = GuidWithNoChangeField then if SrcFieldNames[i] = NoChangeFieldName then begin FDestBase.FQOperat.ParamByName(SrcFieldNames[i]).Value := NoChangeValue; CanChangeCurrField := false; end; if CanChangeCurrField then if FSrcBase.FQSelect.FN(SrcFieldNames[i]).SQLType = SQL_BLOB then CopyBlobFromFNToParamInQuery(FDestBase.FQOperat, FSrcBase.FQSelect, SrcFieldNames[i], SrcFieldNames[i]) else begin //if FSrcBase.FQSelect.FN(FieldNames[i]).Value <> null then FieldValue := FSrcBase.FQSelect.FN(SrcFieldNames[i]).Value; //*** Учет шыфра компоненты if IsComponentTable and (SrcFieldNames[i] = fnCypher) then begin //*** Проверить, есть ли такой шифр в других компонентах if CheckStrValueInTable(AUpdateTableInfo.TableName, fnCypher, FSrcBase.FQSelect.FN(SrcFieldNames[i]).AsString, FSrcBase.FQSelect.Fields[FSrcIndexID].AsInteger, FDestBase.FQSelect) then begin //*** Определить тип обновления записи (новая, или обновление) // Если тип записи "обновдение", то оставить старое значение //SetSQLToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, // fnGuid+' = '''+FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString+'''', nil, fnCypher+', '+fnUpdateType), false); //02.03.2009 strSQL := GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, //02.03.2009 fnGuid+' = :'+fnGuid, nil, fnCypher+', '+fnUpdateType); //02.03.2009 FDestBase.FQSelectA.Close; //02.03.2009 if Not((FDestBase.FQSelectA.SQL.Count = 1) and (FDestBase.FQSelectA.SQL[0] = strSQL)) then //02.03.2009 SetSQLToFIBQuery(FDestBase.FQSelectA, strSQL, false); FDestBase.FQSelectA.Close; if Not IsLoadedSQLGetComponCypherByGUID then begin SetSQLToFIBQuery(FDestBase.FQSelectA, strSQLGetComponCypherByGUID, false); IsLoadedSQLGetComponCypherByGUID := true; end; // fnGuid FDestBase.FQSelectA.Params[0].AsString := FSrcBase.FQSelect.Fields[FSrcIndexGUID].AsString; FDestBase.FQSelectA.ExecQuery; if FDestBase.FQSelectA.RecordCount > 0 then begin if FDestBase.FQSelectA.Fields[1].AsInteger = urtUpdate then // fnUpdateType FieldValue := FDestBase.FQSelectA.Fields[0].AsString // fnCypher else if FDestBase.FQSelectA.Fields[1].AsInteger = urtInsert then // fnUpdateType FieldValue := FDestBase.GetComponentNewCypher; end else FieldValue := FDestBase.GetComponentNewCypher; end; end; //*** Занесть знеачение в обновляемую таблицу //if (AUpdateTableInfo.SkipNullValues = biFalse) or (FieldValue <> null) then FDestBase.FQOperat.ParamByName(SrcFieldNames[i]).Value := FieldValue; end; end; FDestBase.FQOperat.ExecQuery; except on E: Exception do AddExceptionToLogEx(ProcName, E.Message); end; end; FSrcBase.FQSelect.Next; IncProgressIndex; end; finally SrcFieldNames.Free; DestFieldNames.Free; end; except on E: Exception do AddExceptionToLog(ProcName+': '+E.Message); end; end; } { procedure TBaseUpdater.InsertSrcTableToDest(AUpdateTableInfo: TUpdateInfoItem; AUpdateBaseParams: TUpdateBaseParams); var SrcFieldNames: TStringList; DestFieldNames: TStringList; i: Integer; GuidWithNoChangeField: String; NoChangeFieldName: String; NoChangeValue: Variant; CanChangeCurrField: Boolean; FieldValue: Variant; IsComponentTable: Boolean; RecNo: integer; ProcName: String; begin try ProcName := 'TBaseUpdater.InsertSrcTableToDest'; IsComponentTable := AUpdateTableInfo.TableName = tnComponent; SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, '', nil, fnAll)+ 'order by '+fnID); SrcFieldNames := GetFieldNamesFromFIBQuery(FSrcBase.FQSelect); DestFieldNames := GetTableFieldsNames(AUpdateTableInfo.TableName, FDestBase.FQSelect); //*** Убрать поля, которых нет в обновляемой базе FDestBase RemoveNoAssignedStrings(SrcFieldNames, DestFieldNames); RemoveFromStringList(SrcFieldNames, fnID); RemoveFromStringList(SrcFieldNames, fnDateIn); RemoveFromStringList(SrcFieldNames, fnDateMod); RemoveFromStringList(SrcFieldNames, fnUpdateType); GuidWithNoChangeField := ''; NoChangeFieldName := ''; NoChangeValue := null; //*** Если загрузка из файла папки, которая уже существует, то // Определить поле с GUID-ом, которое нельзя поменять if (AUpdateTableInfo.TableName = tnCatalog) and (AUpdateBaseParams.SrcDBType = dbtCatalog) and (AUpdateBaseParams.UpdateNodeResult = unrUpdate) then begin GuidWithNoChangeField := AUpdateBaseParams.SrcObjectGUID; NoChangeFieldName := fnParentID; end; // Определить не изменяемое значение if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then begin SetSQlToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGUID+' = '''+GuidWithNoChangeField+'''', nil, NoChangeFieldName)); NoChangeValue := FDestBase.FQSelect.FN(NoChangeFieldName).Value; end; try RecNo := 0; SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnID+' = :'+fnID, SrcFieldNames, ''), false); while Not FSrcBase.FQSelect.Eof do begin RecNo := RecNo + 1; if FSrcBase.FQSelect.FN(fnGuid).AsString <> '' then begin try FDestBase.FQOperat.Close; FDestBase.FQOperat.ParamByName(fnID).AsInteger := FSrcBase.FQSelect.FN(fnID).AsInteger; for i := 0 to SrcFieldNames.Count - 1 do //*** Сущесьвует ли поле в обновляемой базе if FDestBase.FQOperat.ParamByName(SrcFieldNames[i]) <> nil then begin //*** Определить может ли менятся значение поля CanChangeCurrField := true; if (GuidWithNoChangeField <> '') and (NoChangeFieldName <> '') then if FSrcBase.FQSelect.FN(fnGUID).AsString = GuidWithNoChangeField then if SrcFieldNames[i] = NoChangeFieldName then begin FDestBase.FQOperat.ParamByName(SrcFieldNames[i]).Value := NoChangeValue; CanChangeCurrField := false; end; if CanChangeCurrField then if FSrcBase.FQSelect.FN(SrcFieldNames[i]).SQLType = SQL_BLOB then CopyBlobFromFNToParamInQuery(FDestBase.FQOperat, FSrcBase.FQSelect, SrcFieldNames[i], SrcFieldNames[i]) else begin //if FSrcBase.FQSelect.FN(FieldNames[i]).Value <> null then FieldValue := FSrcBase.FQSelect.FN(SrcFieldNames[i]).Value; //*** Учет шыфра компоненты if IsComponentTable and (SrcFieldNames[i] = fnCypher) then begin //*** Проверить, есть ли такой шифр в других компонентах if CheckStrValueInTable(AUpdateTableInfo.TableName, fnCypher, FSrcBase.FQSelect.FN(SrcFieldNames[i]).AsString, FSrcBase.FQSelect.FN(fnID).AsInteger, FDestBase.FQSelect) then begin //*** Определить тип обновления записи (новая, или обновление) // Если тип записи "обновдение", то оставить старое значение SetSQLToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGuid+' = '''+FSrcBase.FQSelect.FN(fnGUID).AsString+'''', nil, fnCypher+', '+fnUpdateType)); if FDestBase.FQSelect.RecordCount > 0 then begin if FDestBase.FQSelect.FN(fnUpdateType).AsInteger = urtUpdate then FieldValue := FDestBase.FQSelect.FN(fnCypher).AsString else if FDestBase.FQSelect.FN(fnUpdateType).AsInteger = urtInsert then FieldValue := FDestBase.GetComponentNewCypher; end else FieldValue := FDestBase.GetComponentNewCypher; end; end; //*** Занесть знеачение в обновляемую таблицу FDestBase.FQOperat.ParamByName(SrcFieldNames[i]).Value := FieldValue; end; end; FDestBase.FQOperat.ExecQuery; except on E: Exception do AddExceptionToLogEx(ProcName, E.Message); end; end; FSrcBase.FQSelect.Next; IncProgressIndex; end; finally SrcFieldNames.Free; DestFieldNames.Free; end; except on E: Exception do AddExceptionToLog(ProcName+': '+E.Message); end; end; } procedure TBaseUpdater.InsertSrcBaseToDest(AUpdateBaseParams: TUpdateBaseParams); var i: Integer; UpdateInfoItem: TUpdateInfoItem; begin {$IF Not Defined(FINAL_SCS)} //for i := 0 to FUpdateInfoItems.Count - 1 do //for i := 0 to 15 - 1 do {$ELSE} //for i := 0 to FUpdateInfoItems.Count - 1 do {$IFEND} for i := 0 to FUpdateInfoItems.Count - 1 do begin UpdateInfoItem := FUpdateInfoItems[i]; InsertSrcTableToDest(UpdateInfoItem, AUpdateBaseParams); end; end; procedure TBaseUpdater.SetCatalogForOutComponents(ASrcDBName, ANodeTableName: String; AUpdateBaseParams: TUpdateBaseParams); var IDOutCompons: TIntList; DestIDCatalog: Integer; IDCatalogForOutCompons: Integer; FieldsToInsertCatalog: TStringList; FieldsToInsertCatalogRelation: TStringList; i: Integer; SavedQOperatOptions: TpFIBQueryOptions; //OldTick, CurrTick: Cardinal; begin try //*** Отобрать компоненты которые не находятся в папках SetSQLToFIBQuery(FDestBase.FQSelect, 'select '+fnID+' from '+tnComponent+' '+ 'where Not('+fnIsTemplate+' = '''+IntToStr(biTrue)+''') and '+ 'Not(id in (select '+fnIDComponent+' from '+tnCatalogRelation+')) '); if FDestBase.FQSelect.RecordCount > 0 then begin IDOutCompons := TIntList.Create; FieldsToInsertCatalog := TStringList.Create; FieldsToInsertCatalogRelation := TStringList.Create; try IntFIBFieldToIntList(IDOutCompons, FDestBase.FQSelect, fnID); DestIDCatalog := 0; case FSrcBase.FSettings.DBType of dbtCatalog: DestIDCatalog := GetIntFromTableByGUID(tnCatalog, fnID, AUpdateBaseParams.SrcObjectGUID, FDestBase.FQSelect); else DestIDCatalog := GetIntFromTableByGUID(tnCatalog, fnID, AUpdateBaseParams.DestObjectGUID, FDestBase.FQSelect); end; //*** Создать папку для безпапковых компонент FieldsToInsertCatalog.Add(fnParentID); FieldsToInsertCatalog.Add(fnName); FieldsToInsertCatalog.Add(fnIDItemType); SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtInsert, tnCatalog, '', FieldsToInsertCatalog, ''), false); FDestBase.FQOperat.ParamByName(fnParentID).AsInteger := DestIDCatalog; FDestBase.FQOperat.ParamByName(fnName).AsString := cBaseUpdater_Msg1+' '+ExtractFileName(ASrcDBName)+' ('+DateToStr(Date)+')'; FDestBase.FQOperat.ParamByName(fnIDItemType).AsInteger := itDir; FDestBase.FQOperat.ExecQuery; IDCatalogForOutCompons := GenIDFromTable(FDestBase.FQSelect, gnKatalogID, 0); //*** Добавить комп-ты в созданную папку FieldsToInsertCatalogRelation.Add(fnGUID); FieldsToInsertCatalogRelation.Add(fnIDCatalog); FieldsToInsertCatalogRelation.Add(fnIDComponent); if IDOutCompons.Count > 0 then begin //if IDOutCompons.Count >= ReservGuidSize then // StoreGuidsInReservGuidTable(FDestBase.FDataBase, // ReservGuidSize * (RoundUp(IDOutCompons.Count / ReservGuidSize)+1)); SavedQOperatOptions := FDestBase.FQOperat.Options; FDestBase.FQOperat.Close; FDestBase.FQOperat.Options := FDestBase.FQOperat.Options - [qoAutoCommit, qoStartTransaction]; try SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtInsert, tnCatalogRelation, '', FieldsToInsertCatalogRelation, ''), false); FDestBase.FQOperat.Transaction.StartTransaction; //OldTick := GetTickCount; FDestBase.FQOperat.Params[1].AsInteger := IDCatalogForOutCompons; for i := 0 to IDOutCompons.Count - 1 do begin //FDestBase.FQOperat.Close; FDestBase.FQOperat.Params[0].AsString := CreateGUID; FDestBase.FQOperat.Params[2].AsInteger := Integer(IDOutCompons.List.List^[i]); //IDOutCompons[i]; FDestBase.FQOperat.ExecQuery; end; //CurrTick := GetTickCount - OldTick; FDestBase.FQOperat.Transaction.Commit; FDestBase.FQOperat.Close; finally FDestBase.FQOperat.Options := SavedQOperatOptions; end; end; finally IDOutCompons.Free; FieldsToInsertCatalog.Free; FieldsToInsertCatalogRelation.Free; end; end; except on E: Exception do AddExceptionToLogEx('TBaseUpdater.SetCatalogForOutComponents', E.Message); end; end; procedure TBaseUpdater.SetSrcBaseIDs; var i: Integer; begin for i := 0 to FUpdateInfoItems.Count - 1 do begin SetSrcTableIDs(FUpdateInfoItems[i]); //IncProgressIndex; end; end; procedure TBaseUpdater.SetSrcTableIDs( AUpdateTableInfo: TUpdateInfoItem); var GUIDList: TStringList; NewGUID: String; IDList: TIntList; IDListToDelete: TIntList; ActRowLimitList: TIntList; FldActRowLimit: String; DestID: Integer; SrcID: Integer; SrcActRowLimit: Integer; UniqueIDBetweenBases: Integer; ItemIndex: Integer; SrcGUID: String; UpdateRecordType: Integer; InsertFieldNames: TStringList; //IsSelectedDestTableRecord: Boolean; IsExistsGUID: Boolean; i: Integer; begin try InsertFieldNames := TStringList.Create; InsertFieldNames.Add(fnID); InsertFieldNames.Add(fnGUID); InsertFieldNames.Add(fnUpdateType); GUIDList := TStringList.Create; IDList := TIntList.Create; ActRowLimitList := TIntList.Create; IDListToDelete := TIntList.Create; try FldActRowLimit := ''; if CheckFieldInTable(AUpdateTableInfo.TableName, fnActRowLimit, FSrcBase.FQSelect) then FldActRowLimit := snCommaS + fnActRowLimit; SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, '', nil, fnID+', '+fnGUID + FldActRowLimit)+ ' order by '+fnID); while Not FSrcBase.FQSelect.Eof do begin GUIDList.Add(FSrcBase.FQSelect.Fields[1].AsString); //GUIDList.Add(FSrcBase.FQSelect.FN(fnGUID).AsString); IDList.Add(FSrcBase.FQSelect.Fields[0].AsInteger); if FldActRowLimit <> '' then ActRowLimitList.Add(FSrcBase.FQSelect.Fields[2].AsInteger) else ActRowLimitList.Add(alrNone); FSrcBase.FQSelect.Next; end; FSrcBase.FQSelect.Close; //*** Если таблица не справочник, и не для обновления, то все записи как новые если такие уже есть if (AUpdateTableInfo.IsDirectory = biFalse) and (AUpdateTableInfo.ActLimit <> altUpdate) then begin // Скрипт обновления GUID ов //SetSQLToFIBQuery(FSrcBase.FQUpdate, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, 'NEW_GUID'), false); SetSQLToFIBQuery(FSrcBase.FQUpdate, 'update '+AUpdateTableInfo.TableName+' set '+fnGUID+' = :NEW_GUID '+ 'where '+fnGUID+' = :'+fnGuid, false); // Скрипт проверки существования такого GUID SetSQLToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, fnID), false); for i := 0 to GUIDList.Count - 1 do begin SrcActRowLimit := ActRowLimitList[i]; if SrcActRowLimit <> alrSkip then begin FDestBase.FQSelect.Params[0].AsString := GUIDList[i]; FDestBase.FQSelect.ExecQuery; IsExistsGUID := FDestBase.FQSelect.RecordCount > 0; FDestBase.FQSelect.Close; if IsExistsGUID then begin if SrcActRowLimit <> alrInsIfNoExist then begin NewGUID := CreateGUID; if AUpdateTableInfo.IsMainTable then if FUpdateBaseParams.SrcObjectGUID = GUIDList[i] then FUpdateBaseParams.SrcObjectGUID := NewGUID; FSrcBase.FQUpdate.Close; //*** Old GUID FSrcBase.FQUpdate.Params[1].AsString := GUIDList[i]; //*** New GUID FSrcBase.FQUpdate.Params[0].AsString := NewGUID; FSrcBase.FQUpdate.ExecQuery; GUIDList[i] := NewGUID; end else begin if GetValueIndexFromSortedIntList(IDList[i], IDListToDelete) = -1 then InsertValueToSortetIntList(IDList[i], IDListToDelete); end; end; end; end; end //17.03.2009 else // Если таблица не обновляется то с источника удаляем записи которые есть в обновляемой базе - (ээо если справочник) if (AUpdateTableInfo.UpdateAllData = biFalse) and (AUpdateTableInfo.ActLimit <> altUpdate) then begin //// Скрипт удаления //SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQlByParams(qtDelete, AUpdateTableInfo.TableName, fnID+' = :'+fnID, nil, ''), false); // Скрипт проверки существования такого GUID SetSQLToFIBQuery(FDestBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, fnID), false); i := 0; while i <= (GUIDList.Count - 1) do begin FDestBase.FQSelect.Params[0].AsString := GUIDList[i]; FDestBase.FQSelect.ExecQuery; IsExistsGUID := FDestBase.FQSelect.RecordCount > 0; FDestBase.FQSelect.Close; if IsExistsGUID then begin //FSrcBase.FQOperat.Close; ////*** GUID //FSrcBase.FQOperat.Params[0].AsInteger := IDList[i]; //FSrcBase.FQOperat.ExecQuery; //GUIDList.Delete(i); //IDList.Delete(i); //Continue; //// CONTINUE //// AUpdateTableInfo.FGUIDListDisabled.Add(GUIDList[i]); end; i := i + 1; end; end; if IDListToDelete.Count > 0 then begin // Скрипт удаления SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQlByParams(qtDelete, AUpdateTableInfo.TableName, fnID+' = :'+fnID, nil, ''), false); for i := 0 to IDListToDelete.Count - 1 do begin ItemIndex := IDList.IndexOf(IDListToDelete[i]); if ItemIndex <> -1 then begin GUIDList.Delete(ItemIndex); IDList.Delete(ItemIndex); end; FSrcBase.FQOperat.Close; FSrcBase.FQOperat.Params[0].AsInteger := IDListToDelete[i]; FSrcBase.FQOperat.ExecQuery; end; end; SetSQLToFIBQuery(FDestBase.FQInsert, GetSQLByParams(qtInsert, AUpdateTableInfo.TableName, '', InsertFieldNames, ''), false); SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, fnUpdateType), false); //03.03.2009 SetSQLToFIBQuery(FDestBase.FQUpdate, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, fnID), false); SetSQLToFIBQuery(FSrcBase.FQUpdate, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = :'+fnGUID, nil, fnID), false); for i := 0 to GUIDList.Count - 1 do begin SrcGUID := ''; SrcID := 0; UpdateRecordType := urtNone; SrcGUID := GUIDList[i]; SrcID := IDList[i]; DestID := 0; if SrcGUID <> '' then // принимать не пустые гуиды begin //*** Найти такую запись в целевой базе if Not FDestBase.SelectTableRecordByGUID(AUpdateTableInfo.TableName, SrcGUID) then begin if (AUpdateTableInfo.ActLimit = altNone) or (AUpdateTableInfo.ActLimit = altInsert) then if ActRowLimitList[i] <> alrSkip then begin UniqueIDBetweenBases := GenUniqueIDBetweenBases(AUpdateTableInfo, 0, IDList); FDestBase.FQInsert.Close; FDestBase.FQInsert.Params[0].AsInteger := UniqueIDBetweenBases; // fnID FDestBase.FQInsert.Params[1].AsString := SrcGUID; // fnGUID FDestBase.FQInsert.Params[2].AsInteger := urtInsert; // fnUpdateType FDestBase.FQInsert.ExecQuery; FDestBase.FQInsert.Close; AUpdateTableInfo.FNewIDs.Add(UniqueIDBetweenBases); //*** Заменить старый ID в блоке обновленияs новым сгенерированным ID if SrcID <> 0 then begin FSrcBase.FQUpdate.Close; FSrcBase.FQUpdate.Params[1].AsString := SrcGUID; // fnGuid FSrcBase.FQUpdate.Params[0].AsInteger := UniqueIDBetweenBases; // fnID FSrcBase.FQUpdate.ExecQuery; FSrcBase.FQUpdate.Close; end; end else EmptyProcedure; end else begin if (AUpdateTableInfo.ActLimit = altNone) or (AUpdateTableInfo.ActLimit = altUpdate) then begin DestID := FDestBase.FQSelect.FN(fnID).AsInteger; // Внести UPDATE_TYPE = urtUpdate //SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = '''+SrcGUID+'''', nil, fnUpdateType), false); FDestBase.FQOperat.Close; FDestBase.FQOperat.Params[1].AsString := SrcGUID; // fnGUID FDestBase.FQOperat.Params[0].AsInteger := urtUpdate; //fnUpdateType FDestBase.FQOperat.ExecQuery; FDestBase.FQOperat.Close; //*** Заменить старый ID в блоке обновленияs новым сгенерированным ID if DestID <> SrcID then begin UniqueIDBetweenBases := GenUniqueIDBetweenBases(AUpdateTableInfo, DestID, IDList); {//03.03.2009 //SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = '''+SrcGUID+'''', nil, fnID), false); FDestBase.FQUpdate.Close; FDestBase.FQUpdate.ParamByName(fnGUID).AsString := SrcGUID; FDestBase.FQUpdate.ParamByName(fnID).AsInteger := UniqueIDBetweenBases; FDestBase.FQUpdate.ExecQuery; FDestBase.FQUpdate.Close; //SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = '''+SrcGUID+'''', nil, fnID), false); FSrcBase.FQUpdate.Close; FSrcBase.FQUpdate.ParamByName(fnGuid).AsString := SrcGUID; FSrcBase.FQUpdate.ParamByName(fnID).AsInteger := UniqueIDBetweenBases; FSrcBase.FQUpdate.ExecQuery; FSrcBase.FQUpdate.Close; } FSrcBase.FQUpdate.Close; FSrcBase.FQUpdate.Params[1].AsString := SrcGUID; // fnGuid FSrcBase.FQUpdate.Params[0].AsInteger := UniqueIDBetweenBases; // fnID FSrcBase.FQUpdate.ExecQuery; FSrcBase.FQUpdate.Close; end; end; end; FSrcBase.FQUpdate.Close; {//*** Изменить ID в исходной таблице if DestID <> 0 then begin SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnGUID+' = '''+SrcGUID+'''', nil, fnID), false); FSrcBase.FQOperat.ParamByName(fnID).AsInteger := DestID; FSrcBase.FQOperat.ExecQuery; end;} end; IncProgressIndex; end; finally GUIDList.Free; IDList.Free; InsertFieldNames.Free; ActRowLimitList.Free; IDListToDelete.Free; end; except on E: Exception do AddExceptionToLog('TBaseUpdater.SetSrcTableIDs: '+E.Message); end; end; function TBaseUpdater.UpdateBase(const ASrcDBName, ASrcDBNameOriginal, ADestDBName: String; var AUpdateBaseParams: TUpdateBaseParams; ASetBusyParams: Boolean; ABusyType: Integer; ACreateSrcTmp: Boolean): TUpdateBaseResults; var SrcWorkDBName: String; UpdateStructInfo: TUpdateStructInfo; NodeTableName: String; WasCopied: Boolean; SrcDBNameOriginal: String; // Tolik 238/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // begin Result := []; FUpdateBaseParams := AUpdateBaseParams; UpdateStructInfo := nil; //// Существует целевая база //if Not FileExists(ADestDBName) then // Result := Result + [ubrTrgBaseNotExist]; // Существует исходная база if Not FileExists(ASrcDBName) then Result := Result + [ubrSrcBaseNotExist]; // базы указывают на один файл if ADestDBName = ASrcDBName then Result := Result + [ubrSameBases]; if Result <> [] then Exit; ///// EXIT ///// Clear; FDestBase := TBase.Create(F_NormBase.DM.ConnectParams); FDestBase.Open(ADestDBName); if Not FDestBase.Active then Result := Result + [ubrTrgBaseOpenError]; if Result <> [] then Exit; ///// EXIT ///// //SrcWorkDBName := ExtractFileDir(Application.ExeName)+'\'+dnTemp+'\'+ TempDBName; SrcWorkDBName := ASrcDBName; if ACreateSrcTmp then SrcWorkDBName := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + TempDBName); SrcDBNameOriginal := ASrcDBNameOriginal; if SrcDBNameOriginal = '' then SrcDBNameOriginal := ASrcDBName; if Result = [] then begin SetBusyParamsToBase(FDestBase.FQSelect, FDestBase.FQOperat, ABusyType); try BeginProgress; try WasCopied := true; if ACreateSrcTmp then WasCopied := CopyBase(ASrcDBName, SrcWorkDBName); finally EndProgress; end; if WasCopied then begin BeginProgress; try if CheckPakedFile(SrcWorkDBName) then UnPakFile(SrcWorkDBName); finally EndProgress; end; Application.ProcessMessages; FSrcBase := TBase.Create(F_NormBase.DM.ConnectParams){(F_NormBase.DM.DatabaseSrc)}; FSrcBase.Open(SrcWorkDBName); //Application.ProcessMessages; //FSrcBase.FDataBase.UserNames.Count; try if Not FSrcBase.Active then Result := Result + [ubrSrcBaseOpenError]; //*** Загрузка данных FSrcBase.LoadSettings; //*** Проверить, является ли файл нормативной базой if FSrcBase.FSettings.DBName <> bnNB then begin Result := Result + [ubrSrcIsNoNB]; Exit; ///// EXIT ///// end; //*** Проверить, соответствует ли блок обновления запрашиваемому типу if Not (FSrcBase.FSettings.DBType in FUpdateBaseParams.RequiredDBTypes) then begin Result := Result + [ubrSrcIsNoProperRequired]; Exit; ///// EXIT ///// end; FDestBase.LoadSettings; UpdateStructInfo := FSrcBase.GetUpdStructInfo; FProgressStepCount := UpdateStructInfo.Count; FUpdateInfoItems := FSrcBase.GetUpdateInfo; if FSrcBase.FSettings.DBType in [dbtCatalog, dbtComponent] then begin //FUpdateInfoItems.RemoveItemsByUpdAllDataFld; NodeTableName := GetTableNameByDBType(FSrcBase.FSettings.DBType); FUpdateBaseParams.SrcDBType := FSrcBase.FSettings.DBType; FUpdateBaseParams.SrcTableName := NodeTableName; //17.03.2009 ControlForExistingNodeRecord(NodeTableName, FUpdateBaseParams); //17.03.2009 if FUpdateBaseParams.UpdateNodeResult in [unrGoToExistsObject, unrCancel, unrNoExistsRecord] then //17.03.2009 Exit; ///// EXIT ///// end; FProgressTitle := cBaseUpdater_Msg2_3; if FUpdateBaseParams.UpdateBaseMode = ubmUpdate then FProgressTitle := cBaseUpdater_Msg2_3 else case FSrcBase.FSettings.DBType of dbtCatalog: FProgressTitle := cBaseUpdater_Msg2_1; dbtComponent: FProgressTitle := cBaseUpdater_Msg2_2; end; FProgressStepCount := FProgressStepCount + FUpdateInfoItems.RecordCount * 2; //FUpdateInfoItems.Count * 2; if FSrcBase.FSettings.DBType in [dbtCatalog, dbtComponent] then try FProgressStepCount := FProgressStepCount - FUpdateInfoItems.GetItemsCountByUpdAllDataFld * 2; except end; // на этом этапе FProgressStepCount составляет 87% (остальные идут на коррекцию структуры, определение кол-ва комплектующих...) // приводим FProgressStepCount для 100% if FUpdateBaseParams.UpdateBaseMode <> ubmUpdate then FProgressStepCount := Round(FProgressStepCount/87 * 100) else // тут еще нужно определить свойства сечения для кабелей и каналов FProgressStepCount := Round(FProgressStepCount/82 * 100); ProgressStepCountPerPercent := Trunc(FProgressStepCount/100); //04.03.2009 //*** для UpdateStructure //04.03.2009 Inc(FProgressStepCount); FDestBase.OnUpdateStructureItem := DestBaseUpdateStructure; if Assigned(FOnStartProgress) then FOnStartProgress(Self, FProgressStepIndex, FProgressStepCount); //*** подкоррекировать структуру исходной базы FSrcBase.CorrectStructure; IncProgressIndex(ProgressStepCountPerPercent * 1); //*** Обновить структуру обновляемой базы FDestBase.UpdateStructure(UpdateStructInfo); IncProgressIndex(ProgressStepCountPerPercent * 1); // Определить GUID объекта в исходной базе if FSrcBase.FSettings.DBType in [dbtCatalog, dbtComponent] then begin ControlForExistingNodeRecord(NodeTableName, FUpdateBaseParams); if FUpdateBaseParams.UpdateNodeResult in [unrGoToExistsObject, unrCancel, unrNoExistsRecord] then Exit; ///// EXIT ///// end; CorrectCurrencyInSrcBase; IncProgressIndex(ProgressStepCountPerPercent * 1); CorrectNDSInSrcBase; IncProgressIndex(ProgressStepCountPerPercent * 1); if FSrcBase.FSettings.DBType in [dbtCatalog, dbtComponent] then FUpdateInfoItems.RemoveItemsByUpdAllDataFld; OldTick := GetTickCount; SetSrcBaseIDs; InsertSrcBaseToDest(FUpdateBaseParams); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //*** При добавлении ветви из файла, if FSrcBase.FSettings.DBType in [dbtCatalog, dbtComponent] then begin if FUpdateBaseParams.UpdateNodeResult = unrNew then begin AddNewNodeToCatalogTable(NodeTableName, FUpdateBaseParams); end; SetCatalogForOutComponents(SrcDBNameOriginal, NodeTableName, FUpdateBaseParams); end; IncProgressIndex(ProgressStepCountPerPercent * 1); OldTick := GetTickCount; //*** Определить SortID DefineSortID; IncProgressIndex(ProgressStepCountPerPercent * 1); //*** коректировка значений количесв компонент и папок DefineComponKolComplects(FDestBase.FQSelect, FDestBase.FQOperat); IncProgressIndex(ProgressStepCountPerPercent * 3); DefineCatalogKolItemsCompons(FDestBase.FQSelect, FDestBase.FQOperat); IncProgressIndex(ProgressStepCountPerPercent * 2); //*** коректировка значений количесв элементов в справочниках DefineDirTypeChildContentCount(FDestBase.FQSelect, FDestBase.FQOperat); IncProgressIndex(ProgressStepCountPerPercent * 1); //*** Определить валюты для тех папок, в которых должны быть, но нету CreateDefCurrenciesForObjectsByLevel(FDestBase.FQSelect, FDestBase.FQOperat); IncProgressIndex(ProgressStepCountPerPercent * 1); if FUpdateBaseParams.UpdateBaseMode = ubmUpdate then begin DefinePropSectionForLineCompons(FDestBase.FQSelect, FDestBase.FQOperat, pnOutSection, GCompTypeSysNameCables, gtMale, true); IncProgressIndex(ProgressStepCountPerPercent * 2); DefinePropSectionForLineCompons(FDestBase.FQSelect, FDestBase.FQOperat, pnInSection, GCompTypeSysNameCableChannels, gtFemale, true); IncProgressIndex(ProgressStepCountPerPercent * 2); // На каб канал доб-м св-во внешнее сечение, если есть инетрфейс папа DefinePropSectionForLineCompons(FDestBase.FQSelect, FDestBase.FQOperat, pnOutSection, GCompTypeSysNameCableChannels, gtMale, false); IncProgressIndex(ProgressStepCountPerPercent * 1); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Result := Result + [ubrSuccessful]; if FDestBase.FSettings.BuildID < FSrcBase.FSettings.BuildID then FDestBase.FSettings.BuildID := FSrcBase.FSettings.BuildID; FDestBase.FSettings.NDS := FSrcBase.FSettings.NDS; FDestBase.SaveSettings; finally try if UpdateStructInfo <> nil then UpdateStructInfo.Free; FSrcBase.Close; if ACreateSrcTmp then DeleteFile(SrcWorkDBName); finally if Assigned(FOnEndProgress) then FOnEndProgress(Self, FProgressStepIndex, FProgressStepCount); end; end; end; finally SetBusyParamsToBase(FDestBase.FQSelect, FDestBase.FQOperat, bbmEmpty); FDestBase.Close; {$IF Not Defined(FINAL_SCS)} { Application.ProcessMessages; FDestBase.Open(FDestBase.FDataBase.DBName); FDestBase.FDataBase.FBVersion; Application.ProcessMessages; FDestBase.FDataBase.UserNames; MessageModal('', '', MB_OK);} {$IFEND} end; end; AUpdateBaseParams := FUpdateBaseParams; end; procedure TBaseUpdater.AddNewNodeToCatalogTable(ANodeTableName: String; AUpdateBaseParams: TUpdateBaseParams); var IDCatalog: Integer; NodeTableID: Integer; CatalogRelFields: TStringList; begin try IDCatalog := GetIntFromTableByGUID(tnCatalog, fnID, AUpdateBaseParams.DestObjectGUID, FDestBase.FQSelect); NodeTableID := GetIntFromTableByGUID(ANodeTableName, fnID, AUpdateBaseParams.SrcObjectGUID, FDestBase.FQSelect); case FSrcBase.FSettings.DBType of dbtCatalog: begin SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, tnCatalog, fnID+' = :'+fnID, nil, fnParentID), false); FDestBase.FQOperat.ParamByName(fnID).AsInteger := NodeTableID; FDestBase.FQOperat.ParamByName(fnParentID).AsInteger := IDCatalog; FDestBase.FQOperat.ExecQuery; end; dbtComponent: begin CatalogRelFields := TStringList.Create; CatalogRelFields.Add(fnIDCatalog); CatalogRelFields.Add(fnIDComponent); SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtInsert, tnCatalogRelation, '', CatalogRelFields, ''), false); FDestBase.FQOperat.ParamByName(fnIDCatalog).AsInteger := IDCatalog; FDestBase.FQOperat.ParamByName(fnIDComponent).AsInteger := NodeTableID; FDestBase.FQOperat.ExecQuery; CatalogRelFields.Free; end; end; except on E: Exception do AddExceptionToLogEx('TBaseUpdater.AddNewNodeToCatalogTable', E.Message); end; end; function TBaseUpdater.ControlForExistingNodeRecord(ANodeTableName: String; var AUpdateBaseParams: TUpdateBaseParams): TUpdateNodeResult; var NameFromRecord: String; NodeGuid: String; NewNodeGuid: String; FieldNames: TStringList; UpdateInfoItem: TUpdateInfoItem; begin AUpdateBaseParams.UpdateNodeResult := unrCancel; if ANodeTableName <> '' then begin //*** Найти GUID ветви в блоке обновления NodeGuid := ''; if ANodeTableName = tnCatalog then SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, ANodeTableName, fnParentID+' is null', nil, fnGuid+', '+fnID)) else SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, ANodeTableName, '', nil, fnGuid+', '+fnID)); NodeGuid := FSrcBase.FQSelect.FN(fnGuid).AsString; FSrcBase.FQSelect.Close; if NodeGuid = '' then AUpdateBaseParams.UpdateNodeResult := unrNoExistsRecord else begin AUpdateBaseParams.SrcObjectGUID := NodeGuid; AUpdateBaseParams.SrcObjectID := FSrcBase.FQSelect.FN(fnID).AsInteger; if Not FDestBase.SelectTableRecordByGUID(ANodeTableName, NodeGuid) then AUpdateBaseParams.UpdateNodeResult := unrNew else begin AUpdateBaseParams.UpdateNodeResult := unrNew; // Если такое обновление уже есть if AUpdateBaseParams.UpdateBaseMode = ubmUpdate then AUpdateBaseParams.UpdateNodeResult := unrCancel; //*** Внести инфу в объект, что он обновляемый {NameFromRecord := GetStringFromTableByID(ANodeTableName, fnName, FDestBase.FQSelect.FN(fnID).AsInteger, FDestBase.FQSelect); AUpdateBaseParams.UpdateNodeResult := F_NormBase.F_UpdateNormBaseDialog.Execute(FSrcBase.FSettings.DBType, NameFromRecord); //*** Если существующую запись нужно создать как новую, // просто даем этой записи в блоке обновление новый GUID if AUpdateBaseParams.UpdateNodeResult = unrNew then begin FieldNames := TStringList.Create; try NewNodeGuid := CreateGUID; FieldNames.Add(fnGuid); FieldNames.Add(fnName); SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQLByParams(qtUpdate, ANodeTableName, fnGuid+' = '''+NodeGuid+'''', FieldNames, ''), false); FSrcBase.FQOperat.ParamByName(fnGUID).AsString := NewNodeGuid; FSrcBase.FQOperat.ParamByName(fnName).AsString := F_NormBase.F_UpdateNormBaseDialog.NewName; FSrcBase.FQOperat.ExecQuery; AUpdateBaseParams.SrcObjectGUID := NewNodeGuid; finally FieldNames.Free; end; end;} end; UpdateInfoItem := nil; case FSrcBase.FSettings.DBType of dbtCatalog: UpdateInfoItem := FUpdateInfoItems.GetItemByTableName(tnCatalog); dbtComponent: UpdateInfoItem := FUpdateInfoItems.GetItemByTableName(tnComponent); end; if UpdateInfoItem <> nil then UpdateInfoItem.IsMainTable := true; end; end; Result := AUpdateBaseParams.UpdateNodeResult; end; function TBaseUpdater.GenUniqueIDBetweenBases(AUpdateTableInfo: TUpdateInfoItem; ATrgTableID: Integer; ASrcTableIDs: TIntList): integer; var NewDestID: Integer; IsUniqueID: Boolean; //PredID: Integer; //CurrID: Integer; //NoPresentID: Integer; //BusyIDsInSrcTable: TIntList; //MaxGenIDDestTable: Integer; SavedQOperatOptions: TpFIBQueryOptions; SrcID: Integer; MaxSrcID: Integer; NewSrcID: Integer; NewMaxSrcID: Integer; SrcIDsToShiftCount: Integer; SrcGenValue: Integer; i: Integer; begin Result := -1; try IsUniqueID := false; NewDestID := ATrgTableID; if NewDestID = 0 then NewDestID := GenIDFromTable(FDestBase.FQSelect, AUpdateTableInfo.GeneratorName, 1); Result := NewDestID; if GetValueIndexFromSortedIntList(NewDestID, ASrcTableIDs) = -1 then //04.03.2009 if Not FSrcBase.ExistsIntFieldValue(AUpdateTableInfo.TableName, fnID, NewDestID) then IsUniqueID := true else begin {//*** найти уникальные id-ки в ранее удаленных записях SetSQLToFIBQuery(FDestBase.FQSelect, 'select id from '+AUpdateTableInfo.TableName+' order by id'); PredID := 0; CurrID := 0; while Not FDestBase.FQSelect.Eof do begin PredID := CurrID; CurrID := FDestBase.FQSelect.FN(fnID).AsInteger; if CurrID - PredID > 1 then begin NoPresentID := PredID + 1; if Not FSrcBase.ExistsIntFieldValue(AUpdateTableInfo.TableName, fnID, NoPresentID) then begin Result := NoPresentID; IsUniqueID := true; Break; ///// BREAK ///// end; end; FDestBase.FQSelect.Next; end; } { //03.03.2009 MaxGenIDDestTable := 0; //*** Найти максимальные значение генератора обновляемой базы MaxGenIDDestTable := GenIDFromTable(FDestBase.FQSelectGen, AUpdateTableInfo.GeneratorName, 0); //*** Сформировать список ранее сгенерированиых Id-в в блоке обновления, которые могут // пересикаться с новыми Id-ми обновляемой базы SetSQLToFIBQueryWithCheckSQL(FSrcBase.FQSelect, 'select id from '+AUpdateTableInfo.TableName+' '+ 'where id >= :id', false); FSrcBase.FQSelect.ParamByName(fnID).AsInteger := MaxGenIDDestTable; FSrcBase.FQSelect.ExecQuery; BusyIDsInSrcTable := TIntList.Create; IntFIBFieldToIntList(BusyIDsInSrcTable, FSrcBase.FQSelect, fnID); //*** Если не удалось найти уник. ID, то генерим новый до тех пор, пока он не станет уникальным while Not IsUniqueID do begin NewDestID := GenIDFromTable(FDestBase.FQSelectGen, AUpdateTableInfo.GeneratorName, 1); //if Not FSrcBase.ExistsIntFieldValue(AUpdateTableInfo.TableName, fnID, NewDestID) then if BusyIDsInSrcTable.IndexOf(NewDestID) = -1 then begin Result := NewDestID; IsUniqueID := true; end; end; BusyIDsInSrcTable.Free; } // В списоке определяем ID >= NewDestID из исходной таблицы MaxSrcID := 0; SrcIDsToShiftCount := 0; // ASrcTableIDs - сортированый список по возростанию for i := 0 to ASrcTableIDs.Count - 1 do begin SrcID := ASrcTableIDs[i]; if SrcID >= NewDestID then begin //BusyIDsInSrcTable.Add(SrcID); SrcIDsToShiftCount := SrcIDsToShiftCount + 1; if SrcID > MaxSrcID then MaxSrcID := SrcID; end; end; // Сдвигаем ID-ки исходной таблицы вперед, начиная с самого большего if SrcIDsToShiftCount > 0 then begin NewSrcID := MaxSrcID + SrcIDsToShiftCount + 1; NewMaxSrcID := NewSrcID; SavedQOperatOptions := FSrcBase.FQOperat.Options; FSrcBase.FQOperat.Options := FSrcBase.FQOperat.Options - [qoAutoCommit, qoStartTransaction]; try SetSQLToFIBQuery(FSrcBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnID+' = :'+fnIDOld, nil, fnID), false); FSrcBase.FQOperat.Transaction.StartTransaction; for i := ASrcTableIDs.Count - 1 downto 0 do begin SrcID := ASrcTableIDs[i]; if SrcID >= NewDestID then begin FSrcBase.FQOperat.Close; FSrcBase.FQOperat.Params[0].AsInteger := NewSrcID; FSrcBase.FQOperat.Params[1].AsInteger := SrcID; FSrcBase.FQOperat.ExecQuery; ASrcTableIDs[i] := NewSrcID; NewSrcID := NewSrcID - 1; end; end; FSrcBase.FQOperat.Transaction.Commit; FSrcBase.FQOperat.Close; finally FSrcBase.FQOperat.Options := SavedQOperatOptions; end; // корректируем генератор SrcGenValue := GenIDFromTable(FSrcBase.FQSelect, AUpdateTableInfo.GeneratorName, 0); if NewMaxSrcID > SrcGenValue then GenIDFromTable(FSrcBase.FQSelect, AUpdateTableInfo.GeneratorName, NewMaxSrcID - SrcGenValue + 1); end; end; except on E: Exception do AddExceptionToLogEx('TBaseUpdater.GenUniqueIDBetweenBases', E.Message); end; end; { TMakeUpdateParams } constructor TMakeUpdateParams.Create; begin inherited; DBType := 0; // Тип создаваемого обновления (обычное, папка, компонент) ObjectID := 0; ObjectGUID := ''; // GUID обэекта (папка, компонент), если DBType = (папка, компонент) Mode := ummNone; FldFrom := null; FldTo := null; FUpdateInfoItems := TUpdateInfo.Create; end; destructor TMakeUpdateParams.Destroy; begin FreeAndNil(FUpdateInfoItems); inherited; end; { TBaseUpdateMaker } procedure TBaseUpdateMaker.Clear; begin inherited; //ZeroMemory(@FMakeUpdateParams, SizeOf(TMakeUpdateParams)); FMakeUpdateParams := nil; end; constructor TBaseUpdateMaker.Create; begin inherited; Clear; FTreeTableNames := TStringList.Create; FTreeTableNames.Add(tnCatalog); FTreeTableNames.Add(tnDirectoryType); FTreeTableNames.Add(tnInterfaceType); end; procedure TBaseUpdateMaker.DefinePrices; var SrcIDObjectCurrencies: Integer; TrgIDObjectCurrencies: Integer; TrgObjectID: Integer; SrcCurrencies: TList; UpdateComponTableInfo: TUpdateInfoItem; i: integer; CurrID: Integer; CompoIDs: TIntList; ptrObjectCurrencyM: PObjectCurrencyRel; ptrComponCurrencyM: PObjectCurrencyRel; ptrComponCurrencyMFromObject: PObjectCurrencyRel; begin try if FMakeUpdateParams.DBType in [dbtCatalog, dbtComponent] then begin SrcIDObjectCurrencies := 0; TrgIDObjectCurrencies := 0; //*** Найти ID папки с валютами if FMakeUpdateParams.DBType = dbtComponent then begin SrcIDObjectCurrencies := GetComponCatalogOwnerIDByLevel(FMakeUpdateParams.ObjectID, dirCurrencyLevel, FSrcBase.FQSelect); TrgIDObjectCurrencies := 0; end else if FMakeUpdateParams.DBType = dbtCatalog then begin SrcIDObjectCurrencies := GetParentCatalogIDByLevel(FMakeUpdateParams.ObjectID, dirCurrencyLevel, FSrcBase.FQSelect); if (SrcIDObjectCurrencies < 1) or (SrcIDObjectCurrencies <> FMakeUpdateParams.ObjectID) then TrgIDObjectCurrencies := 0 else TrgIDObjectCurrencies := FMakeUpdateParams.ObjectID; end; SrcCurrencies := nil; //*** Если для папки с компонентой не определены валюты, то вкинуть валюты по умолчанию if SrcIDObjectCurrencies < 1 then SrcCurrencies := GetDefCurrenciesForObject(0, FSrcBase.FQSelect) else begin SrcCurrencies := GetObjectCurrencies(SrcIDObjectCurrencies, FSrcBase.FQSelect); if SrcIDObjectCurrencies <> TrgIDObjectCurrencies then for i := 0 to SrcCurrencies.Count - 1 do PObjectCurrencyRel(SrcCurrencies[i]).IDCatalog := 0; end; //----- Создать валюты, если их нету //*** проверить, есть ли валюты для экспортируемого объекта if GetObjectCurrencyCount(TrgIDObjectCurrencies, FDestBase.FQSelect) = 0 then CreateDefCurrenciesForObject(TrgIDObjectCurrencies, FDestBase.FQSelect, FDestBase.FQOperat, SrcCurrencies); //*** Определить цены компонент if SrcCurrencies <> nil then begin ptrObjectCurrencyM := GetObjectCurrencyByMainFldFromList(ctMain, SrcCurrencies); if ptrObjectCurrencyM <> nil then begin //*** Найти инфу о обновяемых компонентах UpdateComponTableInfo := FUpdateInfoItems.GetItemByTableName(tnComponent); if UpdateComponTableInfo <> nil then begin CompoIDs := TIntList.Create; for i := 0 to UpdateComponTableInfo.FIDListToMakeUpdate.Count - 1 do begin CurrID := UpdateComponTableInfo.FIDListToMakeUpdate[i]; CompoIDs.Clear; CompoIDs.Add(CurrID); //*** найти базовою валюту компоненты ptrComponCurrencyM := GetComponCurrencyByMainFld(CurrID, ctMain, FSrcBase.FQSelect); if ptrComponCurrencyM <> nil then begin if ptrComponCurrencyM.Data.GUID <> ptrObjectCurrencyM.Data.GUID then begin ptrComponCurrencyMFromObject := GetObjectCurrencyByGUIDCurrencyFromList(ptrComponCurrencyM.Data.GUID, SrcCurrencies); if ptrComponCurrencyMFromObject <> nil then begin ChangeComponsCurrencyRatiosWithPrices(CompoIDs, ptrComponCurrencyMFromObject.Data, ptrObjectCurrencyM.Data, FDestBase.FQSelect, FDestBase.FQOperat); end; end; FreeMem(ptrComponCurrencyM); end; end; FreeAndNil(CompoIDs); end; end; // Tolik -- 08/02/2017 -- FreeAndNil(SrcCurrencies); // end; end; except on E: Exception do AddExceptionToLogEx('TBaseUpdateMaker.DefinePrices', E.Message); end; end; destructor TBaseUpdateMaker.Destroy; begin FTreeTableNames.Free; inherited; end; procedure TBaseUpdateMaker.InsertSrcBaseToDest; var i: Integer; begin for i := 0 to FUpdateInfoItems.Count - 1 do begin InsertSrcTableToDest(FUpdateInfoItems[i]); IncProgressIndex; end; end; procedure TBaseUpdateMaker.InsertSrcTableToDest( AUpdateTableInfo: TUpdateInfoItem); var SrcFieldNames: TStringList; DestFieldNames: TStringList; RecNo: Integer; i, j: Integer; CurrID: Integer; HandledExceptionInLoop: Boolean; IndexParamID: Integer; IndexFldID: Integer; IndexFldGUID: Integer; IsCatalog: Boolean; SrcQSelectField: TFIBXSQLVAR; IsDelDataFields: Boolean; SavedQOperatOptions: TpFIBQueryOptions; //SavedQOperatOptions: TpFIBQueryOptions; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin try SrcFieldNames := nil; HandledExceptionInLoop := false; try IsCatalog := (AUpdateTableInfo.TableName = tnCatalog); IsDelDataFields := false; SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, fnID+' = :'+fnID, nil, fnAll), false); RecNo := 0; IndexParamID := -1; IndexFldID := -1; IndexFldGUID := -1; OldTick := GetTickCount; if AUpdateTableInfo.FIDListToMakeUpdate.Count > 0 then begin SavedQOperatOptions := FDestBase.FQOperat.Options; FDestBase.FQOperat.Options := FDestBase.FQOperat.Options - [qoAutoCommit, qoStartTransaction]; try for i := 0 to AUpdateTableInfo.FIDListToMakeUpdate.Count - 1 do begin try CurrID := AUpdateTableInfo.FIDListToMakeUpdate[i]; FSrcBase.FQSelect.Close; //FSrcBase.FQSelect.ParamByName(fnID).AsInteger := CurrID; FSrcBase.FQSelect.Params[0].AsInteger := CurrID; FSrcBase.FQSelect.ExecQuery; if FSrcBase.FQSelect.RecordCount > 0 then begin if IndexFldID = -1 then IndexFldID := FSrcBase.FQSelect.FieldIndex[fnID]; if IndexFldGUID = -1 then IndexFldGUID := FSrcBase.FQSelect.FieldIndex[fnGUID]; if FSrcBase.FQSelect.Fields[IndexFldGUID].AsString <> '' then begin RecNo := RecNo + 1; if SrcFieldNames = nil then begin SrcFieldNames := GetFieldNamesFromFIBQuery(FSrcBase.FQSelect); DestFieldNames := GetTableFieldsNames(AUpdateTableInfo.TableName, FDestBase.FQSelect); //*** Убрать поля, которых нет в создаваемом блоке-базе FDestBase RemoveNoAssignedStrings(SrcFieldNames, DestFieldNames); RemoveFromStringList(SrcFieldNames, fnID); RemoveFromStringList(SrcFieldNames, fnGuid); //18.03.2009 RemoveFromStringList(SrcFieldNames, fnDateIn); RemoveFromStringList(SrcFieldNames, fnDateMod); RemoveFromStringList(SrcFieldNames, fnUpdateType); if IsDelDataFields then begin RemoveFromStringList(SrcFieldNames, fnIDComponent); RemoveFromStringList(SrcFieldNames, fnIDProperty); RemoveFromStringList(SrcFieldNames, fnPValue); RemoveFromStringList(SrcFieldNames, fnTakeIntoConnect); RemoveFromStringList(SrcFieldNames, fnTakeIntoJoin); RemoveFromStringList(SrcFieldNames, fnIsTakeJoinForPoints); RemoveFromStringList(SrcFieldNames, fnIsCrossControl); RemoveFromStringList(SrcFieldNames, fnIDCrossProperty); RemoveFromStringList(SrcFieldNames, fnIsDefault); //RemoveFromStringList(SrcFieldNames, fnSortID); end; SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtUpdate, AUpdateTableInfo.TableName, fnID+' = :'+fnID, SrcFieldNames, ''), false); FDestBase.FQOperat.Transaction.StartTransaction; FDestBase.FQOperat.Prepare; if IndexParamID = -1 then IndexParamID := FDestBase.FQOperat.ParamByName(fnID).Index; end; //FDestBase.FQOperat.Close; FDestBase.FQOperat.Params[IndexParamID].AsInteger := FSrcBase.FQSelect.Fields[IndexFldID].AsInteger; for j := 0 to SrcFieldNames.Count - 1 do //*** Сущесьвует ли поле в обновляемой базе if FDestBase.FQOperat.ParamByName(SrcFieldNames[j]) <> nil then begin SrcQSelectField := FSrcBase.FQSelect.FN(SrcFieldNames[j]); if SrcQSelectField.SQLType = SQL_BLOB then CopyBlobFromFNToParamInQuery(FDestBase.FQOperat, FSrcBase.FQSelect, SrcFieldNames[j], SrcFieldNames[j]) else if FSrcBase.FQSelect.FN(SrcFieldNames[j]).Value = null then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).Value := null else begin if (SrcQSelectField.SQLType = SQL_SHORT) then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).AsShort := FSrcBase.FQSelect.FN(SrcFieldNames[j]).AsShort else if (SrcQSelectField.SQLType = SQL_LONG) then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).AsInteger := FSrcBase.FQSelect.FN(SrcFieldNames[j]).AsInteger else if (SrcQSelectField.SQLType = SQL_FLOAT) then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).AsFloat := FSrcBase.FQSelect.FN(SrcFieldNames[j]).AsFloat else if (SrcQSelectField.SQLType = SQL_VARYING) then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).AsString := FSrcBase.FQSelect.FN(SrcFieldNames[j]).AsString else //if FSrcBase.FQSelect.FN(FieldNames[i]).Value <> null then FDestBase.FQOperat.ParamByName(SrcFieldNames[j]).Value := FSrcBase.FQSelect.FN(SrcFieldNames[j]).Value; end; end; //if RecNo = 1 then // if (FMakeUpdateParams.DBType <> dbtUpdate) and (AUpdateTableInfo.TableName = tnCatalog) then // if FDestBase.FQOperat.ParamByName(fnParentID) <> nil then // FDestBase.FQOperat.ParamByName(fnParentID).Value := null; if IsCatalog then if (FDestBase.FQOperat.ParamByName(fnParentID) <> nil) and (FSrcBase.FQSelect.FN(fnParentID) <> nil) then //if AUpdateTableInfo.FIDListToMakeUpdate.IndexOf(FSrcBase.FQSelect.FN(fnParentID).AsInteger) = -1 then if GetValueIndexFromSortedIntList(FSrcBase.FQSelect.FN(fnParentID).AsInteger, AUpdateTableInfo.FIDListToMakeUpdateSorted) = -1 then FDestBase.FQOperat.ParamByName(fnParentID).Value := null; FDestBase.FQOperat.ExecQuery; // FDestBase.FQOperat.Transaction.CommitRetaining; вызывает тормоза после end; while Not FSrcBase.FQSelect.Eof do FSrcBase.FQSelect.Next; end; except on E: Exception do begin if Not HandledExceptionInLoop then begin AddExceptionToLog('TBaseUpdateMaker.InsertSrcTableToDest: '+E.Message); HandledExceptionInLoop := true; end; end; end; end; FDestBase.FQOperat.Transaction.Commit; //FDestBase.FQOperat.Close; FDestBase.FQOperat.Close; FSrcBase.FQSelect.Close; finally FDestBase.FQOperat.Options := SavedQOperatOptions; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; finally if SrcFieldNames <> nil then SrcFieldNames.Free; end; except on E: Exception do AddExceptionToLog('TBaseUpdateMaker.InsertSrcTableToDest: '+E.Message); end; end; procedure TBaseUpdateMaker.SelectAllGuidesForTable(AUpdateTableInfo: TUpdateInfoItem); var FieldNames: TStringList; begin FieldNames := TStringList.Create; try FieldNames.Add(fnID); FieldNames.Add(fnGUID); SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateTableInfo.TableName, '', FieldNames, '')); while Not FSrcBase.FQSelect.Eof do begin AUpdateTableInfo.AddIDGuid( FSrcBase.FQSelect.FN(fnID).AsInteger, FSrcBase.FQSelect.FN(fnGUID).AsString); FSrcBase.FQSelect.Next; end; finally FieldNames.Free; end; end; procedure TBaseUpdateMaker.SelectGuidesForRelations(AUpdateInfoItem: TUpdateInfoItem); var i, j: Integer; UpdateInfoRel: TUpdateInfoRel; FldsForDetail: TStringList; FindedIDs: TIntList; FindedIDsForSelf: TIntList; //*** найденный ID-ки для самого себя (UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem) CurrID: Integer; DirectoryID: Integer; WasLookedItems: Boolean; IndexID: Integer; IndexGUID: Integer; begin FldsForDetail := TStringList.Create; FldsForDetail.Add(fnID); FldsForDetail.Add(fnGuid); FindedIDs := TIntList.Create; FindedIDsForSelf := TIntList.Create; WasLookedItems := false; for i := 0 to AUpdateInfoItem.FUpdateInfoRelation.Count - 1 do begin UpdateInfoRel := TUpdateInfoRel(AUpdateInfoItem.FUpdateInfoRelation[i]); FindedIDs.Clear; case UpdateInfoRel.RelationType of rtDetail: begin {//18.03.2009 SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, UpdateInfoRel.RelTableName, UpdateInfoRel.RelFieldName+' = :'+UpdateInfoRel.RelFieldName, FldsForDetail, ''), false); for j := 0 to AUpdateInfoItem.FIDListToMakeUpdate.Count - 1 do begin WasLookedItems := true; CurrID := AUpdateInfoItem.FIDListToMakeUpdate[j]; if AUpdateInfoItem.FLookedIDs.IndexOf(CurrID) = -1 then begin FSrcBase.FQSelect.Close; FSrcBase.FQSelect.ParamByName(UpdateInfoRel.RelFieldName).AsInteger := CurrID; FSrcBase.FQSelect.ExecQuery; //*** запомнить ID и GUID подчененной таблици while Not FSrcBase.FQSelect.Eof do begin UpdateInfoRel.RelUpdateInfoItem.AddIDGuid( FSrcBase.FQSelect.FN(fnID).AsInteger, FSrcBase.FQSelect.FN(fnGUID).AsString); FindedIDs.Add(FSrcBase.FQSelect.FN(fnID).AsInteger); //*** Если таблица ссылается сама на себя - например дере if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then FindedIDsForSelf.Add(FSrcBase.FQSelect.FN(fnID).AsInteger); FSrcBase.FQSelect.Next; end; end; end;} SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, UpdateInfoRel.RelTableName, UpdateInfoRel.RelFieldName+' = :'+UpdateInfoRel.RelFieldName, FldsForDetail, ''), false); IndexID := -1; IndexGUID := -1; for j := 0 to AUpdateInfoItem.FIDListToMakeUpdate.Count - 1 do begin WasLookedItems := true; CurrID := AUpdateInfoItem.FIDListToMakeUpdate[j]; if AUpdateInfoItem.FLookedIDs.IndexOf(CurrID) = -1 then begin FSrcBase.FQSelect.Close; FSrcBase.FQSelect.Params[0].AsInteger := CurrID; FSrcBase.FQSelect.ExecQuery; //*** запомнить ID и GUID подчененной таблици while Not FSrcBase.FQSelect.Eof do begin if IndexID = -1 then IndexID := FSrcBase.FQSelect.FieldIndex[fnID]; if IndexGUID = -1 then IndexGUID := FSrcBase.FQSelect.FieldIndex[fnGUID]; UpdateInfoRel.RelUpdateInfoItem.AddIDGuid( FSrcBase.FQSelect.Fields[IndexID].AsInteger, FSrcBase.FQSelect.Fields[IndexGUID].AsString); FindedIDs.Add(FSrcBase.FQSelect.Fields[IndexID].AsInteger); //*** Если таблица ссылается сама на себя - например дерево if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then FindedIDsForSelf.Add(FSrcBase.FQSelect.Fields[IndexID].AsInteger); FSrcBase.FQSelect.Next; end; end; end; //if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then // FindedIDsForSelf.Assign(FindedIDs, laOr); end; rtDirectory: begin {//17.03.2009 for j := 0 to AUpdateInfoItem.FIDListToMakeUpdate.Count - 1 do begin WasLookedItems := true; CurrID := AUpdateInfoItem.FIDListToMakeUpdate[j]; if AUpdateInfoItem.FLookedIDs.IndexOf(CurrID) = -1 then begin //*** Найти ID справочника SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateInfoItem.TableName, fnID+' = '''+IntToStr(CurrID)+'''', nil, UpdateInfoRel.RelFieldName)); if FSrcBase.FQSelect.FN(UpdateInfoRel.RelFieldName).AsInteger <> 0 then begin DirectoryID := FSrcBase.FQSelect.FN(UpdateInfoRel.RelFieldName).AsInteger; //*** найти запись в справочной таблице SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, UpdateInfoRel.RelTableName, fnID+' = '''+IntToStr(DirectoryID)+'''', FldsForDetail, '')); if FSrcBase.FQSelect.RecordCount > 0 then begin UpdateInfoRel.RelUpdateInfoItem.AddIDGuid( FSrcBase.FQSelect.FN(fnID).AsInteger, FSrcBase.FQSelect.FN(fnGUID).AsString); FindedIDs.Add(FSrcBase.FQSelect.FN(fnID).AsInteger); //*** Если таблица ссылается сама на себя - например дере if AUpdateInfoItem.TableType = uttTree then if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then FindedIDsForSelf.Add(FSrcBase.FQSelect.FN(fnID).AsInteger); end; end; end; end;} //*** скрипт нахождения ID справочника SetSQLToFIBQuery(FSrcBase.FQSelect, GetSQLByParams(qtSelect, AUpdateInfoItem.TableName, fnID+' = :'+fnID, nil, UpdateInfoRel.RelFieldName), false); //*** найти запись в справочной таблице SetSQLToFIBQuery(FSrcBase.FQSelectA, GetSQLByParams(qtSelect, UpdateInfoRel.RelTableName, fnID+' = :'+fnID, FldsForDetail, ''), false); IndexID := -1; IndexGUID := -1; for j := 0 to AUpdateInfoItem.FIDListToMakeUpdate.Count - 1 do begin WasLookedItems := true; CurrID := AUpdateInfoItem.FIDListToMakeUpdate[j]; if AUpdateInfoItem.FLookedIDs.IndexOf(CurrID) = -1 then begin //*** Найти ID справочника FSrcBase.FQSelect.Close; FSrcBase.FQSelect.Params[0].AsInteger := CurrID; FSrcBase.FQSelect.ExecQuery; if FSrcBase.FQSelect.Fields[0].AsInteger <> 0 then begin DirectoryID := FSrcBase.FQSelect.Fields[0].AsInteger; //*** найти запись в справочной таблице FSrcBase.FQSelectA.Close; FSrcBase.FQSelectA.Params[0].AsInteger := DirectoryID; FSrcBase.FQSelectA.ExecQuery; if FSrcBase.FQSelectA.RecordCount > 0 then begin if IndexID = -1 then IndexID := FSrcBase.FQSelectA.FieldIndex[fnID]; if IndexGUID = -1 then IndexGUID := FSrcBase.FQSelectA.FieldIndex[fnGUID]; UpdateInfoRel.RelUpdateInfoItem.AddIDGuid( FSrcBase.FQSelectA.Fields[IndexID].AsInteger, FSrcBase.FQSelectA.Fields[IndexGUID].AsString); FindedIDs.Add(FSrcBase.FQSelectA.Fields[IndexID].AsInteger); //*** Если таблица ссылается сама на себя - например дере if AUpdateInfoItem.TableType = uttTree then if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then FindedIDsForSelf.Add(FSrcBase.FQSelectA.Fields[IndexID].AsInteger); end; end; end; end; end; end; //if UpdateInfoRel.RelUpdateInfoItem = AUpdateInfoItem then // FindedIDsForSelf.Assign(FindedIDs, laOr); end; FindedIDs.Free; FldsForDetail.Free; if WasLookedItems then AUpdateInfoItem.FLookedIDs.Assign(AUpdateInfoItem.FIDListToMakeUpdate, laOr); AUpdateInfoItem.FLookedIDs.RemoveItems(FindedIDsForSelf); FindedIDsForSelf.Free; //*** найти связи с связянными таблицами (РЕКУРСИЯ) for i := 0 to AUpdateInfoItem.FUpdateInfoRelation.Count - 1 do begin UpdateInfoRel := TUpdateInfoRel(AUpdateInfoItem.FUpdateInfoRelation[i]); if UpdateInfoRel.RelUpdateInfoItem <> nil then if UpdateInfoRel.RelUpdateInfoItem.FIDListToMakeUpdate.Count > 0 then if UpdateInfoRel.RelUpdateInfoItem.HaveNoLookedIDs then SelectGuidesForRelations(UpdateInfoRel.RelUpdateInfoItem); end; end; procedure TBaseUpdateMaker.SelectGuidsByFromAndTo(AMode: TUpdateMakerMode; AFrom, ATo: Variant); var i: Integer; begin for i := 0 to FUpdateInfoItems.Count - 1 do begin SelectGuidsForTableByFromAndTo(FUpdateInfoItems[i], AMode, AFrom, ATo); IncProgressIndex; end; end; procedure TBaseUpdateMaker.SelectGuidsForTableByFromAndTo(AUpdateTableInfo: TUpdateInfoItem; AMode: TUpdateMakerMode; AFrom, ATo: Variant); var strSelectWhere: String; DateFrom: TDate; DateTo: TDate; IDFrom: Integer; IDTo: Integer; i: Integer; UpdInfoRel: TUpdateInfoRel; begin strSelectWhere := ''; DateFrom := 0; DateTo := 0; IDFrom := 0; IDTo := 0; //*** В зависимости от режима, настроить переменные case AMode of ummDate: begin if AFrom <> null then DateFrom := AFrom; if ATo <> null then DateTo := ATo; end; ummID: begin if AFrom <> null then IDFrom := AFrom; if ATo <> null then IDTo := ATo; end; end; case AMode of ummDate: begin if (DateFrom <> null) and (DateTo <> null) then strSelectWhere := '('+fnDateIn+' between '''+DateToStr(DateFrom)+''' and '''+DateToStr(DateTo)+''') or '+ '('+fnDateMod+' between '''+DateToStr(DateFrom)+''' and '''+DateToStr(DateTo)+''')' else if (DateFrom <> null) and (DateTo = null) then strSelectWhere := '('+fnDateIn+' >= '''+DateToStr(DateFrom)+''') or '+ '('+fnDateMod+' >= '+DateToStr(DateFrom)+''')' else if (DateFrom = null) and (DateTo <> null) then strSelectWhere := '('+fnDateIn+' <= '''+DateToStr(DateFrom)+''') or '+ '('+fnDateMod+' <= '+DateToStr(DateFrom)+''')'; end; ummID: begin if (IDFrom <> 0) and (IDTo <> 0) then strSelectWhere := '('+fnID+' between '''+DateToStr(IDFrom)+''' and '''+DateToStr(IDTo)+''')' else if (IDFrom <> 0) and (IDTo = 0) then strSelectWhere := '('+fnID+' >= '''+DateToStr(IDFrom)+'''' else if (IDFrom = 0) and (IDTo <> 0) then strSelectWhere := '('+fnID+' <= '''+DateToStr(IDTo)+''''; end; end; //*** отобрать ID по параметрам в strSelectWhere SetSQLToFIBQuery(FSrcBase.FQSelect, 'select ID, GUID from '+AUpdateTableInfo.TableName+' '+ strSelectWhere + ' order by id'); while Not FSrcBase.FQSelect.Eof do begin if AUpdateTableInfo.FIDListToMakeUpdate.IndexOf(FSrcBase.FQSelect.FN(fnID).AsInteger) = -1 then begin AUpdateTableInfo.AddIDGuid( FSrcBase.FQSelect.FN(fnID).AsInteger, FSrcBase.FQSelect.FN(fnGUID).AsString); end; FSrcBase.FQSelect.Next; end; FSrcBase.FQSelect.Close; //*** Отобрать записи связанных таблиц SelectGuidesForRelations(AUpdateTableInfo); end; procedure TBaseUpdateMaker.SetSrcBaseIDs; var i: Integer; UpdateInfoItem: TUpdateInfoItem; begin for i := 0 to FUpdateInfoItems.Count - 1 do begin UpdateInfoItem := FUpdateInfoItems[i]; if UpdateInfoItem.UpdateAllData = biTrue then SelectAllGuidesForTable(UpdateInfoItem); SetSrcTableIDs(UpdateInfoItem); IncProgressIndex; end; end; procedure TBaseUpdateMaker.SetSrcTableIDs(AUpdateTableInfo: TUpdateInfoItem); var SrcID: Integer; SrcGUID: String; InsertFieldNames: TStringList; MaxIDInserted: Integer; DestTableGenValue: integer; i: Integer; begin try InsertFieldNames := TStringList.Create; InsertFieldNames.Add(fnID); InsertFieldNames.Add(fnGUID); InsertFieldNames.Add(fnUpdateType); try SetSQLToFIBQuery(FDestBase.FQOperat, GetSQLByParams(qtInsert, AUpdateTableInfo.TableName, '', InsertFieldNames, ''), false); MaxIDInserted := 0; if AUpdateTableInfo.FGUIDListToMakeUpdate.Count > 0 then begin for i := 0 to AUpdateTableInfo.FGUIDListToMakeUpdate.Count - 1 do begin SrcID := AUpdateTableInfo.FIDListToMakeUpdate[i]; SrcGUID := AUpdateTableInfo.FGUIDListToMakeUpdate[i]; if MaxIDInserted < SrcID then MaxIDInserted := SrcID; //if i = 0 then // if (AUpdateTableInfo.TableType = uttTree) and (FMakeUpdateParams.DBType <> dbtUsual) then // begin // // end; FDestBase.FQOperat.Close; FDestBase.FQOperat.ParamByName(fnID).AsInteger := SrcID; FDestBase.FQOperat.ParamByName(fnGUID).AsString := SrcGUID; FDestBase.FQOperat.ParamByName(fnUpdateType).AsInteger := urtInsert; FDestBase.FQOperat.ExecQuery; end; // Поправляем генератор DestTableGenValue := GenIDFromTable(FDestBase.FQSelect, AUpdateTableInfo.GeneratorName, 0); if DestTableGenValue < MaxIDInserted then GenIDFromTable(FDestBase.FQSelect, AUpdateTableInfo.GeneratorName, MaxIDInserted - DestTableGenValue + 1); end; finally InsertFieldNames.Free; end; except on E: Exception do AddExceptionToLog('TBaseUpdateMaker.SetSrcTableIDs: '+E.Message); end; end; procedure TBaseUpdateMaker.SetUOM; begin try FDestBase.FSettings.UOM := FSrcBase.Settings.UOM; // Создаем Поле fnUOM if Not CheckFieldInTable(tnSettings, fnUOM, FDestBase.FQSelect) then AddFieldToTable(tnSettings, fnUOM, ftInteger, 0, FDestBase.FQOperat); UpdateTableFieldAllRec(FDestBase.FQOperat, tnSettings, fnUOM, FDestBase.FSettings.UOM); except on E: Exception do AddExceptionToLogEx('TBaseUpdateMaker.SetUOM', E.Message); end; end; function TBaseUpdateMaker.MakeUpdate(ASrcDBName, AEmptyDBName, ADestDBName: String; AMakeUpdateParams: TMakeUpdateParams; APackDest: Boolean): TUpdateBaseResults; var WorkDirectory: String; UpdateInfoItemMain: TUpdateInfoItem; UpdateInfoItemRest: TUpdateInfoItem; i: Integer; EmptyDB: TBase; TempDBPath: String; begin Result := []; //TempDBPath := GetAnsiTempPath + TempDBName; TempDBPath := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + TempDBName); //// Существует исходная база //if Not FileExists(ASrcDBName) then // Result := Result + [ubrSrcBaseNotExist]; // базы указывают на один файл if ADestDBName = ASrcDBName then Result := Result + [ubrSameBases]; if Result <> [] then Exit; ///// EXIT ///// Clear; FMakeUpdateParams := AMakeUpdateParams; FSrcBase := TBase.Create(F_NormBase.DM.ConnectParams); try try FSrcBase.Open(ASrcDBName); except end; if Not FSrcBase.Active then begin Result := Result + [ubrSrcBaseOpenError]; Exit; ///// EXIT ///// end; try if Not FileExists(AEmptyDBName) then FSrcBase.MakeEmptyCopy(AEmptyDBName) else // Если файл для блока обновления имеет устаревшую версию, то заменить его на новую begin EmptyDB := TBase.Create(F_NormBase.DM.ConnectParams); try EmptyDB.Open(AEmptyDBName); if EmptyDB.LoadSettings.BuildID < FSrcBase.LoadSettings.BuildID then begin EmptyDB.Close; FSrcBase.MakeEmptyCopy(AEmptyDBName); end; finally FreeAndNil(EmptyDB); end; end; //*** Создать файл обновления if FileExists(AEmptyDBName) then CopyBase(AEmptyDBName, TempDBPath); if FileExists(TempDBPath) then begin FDestBase := TBase.Create(F_NormBase.DM.ConnectParams); FDestBase.Open(TempDBPath); FUpdateInfoItems := FDestBase.GetUpdateInfo; //FSrcBase.GetUpdateInfo; FProgressStepCount := FUpdateInfoItems.Count * 2; if Assigned(FOnStartProgress) then FOnStartProgress(Self, FProgressStepIndex, FProgressStepCount); try //*** Отобрать ID-ки записей для блока обновления FUpdateInfoItems.Assign(FMakeUpdateParams.FUpdateInfoItems); UpdateInfoItemMain := nil; case AMakeUpdateParams.DBType of dbtUpdate: SelectGuidsByFromAndTo(AMakeUpdateParams.Mode, AMakeUpdateParams.FldFrom, AMakeUpdateParams.FldTo); dbtCatalog, dbtComponent: begin case AMakeUpdateParams.DBType of dbtCatalog: UpdateInfoItemMain := FUpdateInfoItems.GetItemByTableName(tnCatalog); dbtComponent: UpdateInfoItemMain := FUpdateInfoItems.GetItemByTableName(tnComponent); end; if UpdateInfoItemMain <> nil then begin if (AMakeUpdateParams.ObjectID <> 0) and (AMakeUpdateParams.ObjectGUID <> '') then UpdateInfoItemMain.AddIDGuid(AMakeUpdateParams.ObjectID, AMakeUpdateParams.ObjectGUID); SelectGuidesForRelations(UpdateInfoItemMain); end; end end; // Подгрузить данные для всех не подгруженных таблиц, пришедших из параметров if FMakeUpdateParams.FUpdateInfoItems <> nil then for i := 0 to FMakeUpdateParams.FUpdateInfoItems.Count - 1 do begin UpdateInfoItemRest := FUpdateInfoItems.GetItemByTableName(FMakeUpdateParams.FUpdateInfoItems[i].TableName); if UpdateInfoItemRest <> nil then if UpdateInfoItemRest <> UpdateInfoItemMain then SelectGuidesForRelations(UpdateInfoItemRest); end; SetSrcBaseIDs; InsertSrcBaseToDest; DefinePrices; FSrcBase.LoadSettings; FDestBase.LoadSettings; FDestBase.FSettings := FSrcBase.FSettings; FDestBase.FSettings.DBType := AMakeUpdateParams.DBType; FDestBase.SaveSettings; SetUOM; FDestBase.Close; Result := Result + [ubrSuccessful]; finally try FreeAndNil(FDestBase); if APackDest then PakFile(TempDBPath); //*** Переместить тэмп файл в указанное место CopyBase(TempDBPath, ADestDBName, true); finally if Assigned(FOnEndProgress) then FOnEndProgress(Self, FProgressStepIndex, FProgressStepCount); end; end; end else // Существует целевая база Result := Result + [ubrTrgBaseNotExist]; finally FSrcBase.Close; end; finally FreeAndNil(FSrcBase); end; { //------------------------------------------------ FDestBase := TBase.Create; FDestBase.Open(ADestDBName); if Not FDestBase.Active then Result := Result + [ubrTrgBaseOpenError]; if Result <> [] then Exit; ///// EXIT ///// SrcWorkDBName := ExtractFileDir(ASrcDBName)+'\' + TempDBName; if CopyBase(ASrcDBName, SrcWorkDBName) then begin FSrcBase := TBase.Create; FSrcBase.Open(SrcWorkDBName); if Not FSrcBase.Active then Result := Result + [ubrSrcBaseOpenError]; FUpdateInfoItems := FDestBase.GetUpdateInfo; FProgressStepCount := FUpdateInfoItems.Count * 2; if Assigned(FOnStartProgress) then FOnStartProgress(Self, FProgressStepIndex, FProgressStepCount); try //SetSrcBaseIDs; //InsertSrcBaseToDest; FSrcBase.Close; Result := Result + [ubrSuccessful]; finally try FDestBase.Close; DeleteFile(SrcWorkDBName); finally if Assigned(FOnEndProgress) then FOnEndProgress(Self, FProgressStepIndex, FProgressStepCount); end; end; end; } end; { TUpdateInfo } function TUpdateInfo.Add(AUpdateInfoItem: TUpdateInfoItem): Integer; begin Result := inherited Add(AUpdateInfoItem); end; procedure TUpdateInfo.Assign(ASrc: TUpdateInfo); var SrcUpdInfoItem: TUpdateInfoItem; SelfUpdInfoItem: TUpdateInfoItem; i: Integer; begin for i := 0 to ASrc.Count - 1 do begin SrcUpdInfoItem := TUpdateInfoItem(ASrc.Items[i]); SelfUpdInfoItem := GetItemByTableName(SrcUpdInfoItem.TableName); if SelfUpdInfoItem <> nil then begin SelfUpdInfoItem.FIDListToMakeUpdate.Assign(SrcUpdInfoItem.FIDListToMakeUpdate); SelfUpdInfoItem.FIDListToMakeUpdateSorted.Assign(SrcUpdInfoItem.FIDListToMakeUpdateSorted); SelfUpdInfoItem.FGUIDListToMakeUpdate.Assign(SrcUpdInfoItem.FGUIDListToMakeUpdate); SelfUpdInfoItem.FGUIDListToMakeUpdateSorted.Assign(SrcUpdInfoItem.FGUIDListToMakeUpdateSorted); SelfUpdInfoItem.FLookedIDs.Assign(SrcUpdInfoItem.FLookedIDs); end; end; end; procedure TUpdateInfo.DefineRelUpdInfoItems; var UpdInfoItemCount: Integer; UpdInfoItem: TUpdateInfoItem; UpdInfoRel: TUpdateInfoRel; RelUpdInfoItem: TUpdateInfoItem; i, j: Integer; begin UpdInfoItemCount := inherited Count; for i := 0 to UpdInfoItemCount - 1 do begin UpdInfoItem := Items[i]; for j := 0 to UpdInfoItem.FUpdateInfoRelation.Count - 1 do begin UpdInfoRel := TUpdateInfoRel(UpdInfoItem.FUpdateInfoRelation[j]); RelUpdInfoItem := GetItemByTableName(UpdInfoRel.RelTableName); if RelUpdInfoItem <> nil then UpdInfoRel.RelUpdateInfoItem := RelUpdInfoItem; end; end; end; function TUpdateInfo.GetItemByTableName(ATableName: String): TUpdateInfoItem; var i: Integer; UpdInfoItem: TUpdateInfoItem; begin Result := nil; for i := 0 to Count - 1 do begin UpdInfoItem := Items[i]; if UpdInfoItem.TableName = ATableName then begin Result := UpdInfoItem; Break; ///// BREAK ///// end; end; end; constructor TUpdateInfo.Create; begin inherited Create(true); end; destructor TUpdateInfo.Destroy; begin inherited; end; function TUpdateInfo.GetItem(Index: Integer): TUpdateInfoItem; begin Result := TUpdateInfoItem(inherited Items[Index]); end; function TUpdateInfo.IndexOf(AUpdateInfoItem: TUpdateInfoItem): Integer; begin Result := inherited IndexOf(AUpdateInfoItem); end; procedure TUpdateInfo.Insert(Index: Integer; AUpdateInfoItem: TUpdateInfoItem); begin inherited Insert(Index, AUpdateInfoItem); end; function TUpdateInfo.LoadRecordCount: Integer; var i: Integer; UpdateInfoItem: TUpdateInfoItem; ItemsCount: Integer; begin Result := 0; ItemsCount := Inherited Count; for i := 0 to ItemsCount - 1 do begin UpdateInfoItem := Items[i]; UpdateInfoItem.LoadRecordCount; Result := Result + UpdateInfoItem.RecordCountInTable; end; RecordCount := Result; end; function TUpdateInfo.GetItemsCountByUpdAllDataFld: Integer; var i: Integer; UpdateInfoItem: TUpdateInfoItem; begin Result := 0; for i := 0 to Count - 1 do begin UpdateInfoItem := Items[i]; if UpdateInfoItem.UpdateAllData = biTrue then Result := Result + 1; end; end; function TUpdateInfo.Remove(AUpdateInfoItem: TUpdateInfoItem): Integer; begin Result := inherited Remove(AUpdateInfoItem); end; procedure TUpdateInfo.RemoveItemsByUpdAllDataFld; var i: Integer; UpdateInfoItem: TUpdateInfoItem; begin i := 0; while i <= Count-1 do begin UpdateInfoItem := Items[i]; if UpdateInfoItem.UpdateAllData = biTrue then Remove(UpdateInfoItem) else Inc(i); end; end; procedure TUpdateInfo.SetItem(Index: Integer; AUpdateInfoItem: TUpdateInfoItem); begin inherited Items[Index] := AUpdateInfoItem; end; { TUpdateInfoItem } function TUpdateInfoItem.AddIDGuid(AID: Integer; const AGuid: String): Integer; var NewIndexID: Integer; NewIndexGuid: Integer; begin Result := -1; if //(FIDListToMakeUpdate.IndexOf(AID) = -1) and //(FGUIDListToMakeUpdate.IndexOf(AGuid) = -1) then (GetValueIndexFromSortedIntList(AID, FIDListToMakeUpdateSorted) = -1) and (FGUIDListToMakeUpdateSorted.IndexOf(AGuid) = -1) then begin NewIndexID := 0; NewIndexGuid := 0; if FIDListToMakeUpdate.Count = FGUIDListToMakeUpdate.Count then begin NewIndexID := FIDListToMakeUpdate.Add(AID); NewIndexGuid := FGUIDListToMakeUpdate.Add(AGuid); if NewIndexID = NewIndexGuid then Result := NewIndexID; InsertValueToSortetIntList(AID, FIDListToMakeUpdateSorted); FGUIDListToMakeUpdateSorted.Add(AGuid); end; end; end; constructor TUpdateInfoItem.Create(ABase: TBase); begin inherited Create; FBase := ABase; ID := 0; IsOn := 0; TableName := ''; GeneratorName := ''; TableType := ttNone; IsDirectory := biFalse; SortID := 0; IsMainTable := false; ActLimit := altNone; FieldsToUpdate := TStringList.Create; FUpdateInfoRelation := TObjectList.Create(true); FIDListToMakeUpdate := TIntList.Create; FIDListToMakeUpdateSorted := TIntList.Create; FGUIDListToMakeUpdate := TStringList.Create; FGUIDListToMakeUpdateSorted := TStringList.Create; FGUIDListToMakeUpdateSorted.Sorted := true; FGUIDListDisabled := TStringList.Create; FGUIDListDisabled.Sorted := true; FLookedIDs := TIntList.Create; FNewIDs := TIntList.Create; end; destructor TUpdateInfoItem.Destroy; begin FUpdateInfoRelation.Free; FIDListToMakeUpdate.Free; FIDListToMakeUpdateSorted.Free; FGUIDListToMakeUpdate.Free; FGUIDListToMakeUpdateSorted.Free; FGUIDListDisabled.Free; FLookedIDs.Free; FNewIDs.Free; FieldsToUpdate.Free; inherited; end; function TUpdateInfoItem.HaveNoLookedIDs: Boolean; var i: Integer; CurrID: Integer; LookedIDsSorted: TIntList; begin Result := false; if FIDListToMakeUpdate.Count > 0 then begin // Строим сортированный список LookedIDsSorted := IntListToSorted(FLookedIDs); for i := 0 to FIDListToMakeUpdate.Count - 1 do begin CurrID := FIDListToMakeUpdate[i]; //if FLookedIDs.IndexOf(CurrID) = -1 then if GetValueIndexFromSortedIntList(CurrID, LookedIDsSorted) = -1 then begin Result := true; Break; ///// BREAK ///// end; end; FreeAndNil(LookedIDsSorted); end; end; procedure TUpdateInfoItem.LoadRecordCount; begin SetSQLToFIBQuery(FBase.FQSelect, GetSQLByParams(qtSelect, TableName, '', nil, fnCount+'(ID)')); RecordCountInTable := FBase.FQSelect.FN(fnCount).AsInteger; end; procedure TUpdateInfoItem.LoadUpdateInfoRel; var UpdateInfoRel: TUpdateInfoRel; begin SetSQLToFIBQuery(FBase.FQSelect, GetSQLByParams(qtSelect, tnUpdateInfoRelation, fnIDUpdateInfo+' = '''+IntToStr(ID)+'''', nil, fnAll)); FUpdateInfoRelation.Clear; while Not FBase.FQSelect.Eof do begin UpdateInfoRel := TUpdateInfoRel.Create; UpdateInfoRel.ID := FBase.FQSelect.FN(fnID).AsInteger; UpdateInfoRel.IDUpdateInfo := FBase.FQSelect.FN(fnIDUpdateInfo).AsInteger; UpdateInfoRel.ID := FBase.FQSelect.FN(fnID).AsInteger; UpdateInfoRel.RelationType := FBase.FQSelect.FN(fnRelationType).AsInteger; UpdateInfoRel.RelTableName := FBase.FQSelect.FN(fnRelTableName).AsString; UpdateInfoRel.RelFieldName := FBase.FQSelect.FN(fnRelFieldName).AsString; UpdateInfoRel.SortID := FBase.FQSelect.FN(fnSortID).AsInteger; FUpdateInfoRelation.Add(UpdateInfoRel); FBase.FQSelect.Next; end; FBase.FQSelect.Close; end; procedure TUpdateInfoItem.SortByID; var i, j: Integer; IDi: Integer; IDj: Integer; IDbuf: Integer; begin for i := 0 to FIDListToMakeUpdate.Count - 1 do begin IDi := FIDListToMakeUpdate[i]; for j := i to FIDListToMakeUpdate.Count - 1 do begin IDj := FIDListToMakeUpdate[j]; if IDj < IDi then begin FIDListToMakeUpdate.Move(IDi, IDj); FGUIDListToMakeUpdate.Move(IDi, IDj); IDbuf := IDi; IDi := IDj; IDj := IDbuf; end; end; end; end; procedure TBaseUpdater.DestBaseUpdateStructure(Sender: TObject); begin IncProgressIndex; end; procedure TBaseUpdater.UpdEndProgress(Sender: TObject; AStepIndex, AStepCount: Integer); begin F_NormBase.F_Animate.StopAnimate; end; procedure TBaseUpdater.UpdProgress(Sender: TObject; AStepIndex, AStepCount: Integer); begin F_NormBase.F_Animate.SetProgressPos(AStepIndex + 1); end; procedure TBaseUpdater.UpdStartProgress(Sender: TObject; AStepIndex, AStepCount: Integer); begin F_NormBase.F_Animate.GMaxProgressPos := AStepCount; F_NormBase.F_Animate.StartAnimate(FProgressTitle, aviCopyFiles, aiProgressBar); //F_NormBase.F_Animate.SetProgressPos(AStepIndex + 1); end; function MakeUpdate(ADestBaseName: String; AMakeUpdateParams: TMakeUpdateParams; APackDest: Boolean): Boolean; var UpdateMaker: TBaseUpdateMaker; MakeUpdateResults: TUpdateBaseResults; WasNBClose: Boolean; begin Result := false; WasNBClose := false; if (F_NormBase <> nil) and (F_NormBase.GSCSBase <> nil) and (F_NormBase.GSCSBase.Active) then begin SetBusyParamsToBase(F_NormBase.DM.Query_Select, F_NormBase.DM.Query_Operat, bbmExportData); F_NormBase.GSCSBase.SimpleClose(true); WasNBClose := true; end; UpdateMaker := TBaseUpdateMaker.Create; try //UpdateMaker.OnEndProgress := UpdateMaker.UpdEndProgress; //UpdateMaker.OnProgress := UpdateMaker.UpdProgress; //UpdateMaker.OnStartProgress := UpdateMaker.UpdStartProgress; MakeUpdateResults := UpdateMaker.MakeUpdate(F_NormBase.GSCSBase.DBName, GetPathToNBEmpty, ADestBaseName, AMakeUpdateParams, APackDest); if ubrSuccessful in MakeUpdateResults then Result := true; finally UpdateMaker.Free; if WasNBClose then begin F_NormBase.GSCSBase.SimpleOpen(true); SetBusyParamsToBase(F_NormBase.DM.Query_Select, F_NormBase.DM.Query_Operat, bbmEmpty); end; end; end; function UpdateNormBase(const ASrcBasePath, ASrcDBNameOriginal, ADestBasePath: String; var AUpdateBaseParams: TUpdateBaseParams; ABusyType: Integer; ACreateSrcTmp: Boolean): TUpdateBaseResults; var BaseUpdater: TBaseUpdater; WasNBClose: Boolean; WasSetBusyParams: Boolean; // Tolik 28/08/2019- - //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin Result := []; ProcessMessagesEx; WasNBClose := false; WasSetBusyParams := false; if (F_NormBase <> nil) and (F_NormBase.GSCSBase <> nil) and (F_NormBase.GSCSBase.Active) then begin SetBusyParamsToBase(F_NormBase.DM.Query_Select, F_NormBase.DM.Query_Operat, ABusyType); F_NormBase.GSCSBase.SimpleClose(true); WasNBClose := true; WasSetBusyParams := true; end; try BaseUpdater := TBaseUpdater.Create; try BaseUpdater.OnEndProgress := BaseUpdater.UpdEndProgress; BaseUpdater.OnProgress := BaseUpdater.UpdProgress; BaseUpdater.OnStartProgress := BaseUpdater.UpdStartProgress; OldTick := GetTickCount; try Result := BaseUpdater.UpdateBase(ASrcBasePath, ASrcDBNameOriginal, ADestBasePath{F_NormBase.GSCSBase.DBName}, AUpdateBaseParams, Not WasSetBusyParams, ABusyType, ACreateSrcTmp); except on E: Exception do AddExceptionToLog('UpdateNormBase: '+E.Message); end; CurrTick := GetTickCount - OldTick; finally BaseUpdater.Free; end; finally if WasNBClose then begin F_NormBase.GSCSBase.SimpleOpen(true); SetBusyParamsToBase(F_NormBase.DM.Query_Select, F_NormBase.DM.Query_Operat, bbmEmpty); end; end; end; { TUpdateInfoRel } constructor TUpdateInfoRel.Create; begin inherited; ID := 0; IDUpdateInfo := 0; RelationType := rtNone; RelTableName := ''; RelFieldName := ''; SortID := 0; RelUpdateInfoItem := nil; end; destructor TUpdateInfoRel.destroy; begin inherited; end; { TUpdateStructInfo } function TUpdateStructInfo.Add(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; begin Result := inherited Add(AUpdateStructInfoItem); end; constructor TUpdateStructInfo.Create; begin inherited Create(true); end; destructor TUpdateStructInfo.Destroy; begin inherited; end; function TUpdateStructInfo.GetItem(Index: Integer): TUpdateStructInfoItem; begin Result := TUpdateStructInfoItem(inherited Items[Index]); end; function TUpdateStructInfo.IndexOf(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; begin Result := inherited IndexOf(AUpdateStructInfoItem); end; procedure TUpdateStructInfo.Insert(Index: Integer; AUpdateStructInfoItem: TUpdateStructInfoItem); begin inherited Insert(Index, AUpdateStructInfoItem); end; function TUpdateStructInfo.Remove(AUpdateStructInfoItem: TUpdateStructInfoItem): Integer; begin Result := inherited Remove(AUpdateStructInfoItem); end; procedure TUpdateStructInfo.SetItem(Index: Integer; AUpdateStructInfoItem: TUpdateStructInfoItem); begin inherited Items[Index] := AUpdateStructInfoItem; end; { TUpdateStructInfoItem } constructor TUpdateStructInfoItem.Create; begin inherited; FScript := TStringList.Create; end; destructor TUpdateStructInfoItem.Destroy; begin FScript.Free; inherited; end; end.