Posts by gclaxton

gclaxton · mORMot 1

What would the best way to test for an empty table, without throwing an exception?

gclaxton · mORMot 1

Administrator wrote:

And IMHO you should not use "SQL by hand" on the server side, but rely on ORM methods of the framework, if possible without using Server.DB but the Client instance, i.e. TSQLRestClientDB in your case.

Fixed! If you could be so kind and look at what I have now, and let me know if there is something else I need to look at before I actually use the code below. I have include the complete source code (link below) just in case you need to see it in action.

Source Code can be downloaded here

Administrator wrote:

I've updated the framework documentation to explain better how to use high-level ORM methods instead of SQL. Please take a look at the TSQLRest methods: you'll find here almost all needed ORM-oriented methods to change the TSQLRecord content.

Is this available online now? If so the link would be?

Drives.Data.pas

unit Drives.Data;

interface

uses
  SQLite3, SynCommons, SQLite3Commons, Classes;

type
  TSQLDriveRecord = class(TSQLRecord)
  private
    { Private declarations }
    FDrive: RawUTF8;
    FActive: Integer;
    FChecked: Integer;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property Drive: RawUTF8 read FDrive write FDrive stored false;
    property Active: Integer read FActive write FActive default 0;
    property Checked: Integer read FChecked write FChecked default 0;
  end;

  TDrivesClientDB = class(TSQLRestClientDB)
  public
    { Public declarations }
    class function GetRowCount(const theColumn: string = ''): Integer;
    class procedure GetDriveList(theItems: TStrings; const theColumn: string = '');
    class function GetCheckedDrive(const theID: Integer): Boolean;
    class procedure SetCheckedDrive(const theID: Integer; const theCheck: Boolean);
  end;

var
  DrivesClientDB: TDrivesClientDB;

implementation

uses
  Windows, SysUtils;

var
  DrivesModel: TSQLModel;

function CreateDrivesModel(): TSQLModel;
begin
  Result := TSQLModel.Create([TSQLDriveRecord], 'root');
end;

procedure InitializeClientDB();
var
  X: AnsiChar;
  DriveRecord: TSQLDriveRecord;
  Active: Integer;
