ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/iblocaldb/IBXUpgradeDatabaseDlg.pas

Comparing ibx/trunk/iblocaldb/IBXUpgradeDatabaseDlg.pas (file contents):
Revision 79 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

#	Line 31 | Line 31 | interface
31
32		uses
33		Classes, SysUtils, FileUtil, Forms, Controls,  Dialogs, StdCtrls,
34	<	ComCtrls, ExtCtrls, IBDatabase, ibxscript;
34	>	ComCtrls, ExtCtrls, IBDatabase, ibxscript, IBXUpgradeConfFile;
35
36		type
37	+	TGetDatabaseVersionNo = procedure (Sender: TObject; var VersionNo: integer) of object;
38	+
39		{ TUpgradeDatabaseDlg }
40
41		TUpgradeDatabaseDlg = class(TForm)
#	Line 42 | Line 44 | type
44		Label1: TLabel;
45		Panel1: TPanel;
46		ProgressBar1: TProgressBar;
45	–	FDatabase: TIBDatabase;
47		Status: TLabel;
48		Timer1: TTimer;
49		procedure FormShow(Sender: TObject);
#	Line 51 | Line 52 | type
52		procedure IBXScriptProgressEvent(Sender: TObject; Reset: boolean;
53		value: integer);
54		private
55	<	FOnDoUpgrade: TNotifyEvent;
55	>	FOnGetDatabaseVersionNo: TGetDatabaseVersionNo;
56	>	FOnUpgradeStepCompleted: TNotifyEvent;
57		{ private declarations }
58		FUpgradeLog: TStrings;
59	+	FTargetVersionNo: integer;
60	+	FUpgradeConf: TUpgradeConfFile;
61	+	FArchiveStub: string;
62		procedure DoUpdate(Data: PtrInt);
63	+	function CurrentDBVersionNo: integer;
64		public
65		{ public declarations }
66		SuccessfulCompletion: boolean;
67		constructor Create(theOwner: TComponent); override;
68		destructor Destroy; override;
69		procedure Add2Log(Msg: string);
70	<	property OnDoUpgrade: TNotifyEvent read FOnDoUpgrade write FOnDoUpgrade;
70	>	property OnGetDatabaseVersionNo: TGetDatabaseVersionNo read FOnGetDatabaseVersionNo
71	>	write FOnGetDatabaseVersionNo;
72	>	property OnUpgradeStepCompleted: TNotifyEvent read FOnUpgradeStepCompleted write FOnUpgradeStepCompleted;
73		end;
74
75
68	–
76		var
77		UpgradeDatabaseDlg: TUpgradeDatabaseDlg;
78
79	+	function RunUpgradeDatabase(aDatabase: TIBDatabase;
80	+	UpgradeConf: TUpgradeConfFile;
81	+	ArchiveStub: string;
82	+	TargetVersionNo: integer;
83	+	aOnGetDatabaseVersionNo: TGetDatabaseVersionNo;
84	+	aOnUpgradeStepCompleted: TNotifyEvent): boolean;
85	+
86
87		implementation
88
89		{$R *.lfm}
90
91	<	uses  IBXViewLogDig;
91	>	uses  IBXViewLogDig, IBXSaveDatabaseDlg;
92	>
93	>	resourcestring
94	>	sNoUpgradeConf = 'An Upgrade Conf file must be provided';
95	>	sUpdateMsg =       'Applying Update from %s';
96	>	sUpdateStarted =   '%s Update Started';
97	>	sUpdateEnded =     '%s Update Completed';
98	>	sUpdateFailed    = 'Update Failed - %s';
99	>
100	>	function RunUpgradeDatabase(aDatabase: TIBDatabase;
101	>	UpgradeConf: TUpgradeConfFile; ArchiveStub: string; TargetVersionNo: integer;
102	>	aOnGetDatabaseVersionNo: TGetDatabaseVersionNo;
103	>	aOnUpgradeStepCompleted: TNotifyEvent): boolean;
104	>	begin
105	>	if not assigned(UpgradeConf) then
106	>	raise Exception.Create(sNoUpgradeConf);
107	>
108	>	with TUpgradeDatabaseDlg.Create(Application) do
109	>	try
110	>	FTargetVersionNo := TargetVersionNo;
111	>	FUpgradeConf := UpgradeConf;
112	>	FArchiveStub := ArchiveStub;
113	>	IBXScript.Database := aDatabase;
114	>	UpdateTransaction.DefaultDatabase := aDatabase;
115	>	IBXScript.GetParamValue := @UpgradeConf.GetParamValue;
116	>	OnGetDatabaseVersionNo := aOnGetDatabaseVersionNo;
117	>	OnUpgradeStepCompleted := aOnUpgradeStepCompleted;
118	>	Result := ShowModal = mrOK;
119	>	finally
120	>	Free
121	>	end;
122	>	end;
123
124		{ TUpgradeDatabaseDlg }
125
#	Line 124 | Line 169 | begin
169		end;
170
171		procedure TUpgradeDatabaseDlg.DoUpdate(Data: PtrInt);
172	<
172	>	var UpdateAvailable: boolean;
173	>	UpgradeInfo: TUpgradeInfo;
174	>	DBArchive: string;
175	>	LastVersionNo: integer;
176	>	CurVersionNo: integer;
177		begin
178		SuccessfulCompletion := true;
179		try
180	<	if assigned(OnDoUpgrade) then
181	<	OnDoUpgrade(self);
180	>	CurVersionNo := CurrentDBVersionNo;
181	>	repeat
182	>	if CurVersionNo >= FTargetVersionNo then break;
183	>	LastVersionNo := CurVersionNo;
184	>	UpdateAvailable := FUpgradeConf.GetUpgradeInfo(CurVersionNo+1,UpgradeInfo);
185	>	if UpdateAvailable then
186	>	begin
187	>	if UpgradeInfo.BackupDB then
188	>	begin
189	>	CreateDir(ExtractFileDir(FArchiveStub));
190	>	DBArchive := FArchiveStub + '.' + IntToStr(CurrentDBVersionNo) + '.gbk';
191	>	with IBXScript.Database do
192	>	SaveDatabaseToArchive(DatabaseName,Params,DBArchive);
193	>	end;
194	>	Add2Log(UpgradeInfo.UserMessage);
195	>	Status.Caption := UpgradeInfo.UserMessage;
196	>	Application.ProcessMessages;
197	>	Add2Log(Format(sUpdateMsg,[UpgradeInfo.UpdateSQLFile]));
198	>	Add2Log(Format(sUpdateStarted,[DateTimeToStr(Now)]));
199	>	if not IBXScript.PerformUpdate(UpgradeInfo.UpdateSQLFile,true) then
200	>	begin
201	>	Add2Log(Format(sUpdateFailed,[DateTimeToStr(Now)]));
202	>	SuccessfulCompletion := false;
203	>	UpdateTransaction.Rollback;
204	>	break;
205	>	end;
206	>	UpdateTransaction.Commit;
207	>	Add2Log(Format(sUpdateEnded,[DateTimeToStr(Now)]));
208	>	if assigned(FOnUpgradeStepCompleted) then
209	>	OnUpgradeStepCompleted(self);
210	>	end;
211	>	CurVersionNo := CurrentDBVersionNo;
212	>	until not UpdateAvailable or (LastVersionNo = CurVersionNo);
213		except on E:Exception do
214		begin
215		SuccessfulCompletion := false;
#	Line 139 | Line 219 | begin
219		Timer1.Enabled := true;
220		end;
221
222	+	function TUpgradeDatabaseDlg.CurrentDBVersionNo: integer;
223	+	begin
224	+	if assigned(FOnGetDatabaseVersionNo) then
225	+	OnGetDatabaseVersionNo(self,Result)
226	+	else
227	+	Result := 0;
228	+	end;
229	+
230
231		constructor TUpgradeDatabaseDlg.Create(theOwner: TComponent);
232		begin

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines