mORMot Open Source

unit fmTest;

interface

uses
	Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls,
	SynCommons, SynDB, SynDBSQLite3, SynSQLite3, SynSQLite3Static;

type
	TfrmTest = class(TForm)
		btnTest: TButton;
		mmoLog: TMemo;
		procedure FormCreate(Sender: TObject);
		procedure FormDestroy(Sender: TObject);
		procedure btnTestClick(Sender: TObject);
	private
		{ Private declarations }
	public
		{ Public declarations }
	end;

const
	DB_FILENAME = 'Tests.sqlite';
	
var
	frmTest: TfrmTest;
	Props: TSQLDBConnectionProperties;
	Conn: TSQLDBConnection;
	Qry: TQuery;

implementation

{$R *.dfm}

procedure TfrmTest.btnTestClick(Sender: TObject);
var
	Timer: TPrecisionTimer;
	s: string;
	i1, iTrue, iFalse: Integer;
begin
	mmoLog.Clear;
	
	with Qry do begin
		Close;
		
		SQL.Text := 'DELETE FROM Test;';
		ExecSQL;

		Timer.Start;
		
		SQL.Text := 'INSERT OR IGNORE INTO Test VALUES (:Key, :Value);';
		Conn.StartTransaction;
		for i1 := 0 to 999 do begin
			ParamByName('Key').AsString := Format('Clé %d', [i1]);
			ParamByName('Value').AsBoolean := (Random(2) = 1);
			ExecSQL;
		end;
		Conn.Commit;

		SQL.Text := 'SELECT * FROM Test;';
		Open;
		iTrue := 0;
		iFalse := 0;
		while not Eof do begin
			if Fields[1].AsBoolean then
				Inc(iTrue)
			else
				Inc(iFalse);
			Next;
		end;
	
		Timer.Stop;

		mmoLog.Lines.BeginUpdate;
		SQL.Text := 'SELECT * FROM test;';
		Open;
		(* while not Eof do begin
			Next;
			// mmoLog.Lines.Add(FieldByName('Key').AsString);
		end; *)
		First; // <<<<<<<<<<<< Happens here, but also happens if I comment this line out, so the problem could be on the next line of code !
		mmoLog.Lines.Add(Fields[0].AsString);
		mmoLog.Lines.EndUpdate;

		s := 	Format('%d valeurs à True, %d valeurs à False', [iTrue, iFalse]);
		mmoLog.Lines.Add(s);
		s := Format('Terminé en %s', [Timer.Time]);
		mmoLog.Lines.Add(s);
	end;
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
	Randomize;
	
	Props := TSQLDBSQLite3ConnectionProperties.Create(StringToUTF8(DB_FILENAME), '', '', '');
	Conn := Props.NewConnection;
	Conn.Connect;
	Qry := TQuery.Create(Conn);
	with Qry	do begin
		SQL.Text := 'PRAGMA synchronous = OFF;';
		ExecSQL;
	end;
end;

procedure TfrmTest.FormDestroy(Sender: TObject);
begin
	Qry.Free;
	Props.Free;
end;

end.