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=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.