pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Add code to zeos datastore to convert old tables (v1.04) to the new structure.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5183 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-09-19 20:57:45 +00:00
parent f66b612fbd
commit afebf9b206
6 changed files with 258 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
components/tvplanit/examples/datastores/zeos/project1.lpi
View File

@@ -10,9 +10,6 @@
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
@@ -65,11 +62,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>

22
components/tvplanit/examples/datastores/zeos/unit1.lfm
View File

@@ -117,9 +117,6 @@ object Form1: TForm1
AllDayEventAttributes.BackgroundColor = clWindow
AllDayEventAttributes.EventBorderColor = clGray
AllDayEventAttributes.EventBackgroundColor = clBtnFace
Align = alClient
TabStop = True
TabOrder = 0
DateLabelFormat = 'dddd, mmmm dd, yyyy'
DayHeadAttributes.Color = clBtnFace
DayHeadAttributes.DateFormat = 'dddd mmmm, dd'
@@ -132,6 +129,9 @@ object Form1: TForm1
TimeFormat = tf12Hour
ShowEventTime = True
WeekStartsOn = dtMonday
Align = alClient
TabStop = True
TabOrder = 0
end
object VpMonthView1: TVpMonthView
Left = 0
@@ -152,8 +152,12 @@ object Form1: TForm1
DayNameStyle = dsShort
DrawingStyle = dsFlat
EventDayStyle = []
HeadAttributes.Color = clBtnFace
LineColor = clGray
TimeFormat = tf12Hour
TodayAttributes.Color = clSilver
TodayAttributes.BorderPen.Color = clRed
TodayAttributes.BorderPen.Width = 3
OffDayColor = clSilver
SelectedDayColor = clRed
ShowEvents = True
@@ -247,9 +251,8 @@ object Form1: TForm1
end
object ZConnection1: TZConnection
ControlsCodePage = cCP_UTF8
AutoEncodeStrings = False
Properties.Strings = (
'AutoEncodeStrings='
'AutoEncodeStrings=ON'
)
Port = 0
left = 136
@@ -276,10 +279,11 @@ object Form1: TForm1
CategoryColorMap.Category8.Description = 'Category 8'
CategoryColorMap.Category9.Color = clMaroon
CategoryColorMap.Category9.Description = 'Category 9'
HiddenCategories.BackgroundColor = clSilver
HiddenCategories.Color = clGray
EnableEventTimer = True
PlayEventSounds = True
AutoConnect = False
AutoCreate = False
Daybuffer = 31
left = 136
top = 200
end
@@ -309,4 +313,8 @@ object Form1: TForm1
left = 136
top = 335
end
object ZTable1: TZTable
left = 136
top = 536
end
end

4
components/tvplanit/examples/datastores/zeos/unit1.pas
View File

@@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, VpBaseDS, VpZeosDs, VpDayView, VpWeekView, VpTaskList,
VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, ZConnection;
VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, ZConnection,
ZDataset;
type
@@ -35,6 +36,7 @@ type
VpWeekView1: TVpWeekView;
VpZeosDatastore1: TVpZeosDatastore;
ZConnection1: TZConnection;
ZTable1: TZTable;
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);

211
components/tvplanit/source/addons/zeos/vpzeosds.pas
View File