begin
  DrivesModel := CreateDrivesModel();
  DrivesClientDB := TDrivesClientDB.Create(DrivesModel, nil, 'drives.sqlite', TSQLRestServerDB);

  with TSQLRestClientDB(DrivesClientDB) do
  begin
    Server.CreateMissingTables(0);
    (*
    DB.Execute('CREATE TABLE IF NOT EXISTS [driveRecord] (' +
      '[id] INTEGER PRIMARY KEY AUTOINCREMENT, ' +
      '[drive] TEXT NOT NULL UNIQUE COLLATE NOCASE, ' +
      '[active] INTEGER NOT NULL DEFAULT (0), ' +
      '[checked] INTEGER NOT NULL DEFAULT (0));');
    *)

    for X := 'A' to 'Z' do
    begin
      DriveRecord := TSQLDriveRecord.Create(TSQLRestClientDB(DrivesClientDB), Ord(X) - 64);
      try
        Active := DriveRecord.Active;

        if (Windows.GetDriveType(PChar(X + ':\')) in [0, 1]) then
          DriveRecord.Active := 0
        else
          DriveRecord.Active := 1;

        if (Length(DriveRecord.Drive) = 0) then
        begin
          DriveRecord.Drive := StringToUTF8(X) + ':\';
          DriveRecord.Checked := 0;
          Add(DriveRecord, True);
        end
        else begin
          if (Active <> DriveRecord.Active) then Update(DriveRecord);
        end;

      finally
        DriveRecord.Free();
        if (Pointer(DriveRecord) <> nil) then Pointer(DriveRecord) := nil;
      end;
    end;
  end;
end;

procedure FinalizeClientDB();
begin
  TDrivesClientDB(DrivesClientDB).Free();
  TSQLModel(DrivesModel).Free();
end;

{ TDrivesClient }
class function TDrivesClientDB.GetRowCount(const theColumn: string = ''): Integer;
var
  Data: TIntegerDynArray;
begin
  with TSQLRestClientDB(DrivesClientDB) do
    if (Length(theColumn) = 0) then
      Result := TableRowCount(TSQLDriveRecord)
    else begin
      OneFieldValues(TSQLDriveRecord, 'drive', StringToUTF8(theColumn) + '=1', Data);
      Result := high(Data) + 1;
    end;
end;

class procedure TDrivesClientDB.GetDriveList(theItems: TStrings; const theColumn: string = '');
begin
  with TSQLRestClientDB(DrivesClientDB) do
    if (Length(theColumn) = 0) then
      OneFieldValues(TSQLDriveRecord, 'drive', '', theItems)
    else begin
      OneFieldValues(TSQLDriveRecord, 'drive', StringToUTF8(theColumn) + '=1', theItems);
    end;
end;

class function TDrivesClientDB.GetCheckedDrive(const theID: Integer): Boolean;
var
  Data: TIntegerDynArray;
begin
  with TSQLRestClientDB(DrivesClientDB) do
    Result := OneFieldValues(TSQLDriveRecord, 'drive', 'id=' + IntToStr(theID) + ' and active=1 and checked=1', Data);
end;

class procedure TDrivesClientDB.SetCheckedDrive(const theID: Integer; const theCheck: Boolean);
var
  DriveRecord: TSQLDriveRecord;
begin
  DriveRecord := TSQLDriveRecord.Create(TSQLRestClientDB(DrivesClientDB), theID);
  try
    DriveRecord.Checked := Ord(theCheck);
    TSQLRestClientDB(DrivesClientDB).Update(DriveRecord);
  finally
    DriveRecord.Free();
    if (Pointer(DriveRecord) <> nil) then Pointer(DriveRecord) := nil;
  end;
end;

initialization
  InitializeClientDB();

finalization
  FinalizeClientDB();

end.

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TMainFrm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ListView1: TListView;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Panel3: TPanel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainFrm: TMainFrm;

implementation

uses
  Drives.Data;

{$R *.DFM}
procedure TMainFrm.Button1Click(Sender: TObject);
var
  SL: TStringList;
  X: Integer;
  Freq, StartCount, StopCount: Int64;
begin
  Label1.Caption := ' Count: ' + IntToStr(DrivesClientDB.GetRowCount((Sender as TButton).Hint));

  SL := TStringList.Create();
  try
    QueryPerformanceFrequency(Freq);
    QueryPerformanceCounter(StartCount);
    DrivesClientDB.GetDriveList(SL, (Sender as TButton).Hint);
    QueryPerformanceCounter(StopCount);
    Label2.Caption := Format('(%.1f seconds) ', [(StopCount - StartCount) / Freq]);

    ListView1.Items.BeginUpdate();
    try
      ListView1.Items.Clear();

      for X := 0 to (SL.Count - 1) do
      begin
        with ListView1.Items.Add do
        begin
          Caption := '(' + SL[X] + ')';
          ListView1.Items[X].SubItems.AddObject('', SL.Objects[X]);
          ListView1.Items[X].Checked := DrivesClientDB.GetCheckedDrive(Integer(SL.Objects[X]));
        end;
      end;
    finally
      ListView1.Items.EndUpdate();
    end;

  finally
    SL.Free();
    if (Pointer(SL) <> nil) then Pointer(SL) := nil;
  end;
end;

procedure TMainFrm.ListView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Item: TListItem;
  HitTest: THitTests;
begin
  Item := (Sender as TListView).GetItemAt(X, Y);
  if Assigned(Item) then
  begin
    HitTest := (Sender as TListView).GetHitTestInfoAt(X, Y);

    if (HitTest = [htOnStateIcon]) then
    begin
      (Sender as TListView).SetFocus();
      Item.Selected := True;
      Item.Focused := True;

      DrivesClientDB.SetCheckedDrive(Integer((Sender as TListView).Items[Item.Index].SubItems.Objects[0]), Item.Checked);
    end;
  end;
end;

procedure TMainFrm.ListView1KeyPress(Sender: TObject; var Key: Char);
var
  Item: TListItem;
begin
  Item := (Sender as TListView).ItemFocused;
  if Assigned(Item) then
  begin
    (Sender as TListView).SetFocus();
    Item.Selected := True;
    Item.Focused := True;

    if (Key = Chr(32)) then
      DrivesClientDB.SetCheckedDrive(Integer((Sender as TListView).Items[Item.Index].SubItems.Objects[0]), Item.Checked);
  end;
end;

end.

gclaxton · mORMot 1

Is there a way to use CreateMissingTables to make a column "UNIQUE"?

unit FilesInclude.Client;

interface

uses
  Windows, FilesInclude.Data;

procedure CreateDatabase(const theFilename: string);

implementation

uses
  SQLite3;

function GetFileSize(const theFilename: string): TULargeInteger;
var
  Find: THandle;
  Data: TWin32FindData;
begin
  Find := Windows.FindFirstFile(PChar(theFilename), Data);
  if (Find <> INVALID_HANDLE_VALUE) then
  try
    Result.LowPart := Data.nFileSizeLow;
    Result.HighPart := Data.nFileSizeHigh;
  finally
    Windows.FindClose(Find);
  end
  else
    Result.QuadPart := -1;
end;

procedure CreateDatabase(const theFilename: string);
begin
  // If the file is 0 bytes, create the missing tables
  if (GetFileSize(theFilename).QuadPart = 0) then
  begin
    with TSQLRestClientDB(FilesIncludeClient) do
    begin
      // Todo: Use CreateMissingTables to make the 'filename' column "UNIQUE" as below. ?*****?
      Server.CreateMissingTables(0);
      (*
      Server.DB.Execute('CREATE TABLE IF NOT EXISTS [filesInclude] (' +
        '[id] INTEGER PRIMARY KEY AUTOINCREMENT, ' +
        '[filename] TEXT UNIQUE COLLATE NOCASE, '  +
        '[checked] INTEGER, '                      +
        '[description] TEXT COLLATE NOCASE);');
      *)

      // if TableRowCount = 0 then, set the default data values
      if (TableRowCount(TSQLFilesInclude) = 0) then
      begin
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("*.$$$",     0, "MS-DOS Temporary File")');
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("*.bak",     1, "Temporary Backup Files")');
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("*.chk",     0, "Temporary Log Files")');
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("*.err",     0, "Temporary Error File")');
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("*.tmp",     1, "Temporary Files")');
        Server.DB.Execute('INSERT OR IGNORE INTO filesInclude ' +
          '(filename, checked, description) VALUES ("thumbs.db", 0, "Microsoft Thumbnails File")');
      end;
    end;
  end;
end;

end.

gclaxton · mORMot 1

Solution:

class procedure TSQLDrives.GetDriveList(Items: TStrings);
var
  table: TSQLTableJSON;
  X, FieldIndex: Integer;
begin
  table := TSQLRestClientDB(GlobalClient).ExecuteList([TSQLDrives], 'SELECT * FROM drives');
  if (table <> nil) then
  try
    FieldIndex := table.FieldIndex('drive');
    if (FieldIndex >= 0) then
      for X := 1 to table.RowCount do
        Items.Add(UTF8ToString(table.GetU(X, FieldIndex)));
  finally
    table.Free();
  end;
end;

gclaxton · mORMot 1

Not sure if you noticed or not, I change a lot of the code per your suggestions.

gclaxton · mORMot 1

I would like to take the following unit (DrivesData) and display the drive column in a TListView. I've never worked with the (Synopse) SQLite3 code before so I'm hoping someone could give me a little push in the right direction.

Just add the DrivesData unit to the uses clause then run and it will create the "drives.sqlite" database file with a list of drives 'A' to 'Z'.

unit DrivesData;

interface

uses
  Windows, SQLite3, SynCommons, SQLite3Commons, Classes;

type
  TDrives = class(TSQLRecord)
  private
    { Private declarations }
    FDrive: RawUTF8;
  protected
    { Protected declarations }
    FDrivesModel: TSQLModel;
  public
    { Public declarations }
    constructor Create(); override;
    destructor Destroy(); override;

    function GetCount(): Integer;
    procedure GetItems(var Items: TStringList);
  published
    { Published declarations }
    property Drive: RawUTF8 read FDrive write FDrive;
  end;

var
  DriveRecord: TDrives;
  GlobalClient: TSQLRestClientURI;

implementation

//uses
//  SysUtils;

function CreateDrivesModel(): TSQLModel;
begin
  Result := TSQLModel.Create([TDrives], 'root');
end;

{ TDrives }
constructor TDrives.Create();
var
  X: AnsiChar;
begin
  inherited Create();

  FDrivesModel := CreateDrivesModel();
  GlobalClient := TSQLRestClientDB.Create(FDrivesModel, CreateDrivesModel(), 'drives.sqlite', TSQLRestServerDB);

  TSQLRestClientDB(GlobalClient).Server.DB.Execute(
    'CREATE TABLE IF NOT EXISTS drives ' +
    '(id INTEGER PRIMARY KEY, drive TEXT NOT NULL UNIQUE COLLATE NOCASE);');

  for X := 'A' to 'Z' do
  begin
    TSQLRestClientDB(GlobalClient).Server.DB.Execute(
      'INSERT OR IGNORE INTO drives (drive) VALUES ("' + StringToUTF8(X) + ':")');
  end;
end;

destructor TDrives.Destroy();
begin
  if Assigned(FDrivesModel) then
    FDrivesModel.Free();

  inherited Destroy();
end;

function TDrives.GetCount(): Integer;
var
  table: TSQLTable;
begin
  Result := -1;
  table := GlobalClient.ExecuteList([TDrives], 'SELECT COUNT(*) as CNT FROM drives');
  try
    if (table.RowCount > 0) then
      Result := table.GetAsInteger(1, 0);
  finally
    table.Free();
  end;
end;

procedure TDrives.GetItems(var Items: TStringList);
var
  table: TSQLTable;
begin
  table := GlobalClient.List([TDrives], 'COUNT(*)', 'drive');
  if (table <> nil) then
  try
    ;
  finally
    table.Free();
  end;
end;

initialization
  GlobalClient := nil;
  DriveRecord := TDrives.Create();

finalization
  if Assigned(GlobalClient) then
    GlobalClient.Free();

  if Assigned(DriveRecord) then
    DriveRecord.Free();

end.

mORMot Open Source

#1 mORMot 1 » Check for Empty Tables » 2011-05-28 23:34:40

#2 mORMot 1 » SQLite local TSQLRestClientDB demo » 2011-05-27 22:44:22

#3 mORMot 1 » Use CreateMissingTables to make a column "UNIQUE" » 2011-05-26 19:24:45

#4 Re: mORMot 1 » Display SQLite3 table-column in a Delphi7 TListView » 2011-05-24 03:14:10

#5 Re: mORMot 1 » Display SQLite3 table-column in a Delphi7 TListView » 2011-05-23 19:19:01

#6 mORMot 1 » Display SQLite3 table-column in a Delphi7 TListView » 2011-05-23 17:32:42

Board footer