source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,81 @@
|
||||
/// command-line tool for compressing/uncompressing .dbsynlz files
|
||||
program DBSynLZ;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
|
||||
SynCommons,
|
||||
SysUtils;
|
||||
|
||||
{$R SynDBExplorer.res}
|
||||
|
||||
const
|
||||
/// the "magic" number used to identify .dbsynlz compressed files, as
|
||||
// created by TSQLDataBase.BackupSynLZ() or if SynLZCompress parameter is TRUE
|
||||
// for the TSQLDataBase.BackupBackground() method
|
||||
// - note that the SynDBExplorer tool is able to recognize such files, and
|
||||
// open them directly - or use this DBSynLZ.dpr command-line sample tool
|
||||
SQLITE3_MAGIC = $ABA5A5AB;
|
||||
|
||||
function IsSQLite3File(const FileName: TFileName): boolean;
|
||||
var F: integer;
|
||||
Header: array[0..15] of AnsiChar;
|
||||
begin
|
||||
F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
|
||||
if F<0 then
|
||||
result := false else begin
|
||||
result := (FileRead(F,Header,sizeof(Header))=SizeOf(Header)) and
|
||||
(Header='SQLite format 3');
|
||||
FileClose(F);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Process(const FN: TFileName);
|
||||
var f, dest: TFileName;
|
||||
timer: TPrecisionTimer;
|
||||
begin
|
||||
timer.Start;
|
||||
f := ExtractFileName(FN);
|
||||
if ParamCount = 2 then
|
||||
dest := ParamStr(2);
|
||||
if FileIsSynLZ(FN, SQLITE3_MAGIC) then begin
|
||||
if dest = '' then
|
||||
dest := ChangeFileExt(FN, '.db');
|
||||
write('Decompressing ', f, #13#10' into ', ExtractFileName(dest), '...');
|
||||
if FileExists(dest) then
|
||||
writeln(' FAILED: already existing')
|
||||
else if FileUnSynLZ(FN, dest, SQLITE3_MAGIC) then
|
||||
writeln(' OK in ', timer.Stop)
|
||||
else
|
||||
writeln(' FAILED');
|
||||
end else
|
||||
if IsSQlite3File(FN) then begin
|
||||
if dest = '' then
|
||||
dest := ChangeFileExt(FN, '.dbsynlz');
|
||||
write('Compressing ', f, #13#10' into ', ExtractFileName(dest), '...');
|
||||
if FileExists(dest) then
|
||||
writeln(' FAILED: already existing')
|
||||
else if FileSynLZ(FN, dest, SQLITE3_MAGIC) then
|
||||
writeln(' OK in ', timer.Stop)
|
||||
else
|
||||
writeln(' FAILED');
|
||||
end else
|
||||
writeln(f, ' is not a Sqlite3 compressed/uncompressed file');
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount < 1 then begin
|
||||
TextColor(ccLightGreen);
|
||||
writeln(#13#10' SQLite3 database files compression/decompression tool via SynLZ');
|
||||
writeln(StringOfChar('-',65));
|
||||
TextColor(ccGreen);
|
||||
writeln(' Using SynLZ compression from Synopse mORMot ', SYNOPSE_FRAMEWORK_VERSION);
|
||||
TextColor(ccLightGray);
|
||||
writeln(#13#10' DBSynLZ filename.dbsynlz [outfilename.db]'#13#10 +
|
||||
'or'#13#10' DBSynLZ filename.db [outfilename.dbsynlz]');
|
||||
end
|
||||
else
|
||||
Process(ParamStr(1));
|
||||
end.
|
||||
|
||||
BIN
contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDB.ico
Normal file
BIN
contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDB.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
@@ -0,0 +1,65 @@
|
||||
program SynDBExplorer;
|
||||
|
||||
(*
|
||||
|
||||
Synopse mORMot framework
|
||||
|
||||
Sample 12 - SynDB explorer
|
||||
purpose of this sample is to show SynDB classes at work
|
||||
resulting speed is quite amazing, and available features make it useful
|
||||
|
||||
Version 1.15 - July 12, 2011
|
||||
- Initial Release, handling OleDB, Oracle/OCI, and SQLite3 databases
|
||||
|
||||
Version 1.16
|
||||
- SynDbExplorer now executes selected text statement (very convenient)
|
||||
- will try to reconnect to the server in case of error triggerred
|
||||
- added advanced Query Builder
|
||||
- now accepts a SQLite3 database file as command line parameter
|
||||
- fix error ORA-00932 at OCI client level
|
||||
- added UTF-8 BOM to CSV or TXT exports
|
||||
- now direct-to-file fast export feature (into CSV, TXT, SQLite3,
|
||||
Synopse BigTable records or two JSON flavors)
|
||||
- now multi tables direct export into SQLite3 DB files (e.g. for support)
|
||||
- SQLite3 3.7.12.1 including (beta) private encryption methods
|
||||
|
||||
Version 1.17
|
||||
- added Jet / MSAccess direct support (via OleDB provider)
|
||||
- now accepts a Jet / MSAccess database file as command line parameter
|
||||
- added ODBC providers direct support
|
||||
- added log history of SQL requests (in SynDBExplorer.history file)
|
||||
- SQLite3 engine updated to revision 3.7.13
|
||||
- changed .config file format from binary to JSON (with Base64+Zip if needed)
|
||||
|
||||
Version 1.18
|
||||
- SQlite3 engine updated to revision 3.21.0
|
||||
- optimized grid content initialization speed and layout
|
||||
- will now initialize the REGEXP function for SQLite3 (for Delphi XE+)
|
||||
- added incremental text search in SQL history
|
||||
- added "Exec to Tab" button (accessible with Shift+F9 shortcut)
|
||||
|
||||
first line of uses clause below must be {$I SynDprUses.inc} to enable FastMM4
|
||||
conditional define should contain INCLUDE_FTS3 to handle FTS3/FTS4 in SQLite3
|
||||
*)
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc}
|
||||
Forms,
|
||||
{$ifdef FPC}
|
||||
Interfaces,
|
||||
{$endif}
|
||||
SynDBExplorerMain in 'SynDBExplorerMain.pas' {DbExplorerMain},
|
||||
SynDBExplorerClasses in 'SynDBExplorerClasses.pas',
|
||||
SynDBExplorerFrame in 'SynDBExplorerFrame.pas' {DBExplorerFrame: TFrame},
|
||||
SynDBExplorerQueryBuilder in 'SynDBExplorerQueryBuilder.pas' {DBQueryBuilderForm},
|
||||
SynDBExplorerExportTables in 'SynDBExplorerExportTables.pas' {DBExportTablesForm},
|
||||
SynDBExplorerServer in 'SynDBExplorerServer.pas' {HTTPServerForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TDbExplorerMain, DbExplorerMain);
|
||||
Application.CreateForm(THTTPServerForm, HTTPServerForm);
|
||||
Application.Run;
|
||||
end.
|
||||
Binary file not shown.
@@ -0,0 +1,43 @@
|
||||
unit SynDBExplorerClasses;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
SynCommons, mORMot;
|
||||
|
||||
type
|
||||
TExpConnectionType = (
|
||||
ctOracleDirectOCI,
|
||||
ctOracleOLEDB, ctOracleMSOLEDB, ctMSSQL, ctGenericOLEDB,
|
||||
ctSqlite3,
|
||||
ctJet_mdbOLEDB,
|
||||
ctODBC,ctRemoteHTTP,ctZEOS);
|
||||
|
||||
TSQLConnection = class(TSQLRecord)
|
||||
private
|
||||
fUserName: RawUTF8;
|
||||
fIdent: RawUTF8;
|
||||
fPassword: RawUTF8;
|
||||
fServer: RawUTF8;
|
||||
fDataBase: RawUTF8;
|
||||
fConnection: TExpConnectionType;
|
||||
fForeignKeys: TSQLRawBlob;
|
||||
public
|
||||
fTableNames: TRawUTF8DynArray;
|
||||
published
|
||||
property Ident: RawUTF8 read fIdent write fIdent;
|
||||
property Connection: TExpConnectionType read fConnection write fConnection;
|
||||
property Server: RawUTF8 read fServer write fServer;
|
||||
property Database: RawUTF8 read fDataBase write fDataBase;
|
||||
property UserName: RawUTF8 read fUserName write fUserName;
|
||||
property Password: RawUTF8 read fPassword write fPassword;
|
||||
property TableNames: TRawUTF8DynArray read fTableNames write fTableNames;
|
||||
property ForeignKeys: TSQLRawBlob read fForeignKeys write fForeignKeys;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,82 @@
|
||||
object DBExportTablesForm: TDBExportTablesForm
|
||||
Left = 387
|
||||
Top = 248
|
||||
BorderStyle = bsDialog
|
||||
Caption = ' SynDB Explorer - Export Tables'
|
||||
ClientHeight = 471
|
||||
ClientWidth = 393
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poMainFormCenter
|
||||
DesignSize = (
|
||||
393
|
||||
471)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object BtnExport: TButton
|
||||
Left = 24
|
||||
Top = 430
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Export'
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnCancel: TButton
|
||||
Left = 128
|
||||
Top = 430
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
object GroupWhere: TGroupBox
|
||||
Left = 16
|
||||
Top = 8
|
||||
Width = 360
|
||||
Height = 345
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
Caption = ' Per-table additional WHERE clause for export '
|
||||
TabOrder = 2
|
||||
end
|
||||
object ChkUseStandardCollations: TCheckBox
|
||||
Left = 24
|
||||
Top = 379
|
||||
Width = 361
|
||||
Height = 17
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption =
|
||||
'Use standard SQLite3 format (collations not optimized for mORMot' +
|
||||
')'
|
||||
TabOrder = 3
|
||||
end
|
||||
object ChkNoBlobExport: TCheckBox
|
||||
Left = 24
|
||||
Top = 362
|
||||
Width = 361
|
||||
Height = 17
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Do not export BLOB content (save space and time)'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 4
|
||||
end
|
||||
object ChkZipDBFile: TCheckBox
|
||||
Left = 24
|
||||
Top = 397
|
||||
Width = 361
|
||||
Height = 17
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Compress resulting SQLite3 DB file into .zip archive'
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,180 @@
|
||||
unit SynDBExplorerExportTables;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Graphics,
|
||||
Forms, ExtCtrls, mORMotUILogin,
|
||||
SynZip, SynCommons, SynDB, SynTable, SynDBSQLite3;
|
||||
|
||||
type
|
||||
TDBExportTablesForm = class(TForm)
|
||||
BtnExport: TButton;
|
||||
BtnCancel: TButton;
|
||||
GroupWhere: TGroupBox;
|
||||
ChkUseStandardCollations: TCheckBox;
|
||||
ChkNoBlobExport: TCheckBox;
|
||||
ChkZipDBFile: TCheckBox;
|
||||
protected
|
||||
fProps: TSQLDBConnectionProperties;
|
||||
fEdits: array of TLabeledEdit;
|
||||
procedure SetTableNames(const Value: TStrings);
|
||||
public
|
||||
class function ExportTables(aTableNames: TStrings; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
|
||||
class function ExportTables(aListBox: TListBox; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
|
||||
property Props: TSQLDBConnectionProperties read fProps write fProps;
|
||||
end;
|
||||
|
||||
var
|
||||
DBExportTablesForm: TDBExportTablesForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
resourcestring
|
||||
sTableExportWhereHint = 'e.g. "ID>1000" or "RowNum<=500"';
|
||||
|
||||
|
||||
{ TDBExportTablesForm }
|
||||
|
||||
class function TDBExportTablesForm.ExportTables(aTableNames: TStrings;
|
||||
aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
|
||||
var DB: TSQLDBSQLite3ConnectionProperties;
|
||||
Conn: TSQLDBSQLite3Connection;
|
||||
Rows: TSQLDBStatement;
|
||||
Table,SQL: RawUTF8;
|
||||
Fields: TSQLDBColumnDefineDynArray;
|
||||
ExcludeTypes: TSQLDBFieldTypes;
|
||||
ZipFileName: TFileName;
|
||||
Tmp: TForm;
|
||||
TmpPanel: TPanel;
|
||||
i: integer;
|
||||
begin
|
||||
result := 0;
|
||||
if aDestFileName<>'' then
|
||||
with TDBExportTablesForm.Create(Application) do
|
||||
try
|
||||
SetTableNames(aTableNames);
|
||||
ActiveControl := BtnExport;
|
||||
if ShowModal<>mrOk then
|
||||
exit;
|
||||
if ChkNoBlobExport.Checked then
|
||||
ExcludeTypes := [ftBlob] else
|
||||
ExcludeTypes := [];
|
||||
DeleteFile(aDestFileName);
|
||||
Tmp := CreateTempForm(BtnExport.Caption,@TmpPanel,true);
|
||||
try
|
||||
DB := TSQLDBSQLite3ConnectionProperties.Create(StringToUTF8(aDestFileName),'','','');
|
||||
try
|
||||
DB.UseMormotCollations := not ChkUseStandardCollations.Checked;
|
||||
Conn := DB.MainConnection as TSQLDBSQLite3Connection;
|
||||
Conn.Connect;
|
||||
try
|
||||
Conn.DB.ExecuteAll('PRAGMA journal_mode=MEMORY;PRAGMA journal_size_limit=16777216;'+
|
||||
'PRAGMA synchronous=OFF;');
|
||||
// Conn.DB.SetWALMode(true); // slower in WAL mode for huge data :(
|
||||
assert(aTableNames.Count=length(fEdits));
|
||||
for i := 0 to aTableNames.Count-1 do begin
|
||||
TmpPanel.Caption := aTableNames[i];
|
||||
Application.ProcessMessages;
|
||||
Table := StringToUTF8(aTableNames[i]);
|
||||
aProps.GetFields(Table,Fields);
|
||||
SQL := Trim(StringToUTF8(fEdits[i].Text));
|
||||
if SQL<>'' then
|
||||
SQL := ' where '+SQL;
|
||||
SQL := aProps.SQLSelectAll(Table,Fields,ExcludeTypes)+SQL;
|
||||
Rows := aProps.NewThreadSafeStatement;
|
||||
try
|
||||
Rows.Execute(SQL,true);
|
||||
Table := StringReplaceAll(Table,[' ','' ,'-','']);
|
||||
inc(result,Conn.NewTableFromRows(Table,Rows,true));
|
||||
finally
|
||||
Rows.Free;
|
||||
end;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
ShowMessage(E.Message,true);
|
||||
end;
|
||||
finally
|
||||
DB.Free;
|
||||
end;
|
||||
if ChkZipDBFile.Checked then begin
|
||||
ZipFileName := ChangeFileExt(aDestFileName,'.zip');
|
||||
TmpPanel.Caption := ExtractFileName(ZipFileName);
|
||||
Application.ProcessMessages;
|
||||
with TZipWrite.Create(ZipFileName) do
|
||||
try
|
||||
AddDeflated(aDestFileName,true);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
DeleteFile(aDestFileName);
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
Tmp.Free;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDBExportTablesForm.ExportTables(aListBox: TListBox;
|
||||
aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
|
||||
var T: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
result := 0;
|
||||
if (aListBox=nil) or (aListBox.SelCount=0) then
|
||||
exit;
|
||||
T := TStringList.Create;
|
||||
try
|
||||
for i := 0 to aListBox.Count-1 do
|
||||
if aListBox.Selected[i] then
|
||||
T.Add(aListBox.Items[i]);
|
||||
result := ExportTables(T,aProps,aDestFileName);
|
||||
finally
|
||||
T.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExportTablesForm.SetTableNames(const Value: TStrings);
|
||||
var E: TLabeledEdit;
|
||||
max,x,y,n,i,h: integer;
|
||||
begin
|
||||
if Value=nil then
|
||||
n := 0 else
|
||||
n := Value.Count;
|
||||
SetLength(fEdits,n);
|
||||
max := Screen.Height;
|
||||
if n*32+132>max then
|
||||
h := 24 else
|
||||
h := 32;
|
||||
x := 160;
|
||||
n := n*h+24;
|
||||
if n+148>max then
|
||||
n := max-164;
|
||||
GroupWhere.Height := n;
|
||||
ClientHeight := n+132;
|
||||
y := 24;
|
||||
for i := 0 to high(fEdits) do begin
|
||||
E := TLabeledEdit.Create(self);
|
||||
E.Parent := GroupWhere;
|
||||
E.LabelPosition := lpLeft;
|
||||
E.SetBounds(x,y,180,22);
|
||||
E.EditLabel.Caption := Value[i];
|
||||
E.ShowHint := true;
|
||||
E.Hint := sTableExportWhereHint;
|
||||
inc(y,h);
|
||||
if (h=24) and (y>=n-24) and (i<>high(fEdits)) then
|
||||
if x<>160 then break else begin
|
||||
y := 24;
|
||||
inc(x,340);
|
||||
Width := 740;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,326 @@
|
||||
object DBExplorerFrame: TDBExplorerFrame
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 704
|
||||
Height = 536
|
||||
TabOrder = 0
|
||||
OnEnter = ListTableClick
|
||||
object Splitter1: TSplitter
|
||||
Left = 179
|
||||
Top = 0
|
||||
Width = 5
|
||||
Height = 536
|
||||
end
|
||||
object PanelClient: TPanel
|
||||
Left = 184
|
||||
Top = 0
|
||||
Width = 520
|
||||
Height = 536
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
object Splitter2: TSplitter
|
||||
Left = 1
|
||||
Top = 172
|
||||
Width = 518
|
||||
Height = 5
|
||||
Cursor = crVSplit
|
||||
Align = alTop
|
||||
end
|
||||
object DrawGrid: TDrawGrid
|
||||
Left = 1
|
||||
Top = 177
|
||||
Width = 518
|
||||
Height = 358
|
||||
Align = alClient
|
||||
ColCount = 1
|
||||
FixedCols = 0
|
||||
RowCount = 1
|
||||
FixedRows = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object PanelTop: TPanel
|
||||
Left = 1
|
||||
Top = 1
|
||||
Width = 518
|
||||
Height = 171
|
||||
Align = alTop
|
||||
TabOrder = 1
|
||||
DesignSize = (
|
||||
518
|
||||
171)
|
||||
object MemoSQL: TMemo
|
||||
Left = 1
|
||||
Top = 1
|
||||
Width = 455
|
||||
Height = 169
|
||||
Cursor = crIBeam
|
||||
Align = alLeft
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -12
|
||||
Font.Name = 'Consolas'
|
||||
Font.Pitch = fpFixed
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
PopupMenu = PopupMenuSQL
|
||||
ScrollBars = ssVertical
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnExec: TButton
|
||||
Left = 466
|
||||
Top = 3
|
||||
Width = 43
|
||||
Height = 30
|
||||
Hint = 'Execute the SQL statement (F9)'
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Exec'
|
||||
Default = True
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 1
|
||||
OnClick = BtnExecClick
|
||||
end
|
||||
object BtnResultToFile: TButton
|
||||
Left = 466
|
||||
Top = 138
|
||||
Width = 43
|
||||
Height = 30
|
||||
Hint = 'Export the results'
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Result to File'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 5
|
||||
WordWrap = True
|
||||
OnClick = BtnResultToFileClick
|
||||
end
|
||||
object BtnExecToFile: TButton
|
||||
Left = 466
|
||||
Top = 91
|
||||
Width = 43
|
||||
Height = 30
|
||||
Hint = 'Execute the SQL statement with direct export to file'
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Exec to File'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 4
|
||||
WordWrap = True
|
||||
OnClick = BtnExecClick
|
||||
end
|
||||
object BtnExecLog: TButton
|
||||
Left = 466
|
||||
Top = 35
|
||||
Width = 43
|
||||
Height = 22
|
||||
Hint = 'View SQL log history'
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'History'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 2
|
||||
WordWrap = True
|
||||
OnClick = BtnExecLogClick
|
||||
end
|
||||
object BtnExecToTab: TButton
|
||||
Left = 466
|
||||
Top = 59
|
||||
Width = 43
|
||||
Height = 30
|
||||
Hint =
|
||||
'Execute the SQL statement with direct export to a new Tab (Shift' +
|
||||
' F9)'
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Exec to Tab'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 3
|
||||
WordWrap = True
|
||||
OnClick = BtnExecClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object PagesLeft: TPageControl
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 179
|
||||
Height = 536
|
||||
ActivePage = TabTables
|
||||
Align = alLeft
|
||||
TabOrder = 1
|
||||
object TabTables: TTabSheet
|
||||
Caption = 'Tables'
|
||||
DesignSize = (
|
||||
171
|
||||
508)
|
||||
object ImageLogo: TImage
|
||||
Left = 2
|
||||
Top = 474
|
||||
Width = 169
|
||||
Height = 32
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Center = True
|
||||
Picture.Data = {
|
||||
07544269746D617076090000424D760900000000000076000000280000008900
|
||||
0000200000000100040000000000000900000000000000000000100000000000
|
||||
00000504180004A6FC00444446000704C400918FB000D1D1DF001D26E0005454
|
||||
5600726FA000046EFC00B2B0CD0031323300FCFEFC005A53D1003731CF004446
|
||||
FC00CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCC555A5555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC54444CCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCA77778777785CCCCCCCCCCCCC5444ACCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCC533338C
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC58274A555555A877ACCCCCCCCCCCD3333
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
|
||||
CCCCCCCCCC63333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA774A472BBBB74AA82
|
||||
4CCCCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
|
||||
0000CCCCCCCCCCCCCCCCCCCCCCA3333ACCCCCCCCCCCCCCCCCCCCCCCCCCCCC428
|
||||
4700000000000244775CCCCCCCCD3333CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCC3333ECCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCC4278B0000000000000078775CCCCCCCD3336CCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCC54E3333EACCCCCCCCC83333
|
||||
CCCCCCCC888D5CCCC488DACCCCC4277000000000000000002727CCCCCCCD3336
|
||||
CD63E4CCCCCCCAF333368CCCCCCCCC5863333FACCCCCC0000000CCCC83333333
|
||||
3334CCCCCCCE3333DCCCCCCC3333ACCCC3333FCCCCA277000000000000000000
|
||||
0B728CCCCCCD333333333365CCC53333333333FCCCCC5E3333333333ACCCC000
|
||||
0000CCCCD333333333334CCCCC5333333CCCCCCC3333ACCCC6333DCCCC748000
|
||||
000033333333000000287ACCCCCD333333333333CCC533333333333ECCC53333
|
||||
33333333ACCCC0000000CCCCD3EACCCC83333CCCCCD3333334CCCCCC3333ACCC
|
||||
C6333DCCC48AB0000033333333333000000847CCCCCD33335AAD3333DCC53345
|
||||
CCCA33335CC333338A5C5463ACCCC0000000CCCC4ACCCCCC43333CCCCC333333
|
||||
36CCCCCC3333ACCCC6333DCCC7AA000003333333333333000002A75CCCCD3336
|
||||
CCCCD33335C58CCCCCC533334CA3333ACCCCCCC85CCCC0000000CCCCCCC5A8E3
|
||||
33333CCCCA3333E3335CCCCC3333ACCCC6333DCC5BA700003333333333333330
|
||||
0000587CCCCD3333CCCC53333ACCCCCA8F333333AC8333FCCCCCCCCCCCCCC000
|
||||
0000CCCCCCD333333333FCCCC63338A333DCCCCC3333ACCCC6333DCC42400000
|
||||
33333333333333330000442CCCCD3333CCCCC33334CCC43333333333CCD3333F
|
||||
EEEEEEE68CCCC0000000CCCCC3333333333DCCCC533335C3333CCCCC3333ACCC
|
||||
C6333DCC227000033333333333333333000028B5CCCD3333CCCCC33338CC8333
|
||||
33333335CCD3333333333333FCCCC0000000CCCC53333333E45CCCCC83336CCE
|
||||
3334CCCC3333ACCCC3333DCCB77000033333333333333333000008B5CCCD3333
|
||||
CCCCC33334CC33333336D5CCCCD3333333333333DCCCC0000000CCCC43333ACC
|
||||
CCCCCCCC33334CCA3333CCCC3333ACCCC3333DCC07B000033333336193333333
|
||||
000007BACCCD3336CCCCA3333ACC33338CCCCCC5CCA333DCCCCC63334CCCC000
|
||||
0000CCCCA3333CCCCC538CCA3333CCCC33335CCC333338AAF33334CC07B00003
|
||||
3333336193333333000007BACCCD3333ACC5333335CC3333ACCCC5D3CCC33335
|
||||
CCCC33335CCCC0000000CCCCC333333633334CC3333ECCCCD3336CCC33333333
|
||||
333335CC077000033333633333333333000007BACCCD333333333333DCCCD333
|
||||
33633333CCCA3333F4D3333FCCCCC0000000CCCCC533333333338C53333ACCCC
|
||||
A3333CCC3333F3333333FCCCB7700B03333F6333336663330000B8B5CCCD3333
|
||||
63333333CCCCCE3333333333CCCC43333333333CCCCCC0000000CCCCCCC46333
|
||||
3368CC4366ECCCCCCE6634CCE6635CD33338CCCC828004003333333333336333
|
||||
00B077BCCCC8366DC83333DCCCCCCCAE333333FACCCCCCD3333338CCCCCCC000
|
||||
0000CCCCCCCCCC555CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC55CCCCCC5B4B0A20
|
||||
DD3333EFF333336B0040872CCCCCCCCCCCC55CCCCCCCCCCCCC55CCCCCCCCCCCC
|
||||
5555CCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCC7440BB00333333333333372088B42ACCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCA4AB00000333EEEEE3330000B0847CCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC4440000000384A48300000
|
||||
007445CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
|
||||
0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC574800
|
||||
000B0000000BB0000244ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCC474400085555555554B007487CCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCC72A4B0028A5C5A470008A825CCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC77AA8000000000007AA
|
||||
8B5CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
|
||||
0000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA7
|
||||
4A5A8BB0BB7455478CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCC5474A55555555487ACCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA44AAAAA4445CCCCCCCCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0000000CCCCCCCCCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC555555CCCCC
|
||||
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000
|
||||
0000}
|
||||
OnClick = ImageLogoClick
|
||||
end
|
||||
object EditTable: TEdit
|
||||
Left = 2
|
||||
Top = 8
|
||||
Width = 167
|
||||
Height = 21
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
TabOrder = 0
|
||||
OnChange = EditTableChange
|
||||
end
|
||||
object ListTable: TListBox
|
||||
Left = 2
|
||||
Top = 32
|
||||
Width = 167
|
||||
Height = 401
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
ItemHeight = 13
|
||||
MultiSelect = True
|
||||
TabOrder = 1
|
||||
OnClick = ListTableClick
|
||||
OnDblClick = ListTableDblClick
|
||||
OnKeyDown = ListTableKeyDown
|
||||
OnKeyUp = ListTableKeyUp
|
||||
OnMouseDown = ListTableMouseDown
|
||||
end
|
||||
object BtnQueryBuilder: TButton
|
||||
Left = 2
|
||||
Top = 434
|
||||
Width = 84
|
||||
Height = 20
|
||||
Hint = 'Create a query (and potential object) from the selected tables'
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Query Builder'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 2
|
||||
OnClick = BtnQueryBuilderClick
|
||||
end
|
||||
object BtnTablesExport: TButton
|
||||
Left = 1
|
||||
Top = 454
|
||||
Width = 84
|
||||
Height = 20
|
||||
Hint = 'Export the selected tables into a SQLite3 DB file'
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Tables Export'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 3
|
||||
OnClick = BtnTablesExportClick
|
||||
end
|
||||
object btnRunServer: TButton
|
||||
Left = 87
|
||||
Top = 454
|
||||
Width = 84
|
||||
Height = 20
|
||||
Hint = 'Export the selected tables into a SQLite3 DB file'
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'HTTP Server'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 4
|
||||
OnClick = btnRunServerClick
|
||||
end
|
||||
end
|
||||
object TabObjects: TTabSheet
|
||||
Caption = 'Objects'
|
||||
ImageIndex = 1
|
||||
end
|
||||
end
|
||||
object PopupMenuSQL: TPopupMenu
|
||||
OnPopup = PopupMenuSQLPopup
|
||||
Left = 200
|
||||
Top = 16
|
||||
object MenuInsertFieldName: TMenuItem
|
||||
Caption = 'Fields'
|
||||
Hint = 'all fields'
|
||||
end
|
||||
object MenuInsertFieldValues: TMenuItem
|
||||
Caption = 'Values'
|
||||
Hint = 'all values'
|
||||
end
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,813 @@
|
||||
unit SynDBExplorerFrame;
|
||||
|
||||
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows,
|
||||
Messages,
|
||||
SysUtils,
|
||||
Classes,
|
||||
Graphics,
|
||||
Controls,
|
||||
Forms,
|
||||
Dialogs,
|
||||
StdCtrls,
|
||||
Grids,
|
||||
ExtCtrls,
|
||||
ComCtrls,
|
||||
Types,
|
||||
ShellAPI,
|
||||
Menus,
|
||||
{$ifdef ISDELPHIXE3} System.UITypes, {$endif}
|
||||
SynCommons,
|
||||
SynDB,
|
||||
mORMot,
|
||||
mORMoti18n,
|
||||
mORMotUI,
|
||||
mORMotUILogin,
|
||||
mORMotToolBar,
|
||||
mORMotReport;
|
||||
|
||||
type
|
||||
TDBExplorerFrame = class(TFrame)
|
||||
Splitter1: TSplitter;
|
||||
PanelClient: TPanel;
|
||||
Splitter2: TSplitter;
|
||||
DrawGrid: TDrawGrid;
|
||||
PanelTop: TPanel;
|
||||
MemoSQL: TMemo;
|
||||
BtnExec: TButton;
|
||||
BtnResultToFile: TButton;
|
||||
PopupMenuSQL: TPopupMenu;
|
||||
MenuInsertFieldName: TMenuItem;
|
||||
MenuInsertFieldValues: TMenuItem;
|
||||
BtnExecToFile: TButton;
|
||||
PagesLeft: TPageControl;
|
||||
TabTables: TTabSheet;
|
||||
TabObjects: TTabSheet;
|
||||
EditTable: TEdit;
|
||||
ListTable: TListBox;
|
||||
ImageLogo: TImage;
|
||||
BtnQueryBuilder: TButton;
|
||||
BtnTablesExport: TButton;
|
||||
BtnExecLog: TButton;
|
||||
BtnExecToTab: TButton;
|
||||
btnRunServer: TButton;
|
||||
procedure EditTableChange(Sender: TObject);
|
||||
procedure ListTableDblClick(Sender: TObject);
|
||||
procedure BtnExecClick(Sender: TObject);
|
||||
procedure ListTableMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure BtnResultToFileClick(Sender: TObject);
|
||||
procedure PopupMenuSQLPopup(Sender: TObject);
|
||||
procedure ImageLogoClick(Sender: TObject);
|
||||
procedure BtnQueryBuilderClick(Sender: TObject);
|
||||
procedure ListTableClick(Sender: TObject);
|
||||
procedure BtnTablesExportClick(Sender: TObject);
|
||||
procedure BtnExecLogClick(Sender: TObject);
|
||||
procedure ListTableKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
procedure ListTableKeyUp(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
procedure btnRunServerClick(Sender: TObject);
|
||||
private
|
||||
fHint: THintWindowDelayed;
|
||||
fGrid: TSQLTableToGrid;
|
||||
fJSONBuffer: RawUTF8;
|
||||
fPreviousSQL: RawUTF8;
|
||||
fSQLLogFile: TFileName;
|
||||
fListTableShiftState: TShiftState;
|
||||
function OnText(Sender: TSQLTable; FieldIndex, RowIndex: Integer; var Text: string): boolean;
|
||||
function GetTableDescription(const TableName: string): string;
|
||||
procedure OnGridDblClick(Sender: TObject);
|
||||
procedure InsertMenu(Sender: TObject);
|
||||
function GridValue(Row,Col: integer): RawUTF8;
|
||||
function GetFileNameFromCurrentSelectedTable: TFileName;
|
||||
procedure AddSQL(SQL: string; AndExec, AndExecInNewTab: boolean);
|
||||
procedure LogClick(Sender: TObject);
|
||||
procedure LogDblClick(Sender: TObject);
|
||||
procedure LogSearch(Sender: TObject);
|
||||
public
|
||||
Tables: TStringList;
|
||||
Props: TSQLDBConnectionProperties;
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
resourcestring
|
||||
sCaptionStats = '%d rows (%s) in %s';
|
||||
sCaptionUpdated = '%d row(s) updated in %s';
|
||||
sNothingToExport = 'No result to export';
|
||||
sExportFilter = 'Excel file (*.csv)|*.csv|Text file (*.txt)|*.txt|'+
|
||||
'JSON file (*.json)|*.json|Acrobat PDF report (*.pdf)|*.pdf';
|
||||
sHugeFileExport = 'Do you want to export so much data?';
|
||||
sExportingN = 'Exporting %s...';
|
||||
sHugeFileConfirm = 'This could take a while to create the report';
|
||||
sExecExportFilter = 'Excel file (*.csv)|*.csv|Text file (*.txt)|*.txt|'+
|
||||
'Standard JSON file (*.json)|*.json|Smaller JSON file (*.json)|*.json|'+
|
||||
'SQLite3 database file (*.db3)|*.db3|'+
|
||||
'BigTable fixed sized record (*.rec)|*.rec|'+
|
||||
'BigTable variable length record (*.rec)|*.rec';
|
||||
sTableExportFilter = 'SQLite3 database file (*.db3)|*.db3';
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SynDBOracle,
|
||||
SynDBExplorerMain,
|
||||
SynDBExplorerQueryBuilder,
|
||||
SynDBExplorerExportTables,
|
||||
SynTaskDialog,
|
||||
SynTable,
|
||||
SynBigTable,
|
||||
SynDBSQLite3,
|
||||
SynDBExplorerServer;
|
||||
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
function RowsToSynBigTableRecord(const Dest: TFileName; Rows: TSQLDBStatement;
|
||||
VariableLength: boolean): integer;
|
||||
const
|
||||
TOFIELD: array[Boolean,TSQLDBFieldType] of TSynTableFieldType = (
|
||||
(tftUnknown,tftUnknown,tftInt64,tftDouble,tftCurrency,tftDouble,tftUTF8,tftBlobInternal),
|
||||
(tftUnknown,tftUnknown,tftVarInt64,tftDouble,tftCurrency,tftDouble,tftUTF8,tftBlobInternal));
|
||||
var F, FMax: integer;
|
||||
BT: TSynBigTableRecord;
|
||||
Blob: RawByteString;
|
||||
FT: TSynTableFieldType;
|
||||
ColName: RawUTF8;
|
||||
ColRowID: integer;
|
||||
FieldsMap: array of Integer; // column order vary depending on access speed
|
||||
FieldsValue: TRawByteStringDynArray;
|
||||
begin
|
||||
result := 0;
|
||||
if (Dest='') or (Rows=nil) or (Rows.ColumnCount=0) then
|
||||
exit;
|
||||
FMax := Rows.ColumnCount-1;
|
||||
DeleteFile(Dest);
|
||||
SetLength(FieldsValue,FMax+1);
|
||||
BT := TSynBigTableRecord.Create(Dest,'SynDbExported');
|
||||
try
|
||||
while Rows.Step do begin
|
||||
if result=0 then begin
|
||||
// retrieve column layout (when first row of data is available)
|
||||
ColRowID := -1;
|
||||
for F := 0 to FMax do begin
|
||||
ColName := Rows.ColumnName(F);
|
||||
FT := TOFIELD[VariableLength,Rows.ColumnType(F)];
|
||||
if FT=tftUnknown then
|
||||
raise Exception.CreateFmt('Invalid column type %s',[ColName]);
|
||||
if IsRowID(pointer(ColName)) then begin
|
||||
ColName := 'ID__'; // force accepted column name
|
||||
ColRowID := F;
|
||||
end;
|
||||
if not BT.AddField(ColName,FT) then
|
||||
raise Exception.CreateFmt('Impossible to add column %s',[ColName]);
|
||||
end;
|
||||
BT.AddFieldUpdate;
|
||||
if BT.Table.FieldCount<>FMax+1 then
|
||||
raise Exception.Create('Invalid column layout');
|
||||
SetLength(FieldsMap,FMax+1);
|
||||
for F := 0 to FMax do begin
|
||||
ColName := BT.Table.Field[F].Name;
|
||||
if (ColRowID>=0) and (ColName='ID__') then
|
||||
FieldsMap[F] := ColRowID else
|
||||
FieldsMap[F] := Rows.ColumnIndex(ColName);
|
||||
if FieldsMap[F]<0 then
|
||||
raise Exception.CreateFmt('Invalid column type %s',[ColName]);
|
||||
end;
|
||||
end;
|
||||
// recreate each record from scratch (fast in practice)
|
||||
for F := 0 to FMax do
|
||||
with BT.Table.Field[F] do begin
|
||||
case FieldType of
|
||||
tftInt64, tftVarInt64:
|
||||
FieldsValue[F] := SBF(Rows.ColumnInt(FieldsMap[F]));
|
||||
tftDouble:
|
||||
FieldsValue[F] := SBF(Rows.ColumnDouble(FieldsMap[F]));
|
||||
tftCurrency:
|
||||
FieldsValue[F] := SBFCurr(Rows.ColumnCurrency(FieldsMap[F]));
|
||||
tftUTF8:
|
||||
FieldsValue[F] := SBF(Rows.ColumnUTF8(FieldsMap[F]));
|
||||
tftBlobInternal: begin
|
||||
Blob := Rows.ColumnBlob(FieldsMap[F]);
|
||||
FieldsValue[F] := SBF(pointer(Blob),length(Blob));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
BT.Add(RawByteStringArrayConcat(FieldsValue));
|
||||
if BT.CurrentInMemoryDataSize>$5000000 then // write on disk every 80 MB
|
||||
BT.UpdateToFile;
|
||||
inc(result);
|
||||
end;
|
||||
assert(result=BT.Count);
|
||||
finally
|
||||
BT.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.EditTableChange(Sender: TObject);
|
||||
var s: string;
|
||||
i: integer;
|
||||
begin
|
||||
s := SysUtils.UpperCase(SysUtils.trim(EditTable.Text));
|
||||
with ListTable.Items do
|
||||
try
|
||||
BeginUpdate;
|
||||
Clear;
|
||||
for i := 0 to Tables.Count-1 do
|
||||
if (s='') or (Pos(s,SysUtils.UpperCase(Tables[i]))>0) then
|
||||
Add(Tables[i]);
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
ListTableClick(nil);
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.AddSQL(SQL: string; AndExec, AndExecInNewTab: boolean);
|
||||
var len: integer;
|
||||
orig: string;
|
||||
begin
|
||||
fHint.Hide;
|
||||
SQL := SysUtils.Trim(SQL);
|
||||
len := Length(SQL);
|
||||
if len=0 then
|
||||
exit;
|
||||
orig := MemoSQL.Lines.Text;
|
||||
if orig<>'' then
|
||||
SQL := #13#10#13#10+SQL;
|
||||
SQL := orig+SQL;
|
||||
MemoSQL.Lines.Text := SQL;
|
||||
MemoSQL.SelStart := length(SQL)-len;
|
||||
MemoSQL.SelLength := len;
|
||||
if AndExec then
|
||||
if AndExecInNewTab then
|
||||
BtnExecClick(BtnExecToTab) else
|
||||
BtnExecClick(BtnExec) else
|
||||
MemoSQL.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.ListTableKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
fListTableShiftState := Shift;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.ListTableKeyUp(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
fListTableShiftState := [];
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.ListTableDblClick(Sender: TObject);
|
||||
var i: integer;
|
||||
begin
|
||||
i := ListTable.ItemIndex;
|
||||
if i>=0 then
|
||||
AddSQL(UTF8ToString(Props.SQLSelectAll(StringToUTF8(ListTable.Items[i]),nil,[])),
|
||||
true,ssShift in fListTableShiftState);
|
||||
end;
|
||||
|
||||
procedure ShowException(E: Exception);
|
||||
var Dlg: TTaskDialog;
|
||||
stack: string;
|
||||
begin
|
||||
if E=nil then
|
||||
exit;
|
||||
Dlg.Content := E.Message;
|
||||
{$ifdef UNICODE}
|
||||
stack := sLineBreak+E.StackTrace;
|
||||
{$endif}
|
||||
Dlg.Info := Format('Exception class: %s%s',[E.ClassName,stack]);
|
||||
Dlg.Execute([],0,[],tiError);
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.BtnExecClick(Sender: TObject);
|
||||
var SQL, Stop: RawUTF8;
|
||||
Table: TSQLTable;
|
||||
Timer: TPrecisionTimer;
|
||||
SelStart, SelLength, RowsCount, Kind, i: integer;
|
||||
Rows: ISQLDBRows;
|
||||
RowsSize: Int64;
|
||||
FN: TFileName;
|
||||
FS: TFileStream;
|
||||
Frame: TDBExplorerFrame;
|
||||
begin
|
||||
FreeAndNil(fGrid);
|
||||
DrawGrid.RowCount := 0;
|
||||
SelStart := MemoSQL.SelStart;
|
||||
SelLength := MemoSQL.SelLength;
|
||||
if SelLength>10 then
|
||||
SQL := Trim(S2U(MemoSQL.SelText)) else
|
||||
SQL := Trim(S2U(MemoSQL.Lines.Text));
|
||||
for i := 1 to length(SQL) do
|
||||
if SQL[i]<' ' then
|
||||
SQL[i] := ' '; // some engines (e.g. MSSQL) don't like line feeds
|
||||
Frame := self;
|
||||
Screen.Cursor := crSQLWait;
|
||||
Timer.Start;
|
||||
try
|
||||
try
|
||||
Caption := '';
|
||||
RowsCount := 0;
|
||||
RowsSize := 0;
|
||||
if SQL<>'' then
|
||||
if isSelect(Pointer(SQL)) then begin
|
||||
try
|
||||
Rows := Props.Execute(SQL,[],nil,(Sender<>BtnExecToFile));
|
||||
except
|
||||
on Exception do
|
||||
if Props.InheritsFrom(TSQLDBSQLite3ConnectionProperties) then
|
||||
// SQLite3 engine is local -> so any failure is fatal
|
||||
raise else begin
|
||||
// DB error (loose remote connection?) -> retry once
|
||||
Props.ClearConnectionPool;
|
||||
Rows := Props.Execute(SQL,[]);
|
||||
end;
|
||||
end;
|
||||
if (Sender=BtnExec) or (Sender=nil) or (Sender=BtnExecToTab) then begin
|
||||
if Sender=BtnExecToTab then begin
|
||||
Frame := ((Owner as TSynPage).Owner as TDbExplorerMain).CreateFrame;
|
||||
Frame.MemoSQL.Lines.Text := U2S(SQL);
|
||||
end;
|
||||
with Frame do begin
|
||||
fJSONBuffer := Rows.FetchAllAsJSON(false);
|
||||
Stop := Timer.Stop;
|
||||
Table := TSQLTableJSON.Create('',pointer(fJSONBuffer),length(fJSONBuffer));
|
||||
fGrid := TSQLTableToGrid.Create(DrawGrid,Table,nil);
|
||||
fGrid.SetAlignedByType(sftCurrency,alRight);
|
||||
fGrid.OnValueText := OnText;
|
||||
fGrid.SetFieldFixedWidth(100);
|
||||
fGrid.FieldTitleTruncatedNotShownAsHint := true;
|
||||
DrawGrid.Options := DrawGrid.Options-[goRowSelect];
|
||||
DrawGrid.OnDblClick := self.OnGridDblClick;
|
||||
RowsCount := Table.RowCount;
|
||||
RowsSize := length(fJSONBuffer);
|
||||
end;
|
||||
end else
|
||||
if Sender=BtnExecToFile then begin
|
||||
Timer.Pause;
|
||||
with TSaveDialog.Create(self) do
|
||||
try
|
||||
InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
|
||||
Filter := sExecExportFilter; // csv,txt,json,json,record,record
|
||||
DefaultExt := '.csv';
|
||||
FilterIndex := 0;
|
||||
Title := BtnExecToFile.Hint;
|
||||
Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
|
||||
FileName := GetFileNameFromCurrentSelectedTable;
|
||||
if not Execute then
|
||||
exit;
|
||||
Kind := FilterIndex;
|
||||
FN := FileName;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
Timer.Resume;
|
||||
with CreateTempForm(format(sExportingN,[GetFileNameFromCurrentSelectedTable]),nil,True) do
|
||||
try
|
||||
case Kind of
|
||||
5: Rowscount := RowsToSQLite3(FN,S2U(GetFileNameFromCurrentSelectedTable),Rows.Instance,false);
|
||||
6: RowsCount := RowsToSynBigTableRecord(FN,Rows.Instance,False); // fixed length
|
||||
7: RowsCount := RowsToSynBigTableRecord(FN,Rows.Instance,True); // variable length
|
||||
else begin
|
||||
FS := TFileStream.Create(FN,fmCreate);
|
||||
try
|
||||
case Kind of
|
||||
1: RowsCount := Rows.Instance.FetchAllToCSVValues(FS,False,
|
||||
AnsiChar({$ifdef ISDELPHIXE}FormatSettings.{$endif}ListSeparator),true);
|
||||
2: RowsCount := Rows.Instance.FetchAllToCSVValues(FS,true,#9,true);
|
||||
3: RowsCount := Rows.Instance.FetchAllToJSON(FS,true); // expanded=true
|
||||
4: RowsCount := Rows.Instance.FetchAllToJSON(FS,false); // expanded=false
|
||||
end;
|
||||
finally
|
||||
FS.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Stop := Timer.Stop;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
RowsSize := FileSize(FN);
|
||||
end;
|
||||
Frame.Caption := format(sCaptionStats,
|
||||
[RowsCount,Ansi7ToString(KB(RowsSize)),Ansi7ToString(Stop)]);
|
||||
end else
|
||||
Caption := Format(sCaptionUpdated,[Props.ExecuteNoResult(SQL,[]),
|
||||
Ansi7ToString(Timer.Stop)]);
|
||||
with Frame do begin
|
||||
(Parent as TSynPage).Caption := Caption;
|
||||
MemoSQL.SelStart := SelStart;
|
||||
MemoSQL.SelLength := SelLength;
|
||||
MemoSQL.SetFocus;
|
||||
if SQL<>fPreviousSQL then begin
|
||||
AppendToTextFile(SQL,fSQLLogFile);
|
||||
fPreviousSQL := SQL;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
ShowException(E);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDBExplorerFrame.GetTableDescription(const TableName: string): string;
|
||||
var Fields: TRawUTF8DynArray;
|
||||
begin
|
||||
Screen.Cursor := crSQLWait;
|
||||
try
|
||||
Props.GetFieldDefinitions(S2U(TableName),Fields,true);
|
||||
result := TableName+#13#10' '+U2S(RawUTF8ArrayToCSV(Fields,#13#10' '));
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.ListTableMouseDown(Sender: TObject;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
var i: integer;
|
||||
begin
|
||||
if Button=mbRight then begin
|
||||
i := ListTable.ItemIndex;
|
||||
if i>=0 then begin
|
||||
if (fHint.Tag=i) and fHint.Visible then begin
|
||||
fHint.Hide;
|
||||
exit;
|
||||
end;
|
||||
fHint.ShowDelayedString(GetTableDescription(ListTable.Items[i]),
|
||||
ListTable,X,Y,5000,clNavy,true);
|
||||
fHint.Tag := i;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.BtnQueryBuilderClick(Sender: TObject);
|
||||
var SQL: string;
|
||||
O: TDBQueryObject;
|
||||
begin
|
||||
case TDBQueryBuilderForm.BuildQuery(ListTable,Props,SQL) of
|
||||
mrOk: AddSQL(SQL,false,false); // Use SQL
|
||||
mrYes: AddSQL(SQL,true,false); // Exec SQL
|
||||
mrRetry: begin // To Object (SQL=Object serialization)
|
||||
O.FromIniSection(StringToUTF8(SQL));
|
||||
assert(O.AsIniSection=SQL);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDBExplorerFrame.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
fHint := THintWindowDelayed.Create(self);
|
||||
fSQLLogFile := ChangeFileExt(ExeVersion.ProgramFileName,'.history');
|
||||
PagesLeft.ActivePageIndex := 0;
|
||||
end;
|
||||
|
||||
destructor TDBExplorerFrame.Destroy;
|
||||
begin
|
||||
FreeAndNil(fGrid);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDBExplorerFrame.OnText(Sender: TSQLTable; FieldIndex,
|
||||
RowIndex: Integer; var Text: string): boolean;
|
||||
begin
|
||||
if RowIndex=0 then begin
|
||||
Text := U2S(Sender.GetU(RowIndex,FieldIndex)); // display true column name
|
||||
result := true;
|
||||
end else
|
||||
result := false;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.BtnResultToFileClick(Sender: TObject);
|
||||
var F: TStream;
|
||||
Rep: TGdiPages;
|
||||
Form: TCustomForm;
|
||||
TableName: string;
|
||||
begin
|
||||
Form := Application.MainForm;
|
||||
if (fGrid=nil) or (fGrid.Table.RowCount=0) then
|
||||
ShowMessage(sNothingToExport,true) else
|
||||
with TSaveDialog.Create(Form) do
|
||||
try
|
||||
InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
|
||||
DefaultExt := 'csv';
|
||||
Filter := sExportFilter; // csv,txt,json,pdf
|
||||
FilterIndex := 0;
|
||||
Title := BtnResultToFile.Hint;
|
||||
Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
|
||||
TableName := GetFileNameFromCurrentSelectedTable;
|
||||
FileName := TableName;
|
||||
if not Execute then
|
||||
exit;
|
||||
with CreateTempForm(format(sExportingN,[TableName]),nil,True) do
|
||||
try
|
||||
if FilterIndex=4 then begin
|
||||
if fGrid.Table.RowCount>10000 then
|
||||
if YesNo(sHugeFileConfirm,sHugeFileExport,false,true)=mrNo then
|
||||
exit;
|
||||
Rep := TGDIPages.Create(Application);
|
||||
try
|
||||
Rep.BeginDoc;
|
||||
Rep.Font.Size := 11;
|
||||
Rep.DrawTitle(SysUtils.Trim(Form.Caption));
|
||||
Rep.NewLine;
|
||||
Rep.Font.Style := [fsBold];
|
||||
Rep.DrawText(MemoSQL.Text);
|
||||
Rep.Font.Style := [];
|
||||
Rep.Font.Size := 9;
|
||||
Rep.DrawText(self.Caption);
|
||||
Rep.NewLine;
|
||||
if ListTable.ItemIndex>=0 then begin
|
||||
Rep.DrawText(GetTableDescription(TableName));
|
||||
Rep.NewLine;
|
||||
end;
|
||||
Rep.WordWrapLeftCols := true;
|
||||
TSQLRibbon(nil).AddToReport(Rep,fGrid.Table,[]);
|
||||
Rep.EndDoc;
|
||||
Rep.Caption := GetFileNameWithoutExt(ExtractFileName(FileName));
|
||||
Rep.ExportPDFAuthor := U2S(ExeVersion.User);
|
||||
Rep.ExportPDFApplication := Form.Caption;
|
||||
Rep.ExportPDFSubject := BtnResultToFile.Hint;
|
||||
Rep.ExportPDFKeywords := MemoSQL.Text;
|
||||
Rep.ExportPDF(FileName,True,false)
|
||||
finally
|
||||
Rep.Free;
|
||||
end;
|
||||
end else begin
|
||||
F := TFileStream.Create(FileName,fmCreate);
|
||||
try
|
||||
case FilterIndex of
|
||||
1: fGrid.Table.GetCSVValues(F,false,
|
||||
AnsiChar({$ifdef ISDELPHIXE}FormatSettings.{$endif}ListSeparator),true);
|
||||
2: fGrid.Table.GetCSVValues(F,true,#9,true);
|
||||
3: fGrid.Table.GetJSONValues(F,true);
|
||||
end;
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
Free;
|
||||
end;
|
||||
ShellExecute(Form.Handle,nil,pointer(FileName),nil,nil,SW_SHOWNORMAL);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDBExplorerFrame.GridValue(Row, Col: integer): RawUTF8;
|
||||
begin
|
||||
result := fGrid.Table.GetU(Row,Col);
|
||||
if Row>0 then
|
||||
case fGrid.Table.FieldType(Col) of
|
||||
sftAnsiText, sftUTF8Text, sftObject:
|
||||
result := QuotedStr(result);
|
||||
sftDateTime, sftDateTimeMS:
|
||||
result := Props.SQLIso8601ToDate(result);
|
||||
sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime:
|
||||
result := Props.SQLIso8601ToDate(DateTimeToIso8601Text(
|
||||
fGrid.Table.GetAsDateTime(Row,Col)));
|
||||
sftBlob, sftBlobDynArray:
|
||||
result := ''; // BLOB won't work in SQL without parameter binding
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.OnGridDblClick(Sender: TObject);
|
||||
var R,C: integer;
|
||||
sql: string;
|
||||
sel: boolean;
|
||||
selStart: integer;
|
||||
begin
|
||||
R := DrawGrid.Row;
|
||||
C := DrawGrid.Col;
|
||||
if (R<=0) or (fGrid.Table=nil) then
|
||||
exit;
|
||||
sel := MemoSQL.SelLength>5;
|
||||
if sel then
|
||||
sql := MemoSQL.SelText else
|
||||
sql := MemoSQL.Text;
|
||||
if Pos(' WHERE ',SysUtils.UpperCase(sql))=0 then
|
||||
sql := sql+' where ' else
|
||||
sql := sql+' and ';
|
||||
sql := sql+fGrid.Table.GetString(0,C)+'='+U2S(GridValue(R,C));
|
||||
if sel then begin
|
||||
selStart := MemoSQL.SelStart;
|
||||
MemoSQL.SelText := sql;
|
||||
MemoSQL.SelStart := selStart;
|
||||
MemoSQL.SelLength := length(sql);
|
||||
MemoSQL.SetFocus;
|
||||
end else
|
||||
MemoSQL.Text := sql;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.PopupMenuSQLPopup(Sender: TObject);
|
||||
procedure Add(M: TMenuItem; Row: integer);
|
||||
function New(caption: string; Col: integer=0; csv: PString=nil): TMenuItem;
|
||||
begin
|
||||
caption := SysUtils.trim(caption);
|
||||
if caption<>'' then begin
|
||||
result := TMenuItem.Create(self);
|
||||
result.Caption := Caption;
|
||||
result.Hint := ' '+Caption;
|
||||
result.OnClick := InsertMenu;
|
||||
M.Add(result);
|
||||
end else begin
|
||||
result := nil;
|
||||
caption := 'null';
|
||||
end;
|
||||
if csv<>nil then begin
|
||||
if csv^<>'' then
|
||||
csv^ := csv^+',';
|
||||
csv^ := csv^+caption;
|
||||
end;
|
||||
end;
|
||||
var i: integer;
|
||||
csv: string;
|
||||
begin
|
||||
M.Clear;
|
||||
csv := '';
|
||||
if (Row>=0) and (fGrid<>nil) and (fGrid.Table<>nil) then
|
||||
with fGrid.Table do
|
||||
for i := 0 to FieldCount-1 do
|
||||
New(U2S(GridValue(Row,i)),i,@csv);
|
||||
M.Enabled := M.Count>0;
|
||||
if M.Enabled then begin
|
||||
New('-');
|
||||
New(csv).Caption := M.Hint;
|
||||
end;
|
||||
end;
|
||||
begin
|
||||
Add(MenuInsertFieldName,0);
|
||||
Add(MenuInsertFieldValues,DrawGrid.Row);
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.InsertMenu(Sender: TObject);
|
||||
var Ins: string;
|
||||
begin
|
||||
if Sender.InheritsFrom(TMenuItem) then begin
|
||||
Ins := TMenuItem(Sender).Hint;
|
||||
MemoSQL.SelText := Ins;
|
||||
MemoSQL.SelLength := length(Ins);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.ImageLogoClick(Sender: TObject);
|
||||
begin
|
||||
{$WARNINGS OFF}
|
||||
if DebugHook=0 then
|
||||
ShellExecute(0,nil,'https://synopse.info',nil,nil,SW_SHOWNORMAL);
|
||||
{$WARNINGS ON}
|
||||
end;
|
||||
|
||||
function TDBExplorerFrame.GetFileNameFromCurrentSelectedTable: TFileName;
|
||||
begin
|
||||
if (ListTable.Count=0) or (ListTable.ItemIndex<0) then
|
||||
result := 'Export' else
|
||||
result := ListTable.Items[ListTable.ItemIndex];
|
||||
end;
|
||||
|
||||
|
||||
procedure TDBExplorerFrame.ListTableClick(Sender: TObject);
|
||||
var MultiSel: boolean;
|
||||
begin
|
||||
MultiSel := ListTable.SelCount>0;
|
||||
BtnQueryBuilder.Enabled := MultiSel;
|
||||
BtnTablesExport.Enabled := MultiSel;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.BtnTablesExportClick(Sender: TObject);
|
||||
var RowsCount: integer;
|
||||
Timer: TPrecisionTimer;
|
||||
aFileName: TFileName;
|
||||
begin
|
||||
with TSaveDialog.Create(self) do
|
||||
try
|
||||
InitialDir := GetShellFolderPath(CSIDL_DOCUMENTS);
|
||||
Filter := sTableExportFilter;
|
||||
DefaultExt := '.db3';
|
||||
FilterIndex := 0;
|
||||
Title := BtnTablesExport.Hint;
|
||||
Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
|
||||
FileName := U2S(Props.ServerName+'_'+NowToString(false,'_'));
|
||||
if not Execute then begin
|
||||
FileName := U2S(
|
||||
TSQLDBOracleConnectionProperties.ExtractTnsName(Props.ServerName)+
|
||||
'_'+NowToString(false,'_'));
|
||||
if not Execute then
|
||||
exit;
|
||||
end;
|
||||
aFileName := FileName;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
Timer.Start;
|
||||
RowsCount := TDBExportTablesForm.ExportTables(ListTable,Props,aFileName);
|
||||
(Parent as TTabSheet).Caption := format(sCaptionStats,
|
||||
[RowsCount,ExtractFileName(aFileName),Ansi7ToString(Timer.Stop)]);
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.BtnExecLogClick(Sender: TObject);
|
||||
var F: TForm;
|
||||
List: TListBox;
|
||||
Search: TEdit;
|
||||
Details: TMemo;
|
||||
begin
|
||||
F := TForm.Create(Application);
|
||||
try
|
||||
F.Caption := ' '+BtnExecLog.Hint;
|
||||
F.Font := Font;
|
||||
F.Width := 800;
|
||||
F.Height := Screen.Height-80;
|
||||
F.Position := poMainFormCenter;
|
||||
Search := TEdit.Create(F);
|
||||
Search.Parent := F;
|
||||
Search.Align := alTop;
|
||||
Search.Height := 24;
|
||||
Search.OnChange := LogSearch;
|
||||
Details := TMemo.Create(F);
|
||||
Details.Parent := F;
|
||||
Details.Align := alBottom;
|
||||
Details.Height := 200;
|
||||
Details.ReadOnly := true;
|
||||
List := TListBox.Create(F);
|
||||
with List do begin
|
||||
Parent := F;
|
||||
Align := alClient;
|
||||
Tag := PtrInt(Details);
|
||||
OnClick := LogClick;
|
||||
OnDblClick := LogDblClick;
|
||||
end;
|
||||
Search.Tag := PtrInt(List);
|
||||
LogSearch(Search);
|
||||
F.ShowModal;
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.LogClick(Sender: TObject);
|
||||
var List: TListBox absolute Sender;
|
||||
ndx: integer;
|
||||
begin
|
||||
ndx := cardinal(List.ItemIndex);
|
||||
if ndx>=0 then
|
||||
TMemo(List.Tag).Text := copy(List.Items[ndx],21,maxInt) else
|
||||
TMemo(List.Tag).Clear;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.LogDblClick(Sender: TObject);
|
||||
var List: TListBox absolute Sender;
|
||||
SQL: string;
|
||||
ndx: integer;
|
||||
begin
|
||||
ndx := cardinal(List.ItemIndex);
|
||||
if ndx>=0 then begin
|
||||
SQL := copy(List.Items[ndx],21,maxInt);
|
||||
AddSQL(SQL,IsSelect(pointer(StringToAnsi7(SQL))),false);
|
||||
TForm(List.Owner).Close;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.LogSearch(Sender: TObject);
|
||||
const MAX_LINES_IN_HISTORY = 500;
|
||||
var Edit: TEdit absolute Sender;
|
||||
List: TListBox;
|
||||
i: integer;
|
||||
s: RawUTF8;
|
||||
begin
|
||||
s := SynCommons.UpperCase(StringToUTF8(Edit.Text));
|
||||
List := pointer(Edit.Tag);
|
||||
with TMemoryMapText.Create(fSQLLogFile) do
|
||||
try
|
||||
List.Items.BeginUpdate;
|
||||
List.Items.Clear;
|
||||
for i := Count-1 downto 0 do
|
||||
if (s='') or LineContains(s,i) then
|
||||
if List.Items.Add(Strings[i])>MAX_LINES_IN_HISTORY then
|
||||
break; // read last 500 lines from UTF-8 file
|
||||
finally
|
||||
Free;
|
||||
List.Items.EndUpdate;
|
||||
end;
|
||||
List.ItemIndex := 0;
|
||||
LogClick(List);
|
||||
end;
|
||||
|
||||
procedure TDBExplorerFrame.btnRunServerClick(Sender: TObject);
|
||||
begin
|
||||
if (HTTPServerForm.Props=nil) or (HTTPServerForm.Server=nil) then
|
||||
HTTPServerForm.Props := Props;
|
||||
HTTPServerForm.Show;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,23 @@
|
||||
object DbExplorerMain: TDbExplorerMain
|
||||
Left = 225
|
||||
Top = 210
|
||||
Width = 879
|
||||
Height = 623
|
||||
Caption = ' SynDB Explorer'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
KeyPreview = True
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
Scaled = False
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnShow = FormShow
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
end
|
||||
@@ -0,0 +1,392 @@
|
||||
unit SynDBExplorerMain;
|
||||
|
||||
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
||||
|
||||
interface
|
||||
|
||||
{.$define USEZEOS}
|
||||
|
||||
uses
|
||||
Windows,
|
||||
Messages,
|
||||
SysUtils,
|
||||
Variants,
|
||||
Classes,
|
||||
Graphics,
|
||||
Controls,
|
||||
Forms,
|
||||
Grids,
|
||||
ExtCtrls,
|
||||
StdCtrls,
|
||||
{$ifndef FPC}
|
||||
Consts,
|
||||
{$ifdef HASINLINE} XPMan,
|
||||
Contnrs, {$endif}
|
||||
{$endif}
|
||||
{$ifdef ISDELPHIXE}
|
||||
SynSQLite3RegEx, // use direct PCRE library as available since Delphi XE
|
||||
{$endif}
|
||||
SynCommons,
|
||||
SynZip,
|
||||
mORMot,
|
||||
SynSQLite3,
|
||||
SynSQLite3Static,
|
||||
mORMotUI,
|
||||
mORMotUIEdit,
|
||||
mORMotUILogin,
|
||||
mORMotToolBar,
|
||||
SynTaskDialog, // also fix QC 37403 for Delphi 6/7/2006
|
||||
SynTable, // for TSynFilter and TSynValidate
|
||||
SynDB,
|
||||
SynDBOracle,
|
||||
SynOleDB,
|
||||
SynDBSQLite3,
|
||||
SynDBODBC,
|
||||
SynDBRemote,
|
||||
{$ifdef USEZEOS}
|
||||
SynDBZeos,
|
||||
{$endif}
|
||||
SynDBExplorerClasses,
|
||||
SynDBExplorerFrame,
|
||||
ComCtrls;
|
||||
|
||||
type
|
||||
TDbExplorerMain = class(TForm)
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
private
|
||||
MainCaption: string;
|
||||
Connection: TExpConnectionType;
|
||||
Page: TSynPager;
|
||||
PageNew: TSynPage;
|
||||
TempFileName: TFileName;
|
||||
procedure PageChange(Sender: TObject);
|
||||
procedure PageDblClick(Sender: TObject);
|
||||
public
|
||||
ConnectionName: string;
|
||||
Tables: TStringList;
|
||||
Props: TSQLDBConnectionProperties;
|
||||
function CreateFrame: TDBExplorerFrame;
|
||||
end;
|
||||
|
||||
var
|
||||
DbExplorerMain: TDbExplorerMain;
|
||||
|
||||
|
||||
resourcestring
|
||||
sSelectAConnection = 'Select a connection';
|
||||
sNew = 'New Connection';
|
||||
sNewOne = 'New';
|
||||
sConnectionHints = 'Display name|Database type|Server name '+
|
||||
'(for "Generic OLEDB", use ADO-like connection string, and ignore other fields; '+
|
||||
'for SQLite3 or Jet, specify the full file name)|'+
|
||||
'Database name (unneeded for Oracle/SQLite3/Jet/ODBC)|User login|'+
|
||||
'User password (set ? for prompt)';
|
||||
sSelectOrCreateAConnection = 'Select a connection to be used, or\n'+
|
||||
'click on "New connection" to create one.';
|
||||
sPleaseWaitN = 'Connecting to %s...';
|
||||
sPleaseWaitSynLz = 'Decompressing %s...';
|
||||
sUpdateConnection = 'Update connection settings';
|
||||
sPassPromptN = 'Please enter password for %s@%s:';
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SynDBExplorerServer;
|
||||
|
||||
|
||||
{$ifndef HASINLINE}
|
||||
{$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
|
||||
{$endif}
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TDbExplorerMain.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
Tables.Free;
|
||||
Props.Free;
|
||||
if TempFileName<>'' then
|
||||
DeleteFile(TempFileName);
|
||||
end;
|
||||
|
||||
function Crypt(const s: RawUTF8): RawUTF8;
|
||||
var i: integer;
|
||||
begin // just not to be written in plain ascii in .config file
|
||||
SetLength(result,length(s));
|
||||
for i := 0 to length(s)-1 do
|
||||
PByteArray(result)[i] := PByteArray(s)[i] xor (i+137);
|
||||
end;
|
||||
|
||||
procedure TDbExplorerMain.FormCreate(Sender: TObject);
|
||||
var Conns: TSQLRestStorageInMemory;
|
||||
function TryConnect(C: TSQLConnection; LoadTableNames: boolean): boolean;
|
||||
const CONN_CLASSES: array[TExpConnectionType] of TSQLDBConnectionPropertiesClass =
|
||||
(TSQLDBOracleConnectionProperties,
|
||||
TOleDBOracleConnectionProperties,TOleDBMSOracleConnectionProperties,
|
||||
TOleDBMSSQLConnectionProperties,TOleDBConnectionProperties,
|
||||
TSQLDBSQLite3ConnectionProperties,
|
||||
{$ifdef WIN64}
|
||||
nil, // no JET/MSAccess available under Win64
|
||||
{$else}
|
||||
TOleDBJetConnectionProperties,
|
||||
{$endif}
|
||||
TODBCConnectionProperties,
|
||||
TSQLDBWinHTTPConnectionProperties,
|
||||
{$ifdef USEZEOS}TSQLDBZeosConnectionProperties{$else}nil{$endif}
|
||||
);
|
||||
var i: integer;
|
||||
Pass: RawUTF8;
|
||||
begin
|
||||
result := false;
|
||||
if CONN_CLASSES[C.Connection]=nil then begin
|
||||
{$ifndef USEZEOS}
|
||||
if C.Connection=ctZEOS then
|
||||
ShowMessage('USEZEOS conditional should be defined in SynDBExplorerMain.pas',
|
||||
'Zeos/ZDBC not available',true);
|
||||
{$endif}
|
||||
exit;
|
||||
end;
|
||||
try
|
||||
Pass := Crypt(C.Password);
|
||||
if Pass='?' then
|
||||
Pass := StringToUTF8(InputBox(Caption,format(sPassPromptN,
|
||||
[UTF8ToString(C.UserName),UTF8ToString(C.Server)]),'',true));
|
||||
if C.Connection=ctGenericOLEDB then begin
|
||||
Props := TOleDBConnectionProperties.Create('','','','');
|
||||
with TOleDBConnectionProperties(Props) do begin
|
||||
ConnectionString := UTF8ToWideString(C.Server);
|
||||
if LoadTableNames then begin
|
||||
ConnectionStringDialogExecute(Handle);
|
||||
C.Server := WideStringToUTF8(ConnectionString);
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
Props := CONN_CLASSES[C.Connection].Create(C.Server,C.Database,C.UserName,Pass);
|
||||
ConnectionName := UTF8ToString(C.Ident);
|
||||
with CreateTempForm(format(sPleaseWaitN,[ConnectionName]),nil,True) do
|
||||
try
|
||||
Connection := C.Connection;
|
||||
MainCaption := format('%s %s (compiled with %s) - %s',
|
||||
[MainCaption,SYNOPSE_FRAMEWORK_VERSION,GetDelphiCompilerVersion,ConnectionName]);
|
||||
if LoadTableNames or // retrieve all needed info from DB
|
||||
(C.Connection=ctRemoteHTTP) then begin
|
||||
Props.GetTableNames(C.fTableNames); // retrieve and set table names
|
||||
C.ForeignKeys := CompressString(Props.ForeignKeysData); // foreign keys
|
||||
if Conns<>nil then
|
||||
Conns.Modified := true;
|
||||
end else begin
|
||||
Props.ThreadSafeConnection.Connect;
|
||||
Props.ForeignKeysData := UncompressString(C.ForeignKeys);
|
||||
end;
|
||||
for i := 0 to High(C.TableNames) do
|
||||
Tables.Add(UTF8ToString(C.TableNames[i]));
|
||||
{$ifdef ISDELPHIXE}
|
||||
with TSQLDBSQLite3Connection(Props.ThreadSafeConnection) do
|
||||
if InheritsFrom(TSQLDBSQLite3Connection) then
|
||||
CreateRegExpFunction(DB.DB);
|
||||
{$endif}
|
||||
result := true;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
ShowMessage(E.Message,true);
|
||||
FreeAndNil(Props);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
var Btns: TCommonButtons;
|
||||
Task: TTaskDialog;
|
||||
C: TSQLConnection;
|
||||
CmdLine: TExpConnectionType;
|
||||
FN, msg, FN2: string;
|
||||
i, res: Integer;
|
||||
tmp: array[0..MAX_PATH] of char;
|
||||
begin
|
||||
Conns := nil;
|
||||
DefaultFont.Name := 'Tahoma';
|
||||
DefaultFont.Size := 9;
|
||||
Tables := TStringList.Create;
|
||||
C := nil;
|
||||
with TSQLConnection.RecordProps do begin
|
||||
AddFilterOrValidate('Ident',TSynFilterTrim.Create);
|
||||
AddFilterOrValidate('Ident',TSynValidateText.Create);
|
||||
//AddFilterOrValidate('Server',TSynValidateText.Create);
|
||||
end;
|
||||
MainCaption := Caption;
|
||||
if (ParamCount=1) and FileExists(paramstr(1)) then begin
|
||||
FN := paramstr(1);
|
||||
CmdLine := ctOracleDirectOCI;
|
||||
if IsJetFile(FN) then
|
||||
CmdLine := ctJet_mdbOLEDB else
|
||||
if IsSQLite3File(FN) then
|
||||
CmdLine := ctSqlite3 else
|
||||
if TSQLDataBase.IsBackupSynLZFile(FN) then begin
|
||||
FN2 := ExtractFileName(FN);
|
||||
SetString(TempFileName, tmp, GetTempPath(SizeOf(tmp), tmp));
|
||||
TempFileName := TempFileName+FN2+'.db';
|
||||
DeleteFile(TempFileName);
|
||||
with CreateTempForm(format(sPleaseWaitSynLz,[FN2]),nil,True) do
|
||||
try
|
||||
if TSQLDatabase.BackupUnSynLZ(FN, TempFileName) then begin
|
||||
CmdLine := ctSqlite3;
|
||||
FN := TempFileName;
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
if CmdLine=ctOracleDirectOCI then begin
|
||||
ShowMessage(FN+'?',True);
|
||||
exit;
|
||||
end;
|
||||
C := TSQLConnection.Create;
|
||||
try
|
||||
C.Connection := CmdLine;
|
||||
C.Ident := StringToUTF8(FN);
|
||||
C.Server := C.Ident;
|
||||
TryConnect(C,True);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end else begin
|
||||
Conns := TSQLRestStorageInMemory.Create(
|
||||
TSQLConnection,nil,ChangeFileExt(ExeVersion.ProgramFileName,'.config'),false);
|
||||
try
|
||||
Conns.ExpandedJSON := true; // for better human reading and modification
|
||||
Task.Title := MainCaption;
|
||||
Task.Inst := sSelectAConnection;
|
||||
Task.Content := sSelectOrCreateAConnection;
|
||||
if Conns.Count=0 then
|
||||
Btns := [cbCancel] else begin
|
||||
for i := 0 to Conns.Count-1 do
|
||||
Task.Selection := Task.Selection+UTF8ToString(TSQLConnection(Conns[i]).Ident)+#10;
|
||||
Btns := [cbOk,cbCancel];
|
||||
Task.Query := UTF8ToString(TSQLConnection(Conns[0]).Ident);
|
||||
Task.Verify := sUpdateConnection;
|
||||
end;
|
||||
Task.VerifyChecked := false;
|
||||
Task.Buttons := sNew;
|
||||
res := Task.Execute(Btns,0,[],tiQuestion);
|
||||
case res of
|
||||
mrOk:
|
||||
if Task.VerifyChecked then begin
|
||||
C := TSQLConnection(Conns[Task.SelectionRes]);
|
||||
msg := Task.Verify;
|
||||
end else
|
||||
TryConnect(TSQLConnection(Conns[Task.SelectionRes]),false);
|
||||
mrBtn1: begin
|
||||
C := TSQLConnection.Create;
|
||||
msg := sNew;
|
||||
end;
|
||||
end;
|
||||
if C<>nil then
|
||||
with TRecordEditForm.Create(self) do
|
||||
try
|
||||
C.Password := Crypt(C.Password);
|
||||
SetRecord(nil,C,nil,nil,sConnectionHints,0,msg);
|
||||
if ShowModal=mrOk then begin
|
||||
C.Password := Crypt(C.Password);
|
||||
if TryConnect(C,true) and (res=mrBtn1) then
|
||||
Conns.AddOne(C,false,'') else
|
||||
if res=mrBtn1 then
|
||||
FreeAndNil(C);
|
||||
end else
|
||||
if res=mrBtn1 then
|
||||
FreeAndNil(C);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
finally
|
||||
Conns.Free;
|
||||
end;
|
||||
end;
|
||||
Page := TSynPager.Create(self);
|
||||
Page.ControlStyle := Page.ControlStyle+[csClickEvents]; // enable OnDblClick
|
||||
Page.Parent := self;
|
||||
Page.Align := alClient;
|
||||
PageNew := TSynPage.Create(self);
|
||||
PageNew.Caption := sNewOne;
|
||||
PageNew.PageControl := Page;
|
||||
Page.OnChange := PageChange;
|
||||
Page.OnDblClick := PageDblClick;
|
||||
end;
|
||||
|
||||
procedure TDbExplorerMain.FormShow(Sender: TObject);
|
||||
begin
|
||||
if Props=nil then begin
|
||||
Close;
|
||||
exit;
|
||||
end;
|
||||
Caption := MainCaption;
|
||||
SetStyle(self);
|
||||
CreateFrame;
|
||||
end;
|
||||
|
||||
procedure TDbExplorerMain.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
case Key of
|
||||
ord('T'):
|
||||
if Shift=[ssCtrl] then
|
||||
CreateFrame;
|
||||
VK_F9:
|
||||
with Page.ActivePage do
|
||||
if TObject(Tag).InheritsFrom(TDBExplorerFrame) then
|
||||
with TDBExplorerFrame(Tag) do
|
||||
if Shift=[] then
|
||||
BtnExecClick(BtnExec) else
|
||||
if ssShift in Shift then
|
||||
BtnExecClick(BtnExecToTab);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
FrameID: integer;
|
||||
|
||||
function TDbExplorerMain.CreateFrame: TDBExplorerFrame;
|
||||
var P: TSynPage;
|
||||
begin
|
||||
P := TSynPage.Create(self);
|
||||
P.PageControl := Page;
|
||||
P.PageIndex := Page.PageCount-2;
|
||||
result := TDBExplorerFrame.Create(P);
|
||||
result.Parent := P;
|
||||
result.Align := alClient;
|
||||
result.Tables := Tables;
|
||||
result.Props := Props;
|
||||
result.EditTableChange(nil);
|
||||
inc(FrameID);
|
||||
result.Name := 'P'+IntToStr(FrameID);
|
||||
P.Tag := PtrInt(result);
|
||||
Page.ActivePage := P;
|
||||
result.EditTable.SetFocus;
|
||||
SetStyle(P);
|
||||
end;
|
||||
|
||||
procedure TDbExplorerMain.PageChange(Sender: TObject);
|
||||
begin
|
||||
if Page.ActivePage=PageNew then
|
||||
CreateFrame;
|
||||
end;
|
||||
|
||||
procedure TDbExplorerMain.PageDblClick(Sender: TObject);
|
||||
var n, i: Integer;
|
||||
begin
|
||||
i := Page.ActivePageIndex;
|
||||
n := Page.PageCount-2;
|
||||
if n>0 then begin
|
||||
Page.ActivePage.Free;
|
||||
if i=n then
|
||||
Page.ActivePageIndex := n-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,133 @@
|
||||
object DBQueryBuilderForm: TDBQueryBuilderForm
|
||||
Left = 1019
|
||||
Top = 265
|
||||
BorderStyle = bsSingle
|
||||
Caption = ' SynDB Explorer - Query Builder'
|
||||
ClientHeight = 374
|
||||
ClientWidth = 799
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poMainFormCenter
|
||||
DesignSize = (
|
||||
799
|
||||
374)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object GroupJoin: TGroupBox
|
||||
Left = 344
|
||||
Top = 8
|
||||
Width = 441
|
||||
Height = 201
|
||||
Caption = ' Select how Tables are JOINed '
|
||||
TabOrder = 0
|
||||
end
|
||||
object GroupFields: TGroupBox
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 329
|
||||
Height = 201
|
||||
Caption = ' Select Columns to be retrieved for each table '
|
||||
TabOrder = 1
|
||||
DesignSize = (
|
||||
329
|
||||
201)
|
||||
object FieldsTable: TListBox
|
||||
Left = 8
|
||||
Top = 16
|
||||
Width = 129
|
||||
Height = 177
|
||||
Anchors = [akLeft, akTop, akBottom]
|
||||
ItemHeight = 13
|
||||
TabOrder = 0
|
||||
OnClick = FieldsTableClick
|
||||
end
|
||||
object FieldsColumn: TCheckListBox
|
||||
Left = 144
|
||||
Top = 33
|
||||
Width = 177
|
||||
Height = 160
|
||||
Anchors = [akLeft, akTop, akBottom]
|
||||
ItemHeight = 13
|
||||
TabOrder = 1
|
||||
OnClick = FieldsColumnClick
|
||||
end
|
||||
object FieldsAll: TCheckBox
|
||||
Left = 144
|
||||
Top = 16
|
||||
Width = 97
|
||||
Height = 17
|
||||
Caption = 'all columns (*)'
|
||||
TabOrder = 2
|
||||
OnClick = FieldsAllClick
|
||||
end
|
||||
end
|
||||
object MemoSQL: TMemo
|
||||
Left = 8
|
||||
Top = 215
|
||||
Width = 777
|
||||
Height = 113
|
||||
Anchors = [akLeft, akBottom]
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Consolas'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
ScrollBars = ssHorizontal
|
||||
TabOrder = 2
|
||||
end
|
||||
object BtnUseSQL: TButton
|
||||
Left = 24
|
||||
Top = 335
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Use SQL'
|
||||
ModalResult = 1
|
||||
TabOrder = 3
|
||||
end
|
||||
object BtnCancel: TButton
|
||||
Left = 344
|
||||
Top = 335
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 4
|
||||
end
|
||||
object BtnExecSQL: TButton
|
||||
Left = 112
|
||||
Top = 335
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Exec SQL'
|
||||
ModalResult = 6
|
||||
TabOrder = 5
|
||||
end
|
||||
object BtnToObject: TButton
|
||||
Left = 232
|
||||
Top = 335
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'To Object'
|
||||
PopupMenu = BtnToObjectMenu
|
||||
TabOrder = 6
|
||||
OnClick = BtnToObjectClick
|
||||
end
|
||||
object BtnToObjectMenu: TPopupMenu
|
||||
Left = 312
|
||||
Top = 344
|
||||
object MenuToOneTSQLRecord: TMenuItem
|
||||
Caption = 'To one TSQLRecord per table'
|
||||
OnClick = MenuToOneTSQLRecordClick
|
||||
end
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,560 @@
|
||||
unit SynDBExplorerQueryBuilder;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Types,
|
||||
Graphics, Forms, Clipbrd,
|
||||
SynDB, SynCommons, SynTable, Menus;
|
||||
|
||||
type
|
||||
TDBQueryTable = object
|
||||
Name: string;
|
||||
NameWithoutSchema: RawUTF8;
|
||||
NameWithSchema: RawUTF8;
|
||||
Fields: TSQLDBColumnDefineDynArray;
|
||||
FieldsDefinition,
|
||||
FieldsAlias: TRawUTF8DynArray;
|
||||
SelectedAll: boolean;
|
||||
Selected: set of byte;
|
||||
function FieldAlias(FieldIndex: integer): RawUTF8;
|
||||
function FieldIndexMatch(const aTable: RawUTF8; const aField: TSQLDBColumnDefine): integer;
|
||||
function AsIniRow: RawUTF8;
|
||||
function AsTSQLRecordType(Props: TSQLDBConnectionProperties): RawUTF8;
|
||||
function FromIniSection(P: PUTF8Char): PUTF8Char;
|
||||
end;
|
||||
TDBQueryJoin = record
|
||||
SourceTable: integer;
|
||||
SourceField: integer;
|
||||
DestTable: integer;
|
||||
DestField: integer;
|
||||
end;
|
||||
TDBQueryTableDynArray = array of TDBQueryTable;
|
||||
TDBQueryJoinDynArray = array of TDBQueryJoin;
|
||||
TDBQueryObject = object
|
||||
Name: string;
|
||||
Tables: TDBQueryTableDynArray;
|
||||
JOIN: TDBQueryJoinDynArray;
|
||||
procedure InitJOIN(Size: integer);
|
||||
function ComputeSQLSelect: RawUTF8;
|
||||
function AsIniSection: string;
|
||||
function FromIniSection(P: PUTF8Char): Boolean; overload;
|
||||
function FromIniSection(const IniContent: RawUTF8): Boolean; overload;
|
||||
end;
|
||||
PDBQueryTable = ^TDBQueryTable;
|
||||
|
||||
TDBQueryBuilderForm = class(TForm)
|
||||
GroupJoin: TGroupBox;
|
||||
GroupFields: TGroupBox;
|
||||
MemoSQL: TMemo;
|
||||
FieldsTable: TListBox;
|
||||
FieldsColumn: TCheckListBox;
|
||||
FieldsAll: TCheckBox;
|
||||
BtnUseSQL: TButton;
|
||||
BtnCancel: TButton;
|
||||
BtnExecSQL: TButton;
|
||||
BtnToObject: TButton;
|
||||
BtnToObjectMenu: TPopupMenu;
|
||||
MenuToOneTSQLRecord: TMenuItem;
|
||||
procedure FieldsTableClick(Sender: TObject);
|
||||
procedure FieldsAllClick(Sender: TObject);
|
||||
procedure FieldsColumnClick(Sender: TObject);
|
||||
procedure BtnToObjectClick(Sender: TObject);
|
||||
procedure MenuToOneTSQLRecordClick(Sender: TObject);
|
||||
private
|
||||
fProps: TSQLDBConnectionProperties;
|
||||
fObject: TDBQueryObject;
|
||||
fJOINUI: array of record
|
||||
SourceTable: TComboBox;
|
||||
SourceField: TComboBox;
|
||||
DestTable: TComboBox;
|
||||
DestField: TComboBox;
|
||||
end;
|
||||
procedure JoinTableClick(Sender: TObject);
|
||||
procedure SetTableNames(const Value: TStrings);
|
||||
function FieldsTableCurrent: PDBQueryTable;
|
||||
procedure ComputeSQL(Sender: TObject);
|
||||
public
|
||||
class function BuildQuery(aTableNames: TStrings; aProps: TSQLDBConnectionProperties;
|
||||
out SQL: string): integer; overload;
|
||||
class function BuildQuery(aListBox: TListBox; aProps: TSQLDBConnectionProperties;
|
||||
out SQL: string): integer; overload;
|
||||
property Props: TSQLDBConnectionProperties read fProps write fProps;
|
||||
end;
|
||||
|
||||
resourcestring
|
||||
sMissingJOIN = 'Missing JOIN';
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
{ TDBQueryTable }
|
||||
|
||||
function TDBQueryTable.AsIniRow: RawUTF8;
|
||||
var f: integer;
|
||||
begin
|
||||
result := FormatUTF8('%,%,%,',[Name,length(Fields),SelectedAll]);
|
||||
for f := 0 to high(Fields) do
|
||||
with Fields[f] do
|
||||
result := FormatUTF8('%%,%,%,%,',
|
||||
[result,ColumnName,Ord(ColumnType),FieldAlias(f),f in Selected]);
|
||||
end;
|
||||
|
||||
function TDBQueryTable.AsTSQLRecordType(Props: TSQLDBConnectionProperties): RawUTF8;
|
||||
var f, RowIDIndex: integer;
|
||||
IdField: TSQLDBColumnCreate;
|
||||
def: RawUTF8;
|
||||
begin
|
||||
RowIDIndex := -1;
|
||||
for f := 0 to high(Fields) do
|
||||
with Fields[f] do begin
|
||||
if IsRowID(pointer(ColumnName)) then begin
|
||||
RowIDIndex := f;
|
||||
if (ColumnType=ftInt64) and IdemPropNameU(ColumnName,'ID') then
|
||||
def := FormatUTF8('% // warning: %.% column matches TSQLRecord.ID'#13#10'//',
|
||||
[def,NameWithoutSchema,FieldsDefinition[f]]) else
|
||||
def := FormatUTF8('% FATAL ERROR: %.% column overrides TSQLRecord.ID: integer'#13#10'//',
|
||||
[def,NameWithoutSchema,FieldsDefinition[f]]);
|
||||
end;
|
||||
def := FormatUTF8('% f%: %;'#13#10,
|
||||
[def,ColumnName,SQLDBFIELDTYPE_TO_DELPHITYPE[ColumnType]]);
|
||||
end;
|
||||
def := def+' published'#13#10;
|
||||
for f := 0 to high(Fields) do
|
||||
with Fields[f] do
|
||||
if IsRowID(pointer(ColumnName)) then
|
||||
def := FormatUTF8('% /// note: ignoring %.% matching TSQLRecord.ID'#13#10,
|
||||
[def,NameWithoutSchema,ColumnName]) else
|
||||
def := FormatUTF8('% /// match %.%'#13#10' %'#13#10,
|
||||
[def,NameWithoutSchema,FieldsDefinition[f],
|
||||
Props.GetFieldORMDefinition(Fields[f])]);
|
||||
result := FormatUTF8(' /// % Table'#13#10+
|
||||
' // - type definition auto-generated by SynDBExplorer '+
|
||||
SYNOPSE_FRAMEWORK_VERSION+' at %'#13#10' // from %'#13#10,
|
||||
[NameWithoutSchema,NowToString,NameWithSchema]);
|
||||
if RowIDIndex<0 then begin
|
||||
IdField.Name := 'ID';
|
||||
IdField.DBType := ftUnknown;
|
||||
IdField.PrimaryKey := true;
|
||||
result := FormatUTF8('% // - note that the ORM will add one missing ID field via:'#13#10+
|
||||
' // $ %'#13#10,[result,Props.SQLAddColumn(NameWithSchema,IdField)]);
|
||||
end;
|
||||
result := FormatUTF8('% TSQL% = class(TSQLRecord)'#13#10' protected'#13#10'% end;',
|
||||
[result,NameWithoutSchema,def]);
|
||||
end;
|
||||
|
||||
function TDBQueryTable.FieldAlias(FieldIndex: integer): RawUTF8;
|
||||
begin
|
||||
if Cardinal(FieldIndex)>=cardinal(length(FieldsAlias)) then
|
||||
result := '' else
|
||||
result := FieldsAlias[FieldIndex];
|
||||
end;
|
||||
|
||||
function TDBQueryTable.FieldIndexMatch(const aTable: RawUTF8;
|
||||
const aField: TSQLDBColumnDefine): integer;
|
||||
begin
|
||||
for result := 0 to High(Fields) do
|
||||
with Fields[result] do
|
||||
if (aField.ColumnType=ColumnType) then
|
||||
if IsRowID(pointer(ColumnName)) then begin
|
||||
if IdemPropNameU(aField.ColumnName,aTable) then
|
||||
exit; // Toto.Tata=Tata.ID (e.g. for SQLite3 tables)
|
||||
end else
|
||||
if IdemPropNameU(aField.ColumnName,ColumnName) then
|
||||
exit; // Toto.ID_TRN=Tata.ID_TRN (most common RDRMS layouts)
|
||||
result := -1;
|
||||
end;
|
||||
|
||||
function TDBQueryTable.FromIniSection(P: PUTF8Char): PUTF8Char;
|
||||
var i: integer;
|
||||
begin
|
||||
result := P;
|
||||
Name := Ansi7ToString(GetNextItem(result));
|
||||
SetLength(Fields,GetNextItemCardinal(result));
|
||||
SelectedAll := GetNextItemCardinal(result)=1;
|
||||
if result=nil then exit;
|
||||
Selected := [];
|
||||
SetLength(FieldsAlias,length(Fields));
|
||||
for i := 0 to high(Fields) do
|
||||
with Fields[i] do begin
|
||||
ColumnName := GetNextItem(result);
|
||||
ColumnType := TSQLDBFieldType(GetNextItemCardinal(result));
|
||||
FieldsAlias[i] := GetNextItem(result);
|
||||
if GetNextItemCardinal(result)=1 then
|
||||
include(Selected,i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBQueryObject }
|
||||
|
||||
function TDBQueryObject.AsIniSection: string;
|
||||
var ini: RawUTF8;
|
||||
t: integer;
|
||||
begin
|
||||
ini := FormatUTF8('[%]'#13#10'TableCount=%'#13#10,
|
||||
[Name,length(Tables)]);
|
||||
for t := 0 to high(Tables) do
|
||||
ini := FormatUTF8('%Table%=%'#13#10,[ini,t,Tables[t].AsIniRow]);
|
||||
for t := 0 to high(JOIN) do
|
||||
with JOIN[t] do
|
||||
ini := FormatUTF8('%Join%=%,%,%,%'#13#10,
|
||||
[ini,t,SourceTable,SourceField,DestTable,DestField]);
|
||||
result := UTF8ToString(ini);
|
||||
end;
|
||||
|
||||
function TDBQueryObject.ComputeSQLSelect: RawUTF8;
|
||||
var select: RawUTF8;
|
||||
t,f: integer;
|
||||
begin
|
||||
result := '';
|
||||
for t := 0 to high(Tables) do
|
||||
with Tables[t] do begin
|
||||
if SelectedAll then
|
||||
select := NameWithoutSchema+'.*' else begin
|
||||
select := '';
|
||||
for f := 0 to High(Fields) do
|
||||
if f in Selected then begin
|
||||
if select<>'' then
|
||||
select := select+',';
|
||||
select := select+NameWithoutSchema+'.'+Fields[f].ColumnName;
|
||||
if (FieldsAlias<>nil) and (FieldsAlias[f]<>'') then
|
||||
select := select+' '+FieldsAlias[f];
|
||||
end;
|
||||
end;
|
||||
if select<>'' then begin
|
||||
if (result<>'') and (result[length(result)]<>',') then
|
||||
result := result+',';
|
||||
result := result+' '+select;
|
||||
end;
|
||||
end;
|
||||
if result<>'' then begin // need at least one field retrieved
|
||||
result := 'select'#13#10' '+result+#13#10'from'#13#10' ';
|
||||
for t := 0 to high(Tables) do
|
||||
with Tables[t] do begin
|
||||
if t>0 then
|
||||
result := result+', ';
|
||||
result := result+NameWithSchema;
|
||||
if NameWithSchema<>NameWithoutSchema then
|
||||
result := result+' '+NameWithoutSchema;
|
||||
end;
|
||||
select := '';
|
||||
for t := 0 to high(JOIN) do
|
||||
with JOIN[t] do
|
||||
if (SourceField<0) or (SourceTable<0) or
|
||||
(DestField<0) or (DestTable<0) then begin
|
||||
result := StringToUTF8(sMissingJOIN);
|
||||
exit;
|
||||
end else begin
|
||||
if select<>'' then
|
||||
select := select+' and ' else
|
||||
select := #13#10'where'#13#10' ';
|
||||
select := select+Tables[SourceTable].NameWithoutSchema+'.'+
|
||||
Tables[SourceTable].Fields[SourceField].ColumnName+'=';
|
||||
select := select+Tables[DestTable].NameWithoutSchema+'.'+
|
||||
Tables[DestTable].Fields[DestField].ColumnName;
|
||||
end;
|
||||
result := result+select;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDBQueryObject.FromIniSection(P: PUTF8Char): Boolean;
|
||||
var t: integer;
|
||||
begin
|
||||
result := false;
|
||||
if P=nil then exit;
|
||||
while P^=' ' do inc(P);
|
||||
if P^<>'[' then exit;
|
||||
inc(P);
|
||||
Name := Ansi7ToString(GetNextItem(P,']'));
|
||||
inc(P); while P^<=' ' do if P^=#0 then exit else inc(P);
|
||||
if not IdemPChar(P,'TABLECOUNT=') then exit else inc(P,11);
|
||||
SetLength(Tables,GetNextItemCardinal(P,#13));
|
||||
if P=nil then exit;
|
||||
for t := 0 to high(Tables) do begin
|
||||
while P^<=' ' do if P^=#0 then exit else inc(P);
|
||||
if not IdemPChar(P,'TABLE') then
|
||||
exit else begin
|
||||
inc(P,5);
|
||||
if (GetNextItemCardinal(P,'=')<>cardinal(t)) or (P=nil) then exit;
|
||||
P := Tables[t].FromIniSection(P);
|
||||
if P=nil then exit;
|
||||
end;
|
||||
end;
|
||||
SetLength(JOIN,length(Tables)-1);
|
||||
for t := 0 to high(JOIN) do begin
|
||||
if P=nil then exit;
|
||||
while P^<=' ' do if P^=#0 then exit else inc(P);
|
||||
if not IdemPChar(P,'JOIN') then
|
||||
exit else begin
|
||||
inc(P,4);
|
||||
if (GetNextItemCardinal(P,'=')<>cardinal(t)) or (P=nil) then exit;
|
||||
with JOIN[t] do begin
|
||||
SourceTable := GetNextItemCardinal(P);
|
||||
SourceField := GetNextItemCardinal(P);
|
||||
DestTable := GetNextItemCardinal(P);
|
||||
DestField := GetNextItemCardinal(P,#13);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
result := True;
|
||||
end;
|
||||
|
||||
function TDBQueryObject.FromIniSection(const IniContent: RawUTF8): Boolean;
|
||||
var P: PUTF8Char;
|
||||
begin
|
||||
P := pointer(IniContent);
|
||||
result := FromIniSection(P);
|
||||
end;
|
||||
|
||||
procedure TDBQueryObject.InitJOIN(Size: integer);
|
||||
begin
|
||||
SetLength(JOIN,Size);
|
||||
fillchar(JOIN[0],Size*sizeof(JOIN[0]),255); // fill all to -1
|
||||
end;
|
||||
|
||||
|
||||
{ TDBQueryBuilderForm }
|
||||
|
||||
class function TDBQueryBuilderForm.BuildQuery(aTableNames: TStrings;
|
||||
aProps: TSQLDBConnectionProperties; out SQL: string): integer;
|
||||
begin
|
||||
result := mrCancel;
|
||||
if (aProps<>nil) and (aTableNames<>nil) then
|
||||
with TDBQueryBuilderForm.Create(Application) do
|
||||
try
|
||||
Props := aProps;
|
||||
SetTableNames(aTableNames);
|
||||
result := ShowModal;
|
||||
case result of
|
||||
mrOk,mrYes:
|
||||
SQL := MemoSQL.Text;
|
||||
mrRetry:
|
||||
SQL := fObject.AsIniSection;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDBQueryBuilderForm.BuildQuery(aListBox: TListBox;
|
||||
aProps: TSQLDBConnectionProperties; out SQL: string): integer;
|
||||
var T: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
result := mrCancel;
|
||||
if (aListBox=nil) or (aListBox.SelCount=0) then
|
||||
exit;
|
||||
T := TStringList.Create;
|
||||
try
|
||||
for i := 0 to aListBox.Count-1 do
|
||||
if aListBox.Selected[i] then
|
||||
T.Add(aListBox.Items[i]);
|
||||
result := BuildQuery(T,aProps,SQL);
|
||||
finally
|
||||
T.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.SetTableNames(const Value: TStrings);
|
||||
var t,j,f,k,Y: Integer;
|
||||
function CreateCombo(X: integer; Table: integer=-1): TComboBox;
|
||||
var k: Integer;
|
||||
begin
|
||||
result := TComboBox.Create(self);
|
||||
result.Parent := GroupJoin;
|
||||
result.SetBounds(X,Y,100,20);
|
||||
result.Style := csDropDownList;
|
||||
result.Font.Size := 7;
|
||||
if Table>=0 then begin
|
||||
for k := 0 to High(fObject.Tables) do
|
||||
result.Items.Add(Ansi7ToString(fObject.Tables[k].NameWithoutSchema));
|
||||
result.OnClick := JoinTableClick;
|
||||
end else
|
||||
result.OnClick := ComputeSQL;
|
||||
end;
|
||||
begin
|
||||
FieldsTable.Clear;
|
||||
Screen.Cursor := crHourGlass;
|
||||
try
|
||||
// fill fObject.Tables[]
|
||||
SetLength(fObject.Tables,Value.Count);
|
||||
for t := 0 to high(fObject.Tables) do
|
||||
with fObject.Tables[t] do begin
|
||||
Name := Value[t];
|
||||
NameWithoutSchema := StringToAnsi7(Name);
|
||||
Props.GetFields(NameWithoutSchema,Fields);
|
||||
NameWithSchema := Props.SQLTableName(NameWithoutSchema);
|
||||
NameWithoutSchema := TrimLeftSchema(NameWithoutSchema);
|
||||
SetLength(FieldsDefinition,length(Fields));
|
||||
for f := 0 to high(Fields) do
|
||||
FieldsDefinition[f] := Props.GetFieldDefinition(Fields[f]);
|
||||
FieldsTable.Items.Add(Name);
|
||||
end;
|
||||
// create JOIN controls on form
|
||||
SetLength(fJOINUI,length(fObject.Tables)-1);
|
||||
Y := 20;
|
||||
for t := 0 to high(fJOINUI) do
|
||||
with fJOINUI[t] do begin
|
||||
SourceTable := CreateCombo(8,t);
|
||||
SourceField := CreateCombo(112);
|
||||
SourceTable.Tag := PtrInt(SourceField);
|
||||
JoinTableClick(SourceTable);
|
||||
DestTable := CreateCombo(224,t+1);
|
||||
DestField := CreateCombo(328);
|
||||
DestTable.Tag := PtrInt(DestField);
|
||||
JoinTableClick(DestTable);
|
||||
with TLabel.Create(self) do begin
|
||||
Parent := GroupJoin;
|
||||
SetBounds(214,Y+3,8,20);
|
||||
Font.Style := [fsBold];
|
||||
Caption := '=';
|
||||
end;
|
||||
inc(Y,24);
|
||||
end;
|
||||
inc(Y,8);
|
||||
if Y>GroupJoin.ClientHeight then begin
|
||||
ClientHeight := ClientHeight+Y-GroupJoin.ClientHeight;
|
||||
GroupJoin.ClientHeight := Y;
|
||||
GroupFields.ClientHeight := Y;
|
||||
end;
|
||||
// guess column JOIN criteria
|
||||
fObject.InitJOIN(length(fJOINUI));
|
||||
for t := 0 to high(fJOINUI) do
|
||||
with fObject.JOIN[t], fObject.Tables[t] do begin
|
||||
for f := 0 to high(Fields) do begin
|
||||
for j := 0 to high(fObject.Tables) do
|
||||
if j<>t then begin
|
||||
k := fObject.Tables[j].FieldIndexMatch(NameWithoutSchema,Fields[f]);
|
||||
if k>=0 then begin // get first matching field (name+type) in tables
|
||||
SourceTable := t;
|
||||
SourceField := f;
|
||||
DestTable := j;
|
||||
DestField := k;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
if DestTable>=0 then
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
// refresh UI
|
||||
for f := 0 to high(fJOINUI) do
|
||||
with fJOINUI[f] do begin
|
||||
SourceTable.ItemIndex := fObject.JOIN[f].SourceTable;
|
||||
JoinTableClick(SourceTable);
|
||||
SourceField.ItemIndex := fObject.JOIN[f].SourceField;
|
||||
DestTable.ItemIndex := fObject.JOIN[f].DestTable;
|
||||
JoinTableClick(DestTable);
|
||||
DestField.ItemIndex := fObject.JOIN[f].DestField;
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
if Value.Count>0 then begin
|
||||
FieldsTable.ItemIndex := 0;
|
||||
FieldsTableClick(nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.FieldsTableClick(Sender: TObject);
|
||||
var i: integer;
|
||||
T: PDBQueryTable;
|
||||
begin
|
||||
FieldsColumn.Clear;
|
||||
T := FieldsTableCurrent;
|
||||
if T=nil then
|
||||
exit;
|
||||
for i := 0 to High(T^.FieldsDefinition) do
|
||||
FieldsColumn.Items.Add(Ansi7ToString(T^.FieldsDefinition[i]));
|
||||
FieldsAll.Checked := T^.SelectedAll;
|
||||
FieldsAllClick(nil);
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.FieldsAllClick(Sender: TObject);
|
||||
var T: PDBQueryTable;
|
||||
i: integer;
|
||||
begin
|
||||
FieldsColumn.Enabled := not FieldsAll.Checked;
|
||||
T := FieldsTableCurrent;
|
||||
if T=nil then
|
||||
exit;
|
||||
T^.SelectedAll := FieldsAll.Checked;
|
||||
for i := 0 to High(T^.Fields) do
|
||||
FieldsColumn.Checked[i] := i in T^.Selected;
|
||||
ComputeSQL(nil);
|
||||
end;
|
||||
|
||||
function TDBQueryBuilderForm.FieldsTableCurrent: PDBQueryTable;
|
||||
var i: cardinal;
|
||||
begin
|
||||
i := FieldsTable.ItemIndex;
|
||||
if i<cardinal(length(fObject.Tables)) then
|
||||
result := @fObject.Tables[i] else
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.FieldsColumnClick(Sender: TObject);
|
||||
var T: PDBQueryTable;
|
||||
i: integer;
|
||||
begin
|
||||
T := FieldsTableCurrent;
|
||||
if T=nil then
|
||||
exit;
|
||||
FillChar(T^.Selected,sizeof(T^.Selected),0);
|
||||
for i := 0 to High(T^.Fields) do
|
||||
if FieldsColumn.Checked[i] then
|
||||
Include(T^.Selected,i);
|
||||
ComputeSQL(nil);
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.ComputeSQL(Sender: TObject);
|
||||
var f: integer;
|
||||
begin
|
||||
for f := 0 to high(fJOINUI) do
|
||||
with fJOINUI[f] do begin
|
||||
fObject.JOIN[f].SourceTable := SourceTable.ItemIndex;
|
||||
fObject.JOIN[f].SourceField := SourceField.ItemIndex;
|
||||
fObject.JOIN[f].DestTable := DestTable.ItemIndex;
|
||||
fObject.JOIN[f].DestField := DestField.ItemIndex;
|
||||
end;
|
||||
MemoSQL.Text := Ansi7ToString(fObject.ComputeSQLSelect);
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.JoinTableClick(Sender: TObject);
|
||||
var Table, Field: TComboBox;
|
||||
t,f: integer;
|
||||
begin
|
||||
Table := Sender as TComboBox;
|
||||
Field := TComboBox(Table.Tag);
|
||||
Field.Items.Clear;
|
||||
t := Table.ItemIndex;
|
||||
if t>=0 then
|
||||
with fObject.Tables[t] do
|
||||
for f := 0 to high(Fields) do
|
||||
Field.Items.Add(Ansi7ToString(Fields[f].ColumnName));
|
||||
end;
|
||||
|
||||
|
||||
procedure TDBQueryBuilderForm.BtnToObjectClick(Sender: TObject);
|
||||
begin
|
||||
with ClientToScreen(Point(BtnToObject.Left,BtnToObject.Top+BtnToObject.Height)) do
|
||||
BtnToObjectMenu.Popup(X,Y);
|
||||
end;
|
||||
|
||||
procedure TDBQueryBuilderForm.MenuToOneTSQLRecordClick(Sender: TObject);
|
||||
var s: RawUTF8;
|
||||
txt: string;
|
||||
i: integer;
|
||||
begin
|
||||
s := 'type'#13#10;
|
||||
for i := 0 to high(fObject.Tables) do
|
||||
s := s+fObject.Tables[i].AsTSQLRecordType(Props)+#13#10#13#10;
|
||||
txt := UTF8ToString(s);
|
||||
MemoSQL.Text := txt;
|
||||
Clipboard.AsText := txt;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,85 @@
|
||||
object HTTPServerForm: THTTPServerForm
|
||||
Left = 148
|
||||
Top = 129
|
||||
BorderStyle = bsDialog
|
||||
Caption = ' SynDBExplorer HTTP Server'
|
||||
ClientHeight = 165
|
||||
ClientWidth = 346
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnDestroy = FormDestroy
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object lbledtPort: TLabeledEdit
|
||||
Left = 40
|
||||
Top = 32
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 48
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'HTTP Port'
|
||||
TabOrder = 0
|
||||
Text = '8092'
|
||||
OnKeyPress = lbledtPortKeyPress
|
||||
end
|
||||
object lbledtDatabase: TLabeledEdit
|
||||
Left = 176
|
||||
Top = 32
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 75
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Database name'
|
||||
TabOrder = 1
|
||||
Text = 'syndbremote'
|
||||
OnKeyPress = lbledtDatabaseKeyPress
|
||||
end
|
||||
object lbledtUser: TLabeledEdit
|
||||
Left = 40
|
||||
Top = 72
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 52
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'User Name'
|
||||
TabOrder = 2
|
||||
Text = 'synopse'
|
||||
OnKeyPress = lbledtDatabaseKeyPress
|
||||
end
|
||||
object lbledtPassword: TLabeledEdit
|
||||
Left = 176
|
||||
Top = 72
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 46
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Password'
|
||||
TabOrder = 3
|
||||
Text = 'synopse'
|
||||
OnKeyPress = lbledtDatabaseKeyPress
|
||||
end
|
||||
object btnConnect: TButton
|
||||
Left = 72
|
||||
Top = 120
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Start'
|
||||
TabOrder = 4
|
||||
OnClick = btnConnectClick
|
||||
end
|
||||
object btnDisconnect: TButton
|
||||
Left = 160
|
||||
Top = 120
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Stop'
|
||||
Enabled = False
|
||||
TabOrder = 5
|
||||
OnClick = btnDisconnectClick
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,82 @@
|
||||
unit SynDBExplorerServer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ExtCtrls, SynCommons, SynDB, SynDBRemote;
|
||||
|
||||
type
|
||||
THTTPServerForm = class(TForm)
|
||||
lbledtPort: TLabeledEdit;
|
||||
lbledtDatabase: TLabeledEdit;
|
||||
lbledtUser: TLabeledEdit;
|
||||
lbledtPassword: TLabeledEdit;
|
||||
btnConnect: TButton;
|
||||
btnDisconnect: TButton;
|
||||
procedure lbledtPortKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure lbledtDatabaseKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure btnConnectClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure btnDisconnectClick(Sender: TObject);
|
||||
private
|
||||
public
|
||||
Props: TSQLDBConnectionProperties;
|
||||
Server: TSQLDBServerHttpApi;
|
||||
end;
|
||||
|
||||
var
|
||||
HTTPServerForm: THTTPServerForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
mORMotUILogin; // for ShowMessage()
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure THTTPServerForm.lbledtPortKeyPress(Sender: TObject;
|
||||
var Key: Char);
|
||||
begin
|
||||
if not (AnsiChar(Key) in ['0'..'9']) then
|
||||
Key := #0
|
||||
end;
|
||||
|
||||
procedure THTTPServerForm.lbledtDatabaseKeyPress(Sender: TObject;
|
||||
var Key: Char);
|
||||
begin
|
||||
if not (AnsiChar(Key) in ['A'..'Z','a'..'z','_']) then
|
||||
Key := #0
|
||||
end;
|
||||
|
||||
procedure THTTPServerForm.btnConnectClick(Sender: TObject);
|
||||
begin
|
||||
if (Server<>nil) or (Props=nil) then
|
||||
exit;
|
||||
try
|
||||
Server := TSQLDBServerHttpApi.Create(Props,StringToUTF8(lbledtDatabase.Text),
|
||||
StringToUTF8(lbledtPort.Text),StringToUTF8(lbledtUser.Text),
|
||||
StringToUTF8(lbledtPassword.Text));
|
||||
except
|
||||
on E: Exception do
|
||||
ShowMessage(E.ClassName,E.Message,true);
|
||||
end;
|
||||
btnConnect.Enabled := false;
|
||||
btnDisconnect.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure THTTPServerForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(Server);
|
||||
end;
|
||||
|
||||
procedure THTTPServerForm.btnDisconnectClick(Sender: TObject);
|
||||
begin
|
||||
if Server<>nil then
|
||||
FreeAndNil(Server);
|
||||
Props := nil;
|
||||
btnDisconnect.Enabled := false;
|
||||
btnConnect.Enabled := true;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user