@@ -20,7 +20,7 @@ type
procedure SetConnection(const AValue: TZConnection);
protected
procedure CreateTable(const ATableName: String);
procedure CreateTable(const ATableName: String; CreateIndex: Boolean = true);
procedure CreateAllTables;
function GetContactsTable: TDataset; override;
function GetEventsTable: TDataset; override;
@@ -30,6 +30,13 @@ type
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetConnected(const AValue: Boolean); override;
protected
// Fix old tables
procedure AddField(ATableName, AFieldName: String; AFieldType: TFieldType;
ASize: Integer=0);
procedure RenameFields(ATableName: String; AFields: TStrings);
procedure FixContactsTable;
public
constructor Create(AOwner: TComponent); override;
procedure CreateTables;
@@ -53,7 +60,7 @@ type
implementation
uses
LazFileUtils,
LazFileUtils, ZAbstractDataset,
VpConst;
{ TVpZeosDatastore }
@@ -64,15 +71,35 @@ begin
FContactsTable := TZTable.Create(self);
FContactsTable.TableName := 'Contacts';
FContactsTable.UpdateMode := umUpdateAll;
FEventsTable := TZTable.Create(Self);
FEventsTable.TableName := 'Events';
FEventsTable.UpdateMode := umUpdateAll;
FResourceTable := TZTable.Create(self);
FResourceTable.TableName := 'Resources';
FResourceTable.UpdateMode := umUpdateAll;
FTasksTable := TZTable.Create(self);
FTasksTable.TableName := 'Tasks';
FTasksTable.UpdateMode := umUpdateAll;
end;
procedure TVpZeosDatastore.AddField(ATableName, AFieldName: String;
AFieldType: TFieldType; ASize: Integer=0);
var
ft: String;
sql: String;
begin
if AFieldType = ftInteger then
ft := 'INTEGER' else
if (AFieldType = ftString) then
ft := 'VARCHAR(' + intToStr(ASize) + ')'
else
raise Exception.Create('Field type not supported here.');
sql := Format('ALTER TABLE %s ADD COLUMN %s %s;', [ATablename, AFieldName, ft]);
FConnection.ExecuteDirect(sql);
end;
procedure TVpZeosDatastore.CreateAllTables;
@@ -83,7 +110,8 @@ begin
if not FTasksTable.Exists then CreateTable(TasksTableName);
end;
procedure TVpZeosDatastore.CreateTable(const ATableName: String);
procedure TVpZeosDatastore.CreateTable(const ATableName: String;
CreateIndex: Boolean = true);
begin
if ATableName = ContactsTableName then begin
FConnection.ExecuteDirect(
@@ -147,6 +175,7 @@ begin
'UserField8 VARCHAR(100), '+
'UserField9 VARCHAR(100) )'
);
if CreateIndex then begin
FConnection.ExecuteDirect(
'CREATE INDEX ContactsResourceID_idx ON Contacts(ResourceID)'
);
@@ -156,6 +185,7 @@ begin
FConnection.ExecuteDirect(
'CREATE INDEX ContactsCompany_idx ON Contacts(Company)'
);
end;
end else
if ATableName = EventsTableName then begin
FConnection.ExecuteDirect(
@@ -188,6 +218,7 @@ begin
'UserField8 VARCHAR(100), '+
'UserField9 VARCHAR(100) )'
);
if CreateIndex then begin
FConnection.ExecuteDirect(
'CREATE INDEX EventsResourceID_idx ON Events(ResourceID)'
);
@@ -197,6 +228,7 @@ begin
FConnection.ExecuteDirect(
'CREATE INDEX EventsEndTime_idx ON Events(EndTime)'
);
end;
end else
if ATableName = ResourceTableName then begin
FConnection.ExecuteDirect(
@@ -242,6 +274,7 @@ begin
'UserField8 VARCHAR(100), '+
'UserField9 VARCHAR(100) )'
);
if CreateIndex then begin
FConnection.ExecuteDirect(
'CREATE INDEX TasksResourceID_idx ON Tasks(ResourceID)'
);
@@ -252,6 +285,7 @@ begin
'CREATE INDEX TasksCompletedOn_idx ON Tasks(CompletedOn)'
);
end;
end;
end;
procedure TVpZeosDatastore.CreateTables;
@@ -264,6 +298,86 @@ begin
SetConnected(wasConnected or AutoConnect);
end;
procedure TVpZeosDatastore.FixContactsTable;
var
list: TStrings;
autocommit: Boolean;
fieldnames: TStrings;
begin
autocommit := FConnection.AutoCommit;
ContactsTable.Close;
list := TStringList.Create;
try
FConnection.GetColumnNames(ContactsTableName, '', list);
FConnection.AutoCommit := false;
try
// Fields renamed in 1.05
fieldnames := TStringList.Create;
try
if list.IndexOf('Address') > -1 then fieldnames.Add('Address|Address1');
if list.IndexOf('City') > -1 then fieldnames.Add('City|City1');
if list.IndexOf('State') > -1 then fieldnames.Add('State|State1');
if list.IndexOf('Zip') > -1 then fieldnames.Add('Zip|Zip1');
if list.IndexOf('Country') > -1 then fieldnames.Add('Country|Country1');
if list.IndexOf('EMail') > -1 then fieldnames.Add('EMail|EMail1');
if fieldnames.Count > 0 then begin
RenameFields(ContactsTableName, fieldnames);
exit; // This automatically creates the new fields
end;
finally
fieldnames.Free;
end;
// Fields added in 1.05
if list.IndexOf('Department') = -1 then
AddField(ContactsTableName, 'Department', ftString, 50);
if list.IndexOf('AddressType1') = -1 then
AddField(ContactsTableName, 'AddressType1', ftInteger);
if list.IndexOf('AddressType2') = -1 then
AddField(ContactsTableName, 'AddressType2', ftInteger);
if list.IndexOf('Address2') = -1 then
AddField(ContactsTableName, 'Address2', ftString, 100);
if list.IndexOf('City2') = -1 then
AddField(ContactsTableName, 'City2', ftString, 50);
if list.IndexOf('State2') = -1 then
AddField(ContactsTableName, 'State2', ftString, 25);
if list.IndexOf('Zip2') = -1 then
AddField(ContactsTableName, 'Zip2', ftString, 10);
if list.IndexOf('country2') = -1 then
AddField(ContactsTableName, 'Country2', ftString, 25);
if list.IndexOf('EMail2') = -1 then
AddField(ContactsTableName, 'EMail2', ftString, 100);
if list.IndexOf('EMail3') = -1 then
AddField(ContactsTableName, 'EMail3', ftString, 100);
if list.IndexOf('EMailType1') = -1 then
AddField(ContactsTableName, 'EMailType1', ftInteger);
if list.IndexOf('EMailType2') = -1 then
AddField(ContactsTableName, 'EMailType2', ftInteger);
if list.IndexOf('EMailType3') = -1 then
AddField(ContactsTableName, 'EMailType3', ftInteger);
if list.IndexOf('Website1') = -1 then
AddField(ContactsTableName, 'Website1', ftString, 100);
if list.IndexOf('Website2') = -1 then
AddField(ContactsTableName, 'Website2', ftString, 100);
if list.IndexOf('WebsiteType1') = -1 then
AddField(ContactsTableName, 'WebsiteType1', ftInteger);
if list.IndexOf('WebsiteType2') = -1 then
AddField(ContactsTableName, 'WebsiteType2', ftInteger);
FConnection.Commit;
except
FConnection.Rollback;
raise Exception.Create('Failure to update table structure to current VisualPlanIt version');
end;
finally
list.Free;
end;
FConnection.Connected := false;
FConnection.AutoCommit := autocommit;
FConnection.Connected := true;
end;
function TVpZeosDatastore.GetContactsTable: TDataset;
begin
Result := FContactsTable;
@@ -309,6 +423,96 @@ begin
FConnection := nil;
end;
{ Renames the fields specified in the list. Each list item contains old and new
fieldnames separated by a bar character (|).
Note that sqlite3 does not provide a command for renaming of fields. Therefore,
the old table is renamed to a temp table, a new table with the renamed fields
is created and the content of the temp table is copied to the new table.
Finally the temp table is deleted.
See:
https://stackoverflow.com/questions/805363/how-do-i-rename-a-column-in-a-sqlite-database-table
TO DO:
Take care of the case that a renamed field belongs to an index, constraint, etc.
(this case is ignored currently). }
procedure TVpZeosDatastore.RenameFields(ATableName: String; AFields: TStrings);
const
NO_INDEX = false;
var
sql: String;
oldFields: TStrings;
oldfn, newfn: String;
srcfn, destfn: String;
i, j, p: Integer;
done: Boolean;
begin
oldfields := TStringList.Create;
try
FConnection.GetColumnNames(ATableName, '', oldfields);
{ 1 - Rename old table (append _TMP to tablename) }
sql := Format('ALTER TABLE %0:s RENAME TO %0:s_TMP;', [ATableName]);
FConnection.ExecuteDirect(sql);
{ 2 - Create new table }
if ATableName = ContactsTableName then
CreateTable(ContactsTableName, NO_INDEX) else
if ATablename = EventsTableName then
CreateTable(EventsTablename, NO_INDEX) else
if ATableName = ResourceTableName then
CreateTable(ResourceTableName, NO_INDEX) else
if ATableName = TasksTableName then
CreateTable(TasksTableName, NO_INDEX)
else
raise Exception.Create('Unknown table in RenameFields.');
{ 3 - Copy contents from temp table to new table }
srcfn := '';
destfn := '';
for i:=0 to oldfields.Count-1 do begin
done := false;
// Is field "oldfields[i]" contained in the list of fields to be renamed?
for j:=0 to AFields.Count-1 do begin
p := pos('|', AFields[j]);
oldfn := copy(AFields[j], 1, p-1);
newfn := copy(AFields[j], p+1, MaxInt);
if oldfn = oldfields[i] then begin
// yes: add old field name to srcfn, new field name to destfn
srcfn := srcfn + ',' + oldfn;
destfn := destfn + ',' + newfn;
done := true;
break;
end;
end;
if not done then begin
// no: add current field name to srcfn and destfn
srcfn := srcfn + ',' + oldfields[i];
destfn := destfn + ',' + oldfields[i];
end;
end;
// Remove the beginning comma added above.
if srcfn <> '' then System.Delete(srcfn, 1, 1);
if destfn <> '' then System.Delete(destfn, 1, 1);
// Execute INSERT command
sql := Format(
'INSERT INTO %0:s (%1:s) SELECT %2:s FROM %0:s_TMP;', [
ATableName, destfn, srcfn
]);
FConnection.ExecuteDirect(sql);
{ 4 - Finally delete the temp table }
sql := Format('DROP TABLE %s_TMP;', [ATableName]);
FConnection.ExecuteDirect(sql);
FConnection.Disconnect;
FConnection.Connect;
finally
oldfields.Free;
end;
end;
procedure TVpZeosDatastore.SetConnected(const AValue: Boolean);
begin
if (AValue = Connected) or (FConnection = nil) then
@@ -319,6 +523,7 @@ begin
FConnection.Connected := AValue;
if FConnection.Connected then begin
FixContactsTable;
FContactsTable.Open;
FEventsTable.Open;
FResourceTable.Open;

2
components/tvplanit/source/vpfbds.pas
View File

@@ -128,7 +128,7 @@ var
sql: String;
begin
sql := Format('ALTER TABLE %s ALTER %s TO %s;',
[ContactsTableName, AOldFieldName, ANewFieldName]);
[ATableName, AOldFieldName, ANewFieldName]);
FConnection.ExecuteDirect(sql);
end;

2
components/tvplanit/source/vpsqlite3ds.pas
View File

@@ -135,7 +135,7 @@ var
done: Boolean;
begin
{ 1 - Rename old table (append _TMP to tablename) }
sql := Format('ALTER TABLE %0:s RENAME TO %0:s_TMP;', [ContactsTableName]);
sql := Format('ALTER TABLE %0:s RENAME TO %0:s_TMP;', [ATableName]);
FConnection.ExecuteDirect(sql);
{ 2 - Create new table }