xtool/contrib/mORMot/SQLite3/Samples/16 - Execute SQL via services/Project16ClientMain.pas

unit Project16ClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  SynCommons, mORMot, mORMotHttpClient, mORMotUI, mORMotUILogin,
  Project16Interface, ExtCtrls, Grids;

type
  TProjectSettings = class(TPersistent)
  private
    fDatabaseName: RawUTF8;
    fPassword: RawUTF8;
    fUserID: RawUTF8;
    fServerName: RawUTF8;
    fEngine: TRemoteSQLEngine;
  published
    property Engine: TRemoteSQLEngine read fEngine;
    property ServerName: RawUTF8 read fServerName;
    property DatabaseName: RawUTF8 read fDatabaseName;
    property UserID: RawUTF8 read fUserID;
    property PassWord: RawUTF8 read fPassword;
  end;

  TMainForm = class(TForm)
    mmoQuery: TMemo;
    spl1: TSplitter;
    pnlLogin: TPanel;
    drwgrdData: TDrawGrid;
    lbledtServer: TLabeledEdit;
    lbledtDatabase: TLabeledEdit;
    lbledtUser: TLabeledEdit;
    lbledtPassword: TLabeledEdit;
    cbbEngine: TComboBox;
    btnOpen: TButton;
    pnlCommand: TPanel;
    btnExecute: TButton;
    lbl1: TLabel;
    cbbTableNames: TComboBox;
    lblSelectTable: TLabel;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure cbbTableNamesChange(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
  protected
    fSettings: TProjectSettings;
    fSettingsFileName: TFileName;
    fModel: TSQLModel;
    fClient: TSQLRestClientURI;
    fTableJSON: RawUTF8;
    fService: IRemoteSQL;
  public
    function Execute(FormatSQLWhere: PUTF8Char; const BoundsSQLWhere: array of const): TSQLTableJSON; overload;
    procedure ExecuteSQL(FormatSQLWhere: PUTF8Char; const BoundsSQLWhere: array of const);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation

function TMainForm.Execute(FormatSQLWhere: PUTF8Char;
  const BoundsSQLWhere: array of const): TSQLTableJSON;
var SQL: RawUTF8;
begin
  SQL := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  result := TSQLTableJSON.Create(SQL,fService.Execute(SQL,True,False));
end;

procedure TMainForm.ExecuteSQL(FormatSQLWhere: PUTF8Char;
  const BoundsSQLWhere: array of const);
begin
  fService.Execute(FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere),False,False);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  fService := nil;
  fClient.Free;
  fModel.Free;
  fSettings.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  PTypeInfo(TypeInfo(TRemoteSQLEngine))^.EnumBaseType^.AddCaptionStrings(cbbEngine.Items);
  fSettings := TProjectSettings.Create;
  fSettingsFileName := ChangeFileExt(ExeVersion.ProgramFileName,'.settings');
  JSONFileToObject(fSettingsFileName,fSettings);
  cbbEngine.ItemIndex := ord(fSettings.fEngine);
  lbledtServer.Text := UTF8ToString(fSettings.fServerName);
  lbledtDatabase.Text := UTF8ToString(fSettings.fDatabaseName);
  lbledtUser.Text := UTF8ToString(fSettings.fUserID);
  lbledtPassword.Text := UTF8ToString(fSettings.fPassword);
  fModel := TSQLModel.Create([],ROOT_NAME);
  fClient := TSQLHttpClient.Create('localhost',PORT_NAME,fModel);
  if not fClient.ServerTimeStampSynchronize then begin
    ShowLastClientError(fClient,'Please run Project16ServerHttp.exe');
    Close;
    exit;
  end;
  if (not fClient.SetUser('User','synopse'))  or
     (not fClient.ServiceRegisterClientDriven(TypeInfo(IRemoteSQL),fService)) then begin
    ShowLastClientError(fClient,'Remote service not available on server');
    Close;
    exit;
  end;
end;

procedure TMainForm.btnOpenClick(Sender: TObject);
var TableNames: TRawUTF8DynArray;
begin
  if cbbEngine.ItemIndex>=0 then
  try
    fSettings.fEngine := TRemoteSQLEngine(cbbEngine.ItemIndex);
    fSettings.fServerName := StringToUTF8(lbledtServer.Text);
    fSettings.fDatabaseName := StringToUTF8(lbledtDatabase.Text);
    fSettings.fUserID := StringToUTF8(lbledtUser.Text);
    fSettings.fPassword := StringToUTF8(lbledtPassword.Text);
    ObjectToJSONFile(fSettings,fSettingsFileName);
    with fSettings do
      fService.Connect(Engine,ServerName,DatabaseName,UserID,PassWord);
    pnlLogin.Hide;
    mmoQuery.Show;
    pnlCommand.Show;
    drwgrdData.Show;
    with CreateTempForm('Please wait') do begin
      TableNames := fService.GetTableNames;
      Free;
    end;
    cbbTableNames.Items.Text := UTF8ToString(RawUTF8ArrayToCSV(TableNames,#13#10));
  except
    on E: Exception do
      ShowException(E);
  end;
end;

procedure TMainForm.cbbTableNamesChange(Sender: TObject);
begin
  mmoQuery.Text := 'select * from '+cbbTableNames.Text;
end;

procedure TMainForm.btnExecuteClick(Sender: TObject);
var SQL: RawUTF8;
begin
  SQL := trim(StringToUTF8(mmoQuery.Text));
  Screen.Cursor := crHourGlass;
  try
    try
      if isSelect(pointer(SQL)) then begin
        fTableJSON := fService.Execute(SQL,True,False);
        TSQLTableToGrid.Create(drwgrdData,
          TSQLTableJSON.Create(SQL,pointer(fTableJSON),Length(fTableJSON)),fClient);
      end else
        fService.Execute(SQL,False,False);
    except
      on E: Exception do
        ShowException(E);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

end.