source upload

2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions
--- a/contrib/mORMot/SQLite3/Samples/16
+++ b/contrib/mORMot/SQLite3/Samples/16
@@ -0,0 +1,172 @@
+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.