I experience a, for me unsolvable, problem with ATTACH and DETACH in SQLite, using Delphi (Firedac).
I have one database file connected and attach a second one with:
FDConnection1.ExecSQL('ATTACH DATABASE "' + Import_DB_filename + '" AS IMPORTDB;');
Therein, the variable 'Import_DB_filename' contains the full path and filename of the database file.
This works OK and I can access both databases within the connection through the FireDac queries, and can do my coding without problems.
However, things go wrong upon detaching:
FDConnection1.ExecSQL('DETACH DATABASE IMPORTDB;');
In debugging mode, I always get the error:
Debugger Exception Notification
E Project My_Program.EXE raised exception class $C0000005 with message 'access violation at 0x00405d7b: read of address 0x00000000'.
Apparently something goes wrong with the memory assignments, since the debugger stops in a (assembly) function SysFreeMem(P:Pointer): Integer; in GETMEM.INC.
Whatever I try, the error persists and associates a memory leak that eventually leads to a crash of the compiler (Delphi Seattle Enterprise).
Even attaching and subsequent detaching of the database without passing any code results in the same error.
(FDconnection: locking mode = lmNormal;
JournalMode = jmOff or jmWALL or jmdelete)
I do hope that you can help me out on this lasting problem.
If you run the project below, you should find that:
You can access two Sqlite databases quite happily using separate FDConnections and FDTables.
You can move data from a table in one db to a table of the same name in the other using a FireDAC FDDataMove component.
Code:
unit BatchMoveu;
interface
[...]
type
TForm3 = class(TForm)
FDConnection1: TFDConnection;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
DBNavigator1: TDBNavigator;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink;
Button1: TButton;
FDTable1: TFDTable;
FDConnection2: TFDConnection;
DataSource2: TDataSource;
DBGrid2: TDBGrid;
btnBatchMove: TButton;
FDDataMove1: TFDDataMove;
FDTable2: TFDTable;
procedure btnBatchMoveClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure PopulateTable1;
procedure TestDataMove;
public
procedure CreateDatabase(DBName : String; FDConnection : TFDConnection;
FDTable : TFDTable);
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
const
DBName1 = 'd:\delphi\code\sqlite\db1.sqlite';
DBName2 = 'd:\delphi\code\sqlite\db2.sqlite';
procedure TForm3.Button1Click(Sender: TObject);
begin
CreateDatabase(DBName1, FDConnection1, FDTable1);
CreateDatabase(DBName2, FDConnection2, FDTable2);
PopulateTable1;
FDTable2.Open;
end;
procedure TForm3.CreateDatabase(DBName : String; FDConnection : TFDConnection;
FDTable : TFDTable);
var
AField : TField;
i : Integer;
begin
if FileExists(DBName) then
DeleteFile(DBName);
AField := TLargeIntField.Create(Self);
AField.FieldName := 'ID';
AField.DataSet := FDTable;
AField.Name := AField.DataSet.Name + 'IDField';
AField := TWideStringField.Create(Self);
AField.Size := 80;
AField.FieldName := 'Name';
AField.DataSet := FDTable;
AField.Name := AField.DataSet.Name + 'NameField';
FDConnection.Params.Values['database'] := DBName;
FDConnection.Connected:= True;
FDTable.CreateTable(False, [tpTable]);
end;
procedure TForm3.PopulateTable1;
var
i : Integer;
begin
FDTable1.Open;
for i:= 1 to 1000 do begin
FDTable1.InsertRecord([i, 'Row ' + IntToStr(i)]);
end;
FDTable1.Close;
//FDConnection1.Commit;
FDTable1.Open;
end;
procedure TForm3.TestDataMove;
var
Item : TFdMappingItem;
begin
Item := FDDataMove1.Mappings.Add;
Item.SourceFieldName := 'ID';
Item.DestinationFieldName := 'ID';
Item := FDDataMove1.Mappings.Add;
Item.SourceFieldName := 'Name';
Item.DestinationFieldName := 'Name';
FDDataMove1.Source := FDTable1;
FDDataMove1.Destination := FDTable2;
FDDataMove1.Options := FDDataMove1.Options - [poOptimiseSrc];
FDDataMove1.Execute;
FDConnection2.Connected := False;
FDTable2.Open;
end;
procedure TForm3.btnBatchMoveClick(Sender: TObject);
begin
TestDataMove;
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
FDConnection1.Close;
end;
end.
Related
I'm working on porting a set of paradox tables to SQLite. In order to do so, I created a test application that simulates (somewhat) the current usage scenario: multiple users accessing the same DB file and performing simultaneous read and writes.
The application is very simple: it will start several threads that each create a connection, opens a table and will randomly read, update or insert inside the table.
Almost immediately, The application encounters a "database table locked" error. I have tried several things to attempt to work around it but nothing seems to work. What am I doing wrong ?
Here is the code internal to the threads:
procedure testDB(TargetFolder: string);
var
Conn: TFDConnection;
Table: TFDTable;
i: Integer;
begin
randomize;
Conn := TFDConnection.Create(nil);
try
Conn.DriverName := 'SQLite';
Conn.LoginPrompt := false;
Conn.Params.clear;
Conn.Params.Database := TPath.Combine(TargetFolder, 'testDB.sdb');
Conn.Params.Add('DriverID=SQLite');
// all this is the result of several attemp to fix the table locking error. none worked
Conn.Params.Add('LockingMode=Normal');
Conn.Params.Add('Synchronous=Normal');
Conn.UpdateOptions.UpdateMode := TUpdateMode.upWhereAll;
Conn.UpdateOptions.LockWait := True;
Conn.UpdateOptions.LockMode := TFDLockMode.lmPessimistic;
Conn.UpdateOptions.LockPoint := TFDLockPoint.lpImmediate;
Conn.UpdateOptions.AssignedValues := [uvLockMode,uvLockPoint,uvLockWait];
Conn.Open();
Conn.ExecSQL('CREATE TABLE IF NOT EXISTS ''test'' (''ID'' INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT UNIQUE,''data1'' TEXT NOT NULL,''data2'' INTEGER NOT NULL)');
Table := TFDTable.Create(nil);
try
table.Connection := Conn;
while True do
begin
case Trunc(Random(10)) of
0..3:
begin
table.Open('test');
try
if table.Locate('data1', 'name'+intToStr(Trunc(Random(10))),[TLocateOption.loCaseInsensitive]) then
begin
table.Edit;
table.FieldByName('data2').AsInteger := table.FieldByName('data2').AsInteger + 1;
table.Post;
end;
finally
table.close;
end;
end;
4..8:
begin
table.Open('test');
try
i := Trunc(Random(10));
if not table.Locate('data1', 'name'+ i.ToString,[TLocateOption.loCaseInsensitive]) then
begin
table.AppendRecord([null, 'name'+ i.ToString, 0]);
end;
finally
table.close;
end;
end
else
break;
end;
end;
finally
FreeAndNil(Table);
end;
finally
FreeAndNil(Conn);
end;
end;
Thanks to Victoria, I managed to find the right parameters.
Conn := TFDConnection.Create(nil);
try
Conn.DriverName := 'SQLite';
Conn.LoginPrompt := false;
Conn.Params.clear;
Conn.Params.Database := TPath.Combine(TargetFolder, 'testDB.sdb');
Conn.Params.Add('DriverID=SQLite');
Conn.Params.Add('SharedCache=False');
Conn.Params.Add('LockingMode=Normal');
Conn.Params.Add('Synchronous=Normal');
Conn.UpdateOptions.LockWait := True;
Conn.Open();
Thanks again
I am trying to save binary encoded data in SQLite database and I am able to save the values but there are few characters that are getting lost after saving and closing the dataset.
The inserted data looks like this.
The highlighted text is getting lost when I load the saved record in a grid or table.
Create SQLite connection:
procedure CreateSQLiteDB(ASQLiteDB: string);
begin
FDConnection1.Params.Values['Database'] := 'DB_MOBILE';
FDConnection1.Connected := true;
end;
Copy table schema from an existing dataset:
procedure CopyTableSchemaFrom(ADataset: TDataset;
ATableNm: string);
var
i: Integer;
AField: TField;
procedure L_CopyFieldDefToSQLiteTable(AName: string; aType: TDataType;
ASize: Integer; AIsRqrd: Boolean);
var
LFldSz: Integer;
begin
LFldSz:= 0;
case aType of
ftString, ftWideString, ftBCD, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic: LFldSz:= ASize;
end;
tblSQLite.FieldDefs.Add(AName, aType, LFldSz, AIsRqrd);
end;
begin
if ADataset = nil then
Assert(false, 'Unassigned argument supplied in ADataset.');
if Trim(ATableNm) = '' then
Assert(false, 'Empty argument supplied in ATableNm.');
// SQLite Table name should be same as .DBF file name
tblSQLite.TableName := ATableNm;
{ Loop through the field in source dataset and copy them to SQLite table. }
for i := 0 to ADataset.FieldCount - 1 do
begin
AField := ADataset.Fields[i];
if AField = nil then
Continue;
L_CopyFieldDefToSQLiteTable(AField.FieldName, AField.DataType,
AField.DataSize, AField.Required);
end;
tblSQLite.CreateDataSet;
end;
Copy value from existing dataset to SQLite;
procedure CopyDataFrom(ASrc: TDataset;
ASQLiteTblNm: string);
var
i: Integer;
begin
if ASrc = nil then
Assert(false, 'Unassigned argument supplied in ASrc.');
if Trim(ASQLiteTblNm) = '' then
Assert(false, 'Empty argument supplied in ASQLiteTblNm.');
tblSQLite.Close;
tblSQLite.CachedUpdates := true;
tblSQLite.Active := true;
ASrc.First;
while not ASrc.Eof do
begin
tblSQLite.Insert;
for i := 0 to ASrc.FieldCount - 1 do
begin
tblSQLite.Fields[i].Value := ASrc.Fields[i].Value;
end;
ASrc.Next;
end;
tblSQLite.ApplyUpdates;
tblSQLite.CommitUpdates;
end;
I am attempting to encrypt/decrypt a SQLite database via FireDAC in a Delphi XE7 application running on Windows 7 (64 bit).
The code looks like this:
Procedure TMain.ActionBtnClick(Sender: TObject);
Begin
If ActionBtn.Caption = 'Encrypt' Then
Begin
SetPassword;
FDSQLiteSecurity.SetPassword;
End
Else
FDSQLiteSecurity.RemovePassword;
SetStatus;
End;
Procedure TMain.DBNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
Begin
If OpenDialog.Execute Then
Begin
DBName.Text := OpenDialog.FileName;
SetStatus;
End;
End;
Procedure TMain.FormClose(Sender: TObject; Var Action: TCloseAction);
Var
Reg: TRegistry;
Begin
Reg := TRegistry.Create;
Try
Reg.OpenKey('\SQLiteSecurity', True);
Reg.WriteString('Database', DBName.Text);
Finally
Reg.CloseKey;
Reg.Free;
End;
End;
Procedure TMain.FormShow(Sender: TObject);
Var
Reg: TRegistry;
Begin
DBStatus.Caption := '';
Reg := TRegistry.Create;
Try
Reg.OpenKey('\SQLiteSecurity', True);
If Reg.ValueExists('Database') Then
Begin
DBName.Text := Reg.ReadString('Database');
SetStatus;
End;
Finally
Reg.CloseKey;
Reg.Free;
End;
End;
Procedure TMain.SetPassword;
Var
s: String;
Begin
FDSQLiteSecurity.Database := DBName.Text;
BEK(s);
FDSQLiteSecurity.Password := s;
End;
Procedure TMain.SetStatus;
Begin
DBStatus.Caption := FDSQLiteSecurity.CheckEncryption;
If DBStatus.Caption = '<unencrypted>' Then
ActionBtn.Caption := 'Encrypt'
Else
ActionBtn.Caption := 'Decrypt';
End;
When trying to encrypt, at the line that reads "FDSQLiteSecurity.SetPassword;", I get the following error message:
[FireDAC][Phys][SQLite] ERROR: Cipher: failed to reserve an envelope space.
I have tried to find the meaning of this error message without success. Does anyone know what the error message from SQLite is trying to tell me?
TFDSQLiteSecurityOptions FireDAC.Phys.SQLite.TFDSQLiteSecurity.Options
Have you set option soSetLargeCache ?
Use the Options property to specify the database encryption options.
Due to current SQLite encryption limitation the SetPassword / ChangePassword / RemovePassword calls will fail, if the database has blob fields with a value size greater than 1 DB page, and the database does not fit into the SQLite cache.
If soSetLargeCache is set, then SetPassword / ChangePassword / RemovePassword automatically set the cache size greater than the DB size, to fit the database into the memory in full.
If the DB size is greater than the accessible system memory, then the corresponding call fails.
I've been doing my university project and I've stumbled upon problem I cannot solve.
After declaring variable (a pointer to TButton) I cannot use it. I'll copy a part of my code to help show the problem.
So before the implementation I have
private
prevButton : ^TButton;
After that I use OnClick procedure with my buttons
procedure TForm2.MissingButtonClick(Sender : TObject);
var
b : TButton;
begin
b := Sender as TButton;
prevButton := #b;
showmessage(prevButton^.Caption);
end;
And caption is shown no problem. But then when I use my OnClick procedure and try to change labels caption I get access violation.
procedure TForm2.LabelClick(Sender : TObject);
var
l : TLabel;
begin
l := Sender as TLabel;
if prevButton = nil then
showmessage('nil');
if prevButton <> nil then begin
showmessage(prevButton^.Caption);
l.Caption := (prevButton^.Caption);
prevButton^.OnClick := #AlreadyClicked;
prevButton^.Free;
prevButton^ := nil;
prevButton := nil;
refreshLabels(words);
end;
end;
So here is the question, why can't I use my variable in this procedure if I could use it without problem second earlier in other procedure.
Cheers.
Your code is severely flawed in several places.
First, the initial declaration is incorrect. A variable of type TButton is already a pointer, so you don't have to dereference it:
private
prevButton: TButton;
You also don't have to dereference it when assigning to it or using it:
procedure TForm2.MissingButtonClick(Sender : TObject);
begin
prevButton := TButton(Sender);
showmessage(prevButton.Caption);
end;
I'm not sure what your LabelClick event is trying to accomplish. If you free prevButton, you also invalidate the original button to which you pointed it. In other words, if you assigned prevButton := Button1;, and then prevButton.Free;, you've also freed Button1, and I don't think that's your intent. You can safely assign nil to prevButton, but don't free it also:
prevButton := nil; // No longer points to existing object instance
If you want to change the OnClick of an existing button, don't jump through all of those hoops:
// Assign this to the button's OnClick in the Object Inspector
procedure TForm1.Button1FirstClick(Sender: TObject);
begin
ShowMessage('First time I was clicked');
Button1.OnClick := #Button1AfterClicked;
end;
// Create these two in the code editor, and declare it in the
// form declaration, but don't assign it to an event of the button
// in the Object Inspector
procedure TForm1.Button1AfterClick(Sender: TObject);
begin
ShowMessage('Second time clicked');
Button1.OnClick := #Button1MoreClicks;
end;
procedure TForm1.Button1MoreClicks(Sender: TObject);
begin
ShowMessage('Third and later clicks');
end;
I'm with a problem on Delphi, i create a simple app to test the mobile power of RadStudio, I created a simple app that put some data into some inputs and then add it to database when button is clicked. I followed this Embarcadero tutorial as starting point
The problem is that I only get one entry added, then no more entries are added or the list is not refreshed. Below some code:
Table creation:
procedure TTabbedForm.logAfterConnect(Sender: TObject);
begin
log.ExecuteDirect('CREATE TABLE IF NOT EXISTS lista (id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,idCons INTEGER,nome TEXT,kms INTEGER,kmsAlarme INTEGER,quantidade INTEGER,quantidadeAlarme INTEGER,data INTEGER,dataAlarme INTEGER,alarmeMsg TEXT)');
end;
Add button code:
procedure TTabbedForm.btnGravarClick(Sender: TObject);
begin
try
SQLQueryInsert.ParamByName('idCons').AsInteger := PopupBoxTipo.ItemIndex;
SQLQueryInsert.ParamByName('nome').AsString := PopupBoxTipo.Text;
SQLQueryInsert.ParamByName('kms').AsInteger := StrToInt(kmsEdit.Text);
SQLQueryInsert.ParamByName('quantidade').AsInteger := StrToInt(qtdEdit.Text);
SQLQueryInsert.ParamByName('data').AsInteger := DateTimeToUnix(dtaEvento.Date);
SQLQueryInsert.ExecSQL();
lista.Refresh;
LinkFillControlToField1.BindList.FillList;
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
end;
If you need some more code snippet, please ask!
Thanks in advance for any reply!
Try this method it works for me
procedure TData.InsertItem(someObject: TSomeObjectClass);
var
qry: TFDQuery;
begin
qry := CreateQry( 'insert into SomeObject(id, description, something)'+
' values (:id, :description, :something);', false);
qry.Params.ParamByName('id').AsInteger := someObject.id;
qry.Params.ParamByName('description').asstring := someObject.description;
qry.Params.ParamByName('something').asstring := someObject.something;
qry.Prepare;
qry.execsql;
qry.Free;
end;
I've put and object in the parameter but you can also put the data you want to insert seperatly