diff --git a/components/tvplanit/examples/datastores/sqlite3/unit1.lfm b/components/tvplanit/examples/datastores/sqlite3/unit1.lfm index b7ef81086..782c9ed77 100644 --- a/components/tvplanit/examples/datastores/sqlite3/unit1.lfm +++ b/components/tvplanit/examples/datastores/sqlite3/unit1.lfm @@ -377,7 +377,7 @@ object Form1: TForm1 end object SQLTransaction1: TSQLTransaction Active = False - Action = caCommit + Action = caCommitRetaining Database = SQLite3Connection1 Options = [] left = 256 diff --git a/components/tvplanit/source/vpdbds.pas b/components/tvplanit/source/vpdbds.pas index 9af9ef1e4..91e400aa6 100644 --- a/components/tvplanit/source/vpdbds.pas +++ b/components/tvplanit/source/vpdbds.pas @@ -1283,7 +1283,7 @@ begin F := FindField('EMail2'); if F <> nil then AContact.EMail2 := F.AsString; F := FindField('EMail3'); - if F <> nil then AContact.EMail := F.AsString; + if F <> nil then AContact.EMail3 := F.AsString; F := FindField('EMailType1'); if F <> nil then AContact.EMailType1 := F.AsInteger; F := FindField('EMailType2'); diff --git a/components/tvplanit/source/vpfbds.pas b/components/tvplanit/source/vpfbds.pas index 882ff03f8..721523513 100644 --- a/components/tvplanit/source/vpfbds.pas +++ b/components/tvplanit/source/vpfbds.pas @@ -23,13 +23,8 @@ type procedure SetConnection(const AValue: TIBConnection); protected - procedure Addfield(ATableName, AFieldName: String; AFieldType: TFieldType; - ASize: Integer=0); - procedure RenameField(ATableName, AOldFieldName, ANewFieldName: String); - procedure CreateAllTables(dbIsNew: Boolean); procedure CreateTable(const ATableName: String); - procedure FixContactsTable; function GetContactsTable: TDataset; override; function GetEventsTable: TDataset; override; function GetResourceTable: TDataset; override; @@ -39,6 +34,13 @@ type procedure OpenTables; procedure SetConnected(const AValue: Boolean); override; + protected + // Fix old tables + procedure AddField(ATableName, AFieldName: String; AFieldType: TFieldType; + ASize: Integer=0); + procedure RenameField(ATableName, AOldFieldName, ANewFieldName: String); + procedure FixContactsTable; + public constructor Create(AOwner: TComponent); override; procedure CreateTables; @@ -441,7 +443,7 @@ begin if list.IndexOf('State2') = -1 then AddField(ContactsTableName, 'State2', ftString, 25); if list.IndexOf('Zip2') = -1 then - AddField(ContactsTableName, 'Zip2', ftString, 25); + AddField(ContactsTableName, 'Zip2', ftString, 10); if list.IndexOf('country2') = -1 then AddField(ContactsTableName, 'Country2', ftString, 25); if list.IndexOf('EMail2') = -1 then diff --git a/components/tvplanit/source/vpsqlite3ds.pas b/components/tvplanit/source/vpsqlite3ds.pas index 2739e41a3..0d7f948a6 100644 --- a/components/tvplanit/source/vpsqlite3ds.pas +++ b/components/tvplanit/source/vpsqlite3ds.pas @@ -20,7 +20,7 @@ type procedure SetConnection(const AValue: TSqlite3Connection); protected - procedure CreateTable(const ATableName: String); + procedure CreateTable(const ATableName: String; WithIndex: Boolean = true); function GetContactsTable: TDataset; override; function GetEventsTable: TDataset; override; function GetResourceTable: TDataset; override; @@ -30,6 +30,13 @@ type procedure OpenTables; 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; @@ -85,6 +92,112 @@ begin FTasksTable.SQL.Add('SELECT * FROM Tasks'); end; +procedure TVpSqlite3Datastore.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; + +{ 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 TVpSqlite3Datastore.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 + { 1 - Rename old table (append _TMP to tablename) } + sql := Format('ALTER TABLE %0:s RENAME TO %0:s_TMP;', [ContactsTableName]); + 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 } + oldFields := TStringList.Create; + try + // Get old field list + FConnection.GetFieldNames(ATableName + '_TMP', oldfields); + // Combine comma-separated old and new field names in srcfn and destfn + // strings ready for use by INSERT command. + 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); + finally + oldfields.Free; + end; + + { 4 - Finally delete the temp table } + sql := Format('DROP TABLE %s_TMP;', [ATableName]); + FConnection.ExecuteDirect(sql); +end; + // Connection and tables are active afterwards! procedure TVpSqlite3Datastore.CreateTables; var @@ -114,7 +227,8 @@ begin SetConnected(wasConnected or AutoConnect); end; -procedure TVpSqlite3Datastore.CreateTable(const ATableName: String); +procedure TVpSqlite3Datastore.CreateTable(const ATableName: String; + WithIndex: Boolean = true); begin if ATableName = ContactsTableName then begin FConnection.ExecuteDirect( @@ -130,13 +244,13 @@ begin 'Company VARCHAR(50), '+ 'Department VARCHAR(50), '+ 'Job_Position VARCHAR(30), '+ - 'AddressType1 INTEGER, '+ + 'AddressType1 INTEGER DEFAULT 0, '+ 'Address1 VARCHAR(100), '+ 'City1 VARCHAR(50), '+ 'State1 VARCHAR(25), '+ 'Zip1 VARCHAR(10), '+ 'Country1 VARCHAR(25), '+ - 'AddressType2 INTEGER, '+ + 'AddressType2 INTEGER DEFAULT 1, '+ 'Address2 VARCHAR(100), '+ 'City2 VARCHAR(50), '+ 'State2 VARCHAR(25), '+ @@ -156,13 +270,13 @@ begin 'EMail1 VARCHAR(100), '+ 'EMail2 VARCHAR(100), '+ 'EMail3 VARCHAR(100), '+ - 'EMailType1 INTEGER, '+ - 'EMailType2 INTEGER, '+ - 'EMailType3 INTEGER, '+ + 'EMailType1 INTEGER DEFAULT 0, '+ + 'EMailType2 INTEGER DEFAULT 1, '+ + 'EMailType3 INTEGER DEFAULT 2, '+ 'Website1 VARCHAR(100), '+ 'Website2 VARCHAR(100), '+ - 'WebsiteType1 INTEGER, '+ - 'WebsiteType2 INTEGER, '+ + 'WebsiteType1 INTEGER DEFAULT 0, '+ + 'WebsiteType2 INTEGER DEFAULT 1, '+ 'Custom1 VARCHAR(100), '+ 'Custom2 VARCHAR(100),'+ 'Custom3 VARCHAR(100), '+ @@ -178,15 +292,17 @@ begin 'UserField8 VARCHAR(100), '+ 'UserField9 VARCHAR(100) )' ); - FConnection.ExecuteDirect( - 'CREATE INDEX ContactsResourceID_idx ON Contacts(ResourceID)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX ContactsName_idx ON Contacts(LastName, FirstName)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX ContactsCompany_idx ON Contacts(Company)' - ); + if WithIndex then begin + FConnection.ExecuteDirect( + 'CREATE INDEX ContactsResourceID_idx ON Contacts(ResourceID)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX ContactsName_idx ON Contacts(LastName, FirstName)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX ContactsCompany_idx ON Contacts(Company)' + ); + end; end else if ATableName = EventsTableName then begin FConnection.ExecuteDirect( @@ -219,15 +335,17 @@ begin 'UserField8 VARCHAR(100), '+ 'UserField9 VARCHAR(100) )' ); - FConnection.ExecuteDirect( - 'CREATE INDEX EventsResourceID_idx ON Events(ResourceID)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX EventsStartTime_idx ON Events(StartTime)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX EventsEndTime_idx ON Events(EndTime)' - ); + if WithIndex then begin + FConnection.ExecuteDirect( + 'CREATE INDEX EventsResourceID_idx ON Events(ResourceID)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX EventsStartTime_idx ON Events(StartTime)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX EventsEndTime_idx ON Events(EndTime)' + ); + end; end else if ATableName = ResourceTableName then begin FConnection.ExecuteDirect( @@ -273,15 +391,87 @@ begin 'UserField8 VARCHAR(100), '+ 'UserField9 VARCHAR(100) )' ); - FConnection.ExecuteDirect( - 'CREATE INDEX TasksResourceID_idx ON Tasks(ResourceID)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX TasksDueDate_idx ON Tasks(DueDate)' - ); - FConnection.ExecuteDirect( - 'CREATE INDEX TasksCompletedOn_idx ON Tasks(CompletedOn)' - ); + if WithIndex then begin + FConnection.ExecuteDirect( + 'CREATE INDEX TasksResourceID_idx ON Tasks(ResourceID)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX TasksDueDate_idx ON Tasks(DueDate)' + ); + FConnection.ExecuteDirect( + 'CREATE INDEX TasksCompletedOn_idx ON Tasks(CompletedOn)' + ); + end; + end; +end; + +{ Updates the contacts table and adds/renames new fields in the current version. + IMPORTANT: The renaming process assumes that the renamed column is not part of + any index. } +procedure TVpSqlite3Datastore.FixContactsTable; +var + list: TStrings; + fnames: TStrings; +begin + ContactsTable.Close; + list := TStringList.Create; + try + FConnection.GetFieldNames(ContactsTableName, list); + + // Fields renamed in 1.05 + fnames := TStringList.Create; + try + if list.IndexOf('Address') > -1 then fnames.Add('Address|Address1'); + if list.IndexOf('City') > -1 then fnames.Add('City|City1'); + if list.IndexOf('State') > -1 then fnames.Add('State|State1'); + if list.IndexOf('Zip') > -1 then fnames.Add('Zip|Zip1'); + if list.IndexOf('Country') > -1 then fnames.Add('Country|Country1'); + if list.IndexOf('EMail') > -1 then fnames.Add('EMail|EMail1'); + if fnames.Count > 0 then begin + RenameFields(ContactsTableName, fnames); + exit; // This automatically creates the new fields + end; + finally + fnames.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); + finally + list.Free; end; end; @@ -332,6 +522,7 @@ procedure TVpSqlite3Datastore.OpenTables; begin if FContactsTable.Transaction = nil then FContactsTable.Transaction := FConnection.Transaction; + FixContactsTable; FContactsTable.Open; if FEventsTable.Transaction = nil then diff --git a/components/tvplanit/source/vpsr.pas b/components/tvplanit/source/vpsr.pas index 1aeda40df..bdadfc7e8 100644 --- a/components/tvplanit/source/vpsr.pas +++ b/components/tvplanit/source/vpsr.pas @@ -43,11 +43,11 @@ type ptISDN, ptMobile, ptOther, ptOtherFax, ptPager, ptPrimary, ptRadio, ptTelex, ptTTYTDD, ptWork, ptWorkFax); - TVpEMailType = (mtHome, mtOther, mtWork); + TVpEMailType = (mtWork, mtHome, mtOther); TVpWebSiteType = (wtBusiness, wtPersonal); - TVpAddressType = (atHome, atWork); + TVpAddressType = (atWork, atHome); TVpCategoryType = (ctBusiness, ctClients, ctFamily, ctOther, ctPersonal);