mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-16 08:15:53 +01:00
a57cc3581f
- New! `TMVCActiveRecord.DeleteRQL` deletes records using an `RQL` expression as `where` clause. - New! Microsoft SQLServer Support in ActiveRecord and RQL (thanks to one of the biggest Delphi based company in Italy which heavily uses DMVCFramework) - Improved! `ActiveRecordShowCase` sample is much better now.
406 lines
12 KiB
ObjectPascal
406 lines
12 KiB
ObjectPascal
unit MainFormU;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows,
|
|
Winapi.Messages,
|
|
System.SysUtils,
|
|
System.Variants,
|
|
System.Classes,
|
|
Vcl.Graphics,
|
|
Vcl.Controls,
|
|
Vcl.Forms,
|
|
Vcl.Dialogs,
|
|
FireDAC.Stan.Intf,
|
|
FireDAC.Stan.Option,
|
|
FireDAC.Stan.Error,
|
|
FireDAC.UI.Intf,
|
|
FireDAC.Phys.Intf,
|
|
FireDAC.Stan.Def,
|
|
FireDAC.Stan.Pool,
|
|
FireDAC.Stan.Async,
|
|
FireDAC.Phys,
|
|
FireDAC.Stan.Param,
|
|
FireDAC.DatS,
|
|
FireDAC.DApt.Intf,
|
|
FireDAC.DApt,
|
|
FireDAC.VCLUI.Wait,
|
|
FireDAC.Comp.UI,
|
|
FireDAC.Phys.IBBase,
|
|
FireDAC.Phys.FB,
|
|
Data.DB,
|
|
FireDAC.Comp.DataSet,
|
|
FireDAC.Comp.Client,
|
|
Vcl.StdCtrls,
|
|
Vcl.ExtCtrls,
|
|
FireDAC.Phys.ODBCBase,
|
|
FireDAC.Phys.MSSQL,
|
|
FireDAC.Phys.MSSQLDef,
|
|
FireDAC.Phys.FBDef,
|
|
Vcl.ComCtrls,
|
|
Vcl.Grids,
|
|
Vcl.ValEdit,
|
|
FireDAC.Phys.MySQLDef,
|
|
FireDAC.Phys.MySQL, FireDAC.Phys.PGDef, FireDAC.Phys.PG, FireDAC.Phys.IBDef,
|
|
FireDAC.Phys.IB, FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteDef,
|
|
FireDAC.Phys.SQLite;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
FDConnection1: TFDConnection;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
qry: TFDQuery;
|
|
FDPhysFBDriverLink1: TFDPhysFBDriverLink;
|
|
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
|
|
Splitter1: TSplitter;
|
|
mmConnectionParams: TMemo;
|
|
Label2: TLabel;
|
|
FDPhysMSSQLDriverLink1: TFDPhysMSSQLDriverLink;
|
|
cboConnectionDefs: TComboBox;
|
|
Panel3: TPanel;
|
|
Panel4: TPanel;
|
|
btnGenEntities: TButton;
|
|
PageControl1: TPageControl;
|
|
TabSheet1: TTabSheet;
|
|
TabSheet2: TTabSheet;
|
|
btnGetTables: TButton;
|
|
veTablesMapping: TValueListEditor;
|
|
mmOutput: TMemo;
|
|
Panel5: TPanel;
|
|
btnSaveCode: TButton;
|
|
FileSaveDialog1: TFileSaveDialog;
|
|
FDPhysMySQLDriverLink1: TFDPhysMySQLDriverLink;
|
|
FDPhysPgDriverLink1: TFDPhysPgDriverLink;
|
|
FDPhysFBDriverLink2: TFDPhysFBDriverLink;
|
|
FDPhysIBDriverLink1: TFDPhysIBDriverLink;
|
|
FDPhysMySQLDriverLink2: TFDPhysMySQLDriverLink;
|
|
FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink;
|
|
procedure btnGenEntitiesClick(Sender: TObject);
|
|
procedure btnGetTablesClick(Sender: TObject);
|
|
procedure btnSaveCodeClick(Sender: TObject);
|
|
procedure cboConnectionDefsChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
private
|
|
fIntfBuff, fImplBuff: TStringStream;
|
|
FHistoryFileName: string;
|
|
lTypesName: TArray<string>;
|
|
procedure EmitHeaderComments;
|
|
function GetClassName(const aTableName: string): string;
|
|
procedure EmitUnit;
|
|
procedure EmitUnitEnd;
|
|
procedure EmitProperty(F: TField);
|
|
procedure EmitField(F: TField);
|
|
procedure EmitClass(const aTableName, aClassName: string);
|
|
procedure EmitClassEnd;
|
|
function GetDelphiType(FT: TFieldType): string;
|
|
function GetFieldName(const Value: string): string;
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{Spring.SystemUtils,} System.IOUtils;
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
procedure TMainForm.btnGenEntitiesClick(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
lTableName: string;
|
|
lClassName: string;
|
|
F: Integer;
|
|
lFieldsName: TArray<string>;
|
|
begin
|
|
fIntfBuff.Clear;
|
|
EmitHeaderComments;
|
|
EmitUnit;
|
|
for I := 1 to veTablesMapping.RowCount - 1 do
|
|
begin
|
|
lTableName := veTablesMapping.Cells[0, I];
|
|
lClassName := veTablesMapping.Cells[1, I];
|
|
EmitClass(lTableName, lClassName);
|
|
qry.Open('select * from ' + lTableName + ' where 1=0');
|
|
|
|
lFieldsName := [];
|
|
lTypesName := [];
|
|
fIntfBuff.WriteString('private' + sLineBreak);
|
|
for F := 0 to qry.Fields.Count - 1 do
|
|
begin
|
|
EmitField(qry.Fields[F]);
|
|
|
|
if GetDelphiType(qry.Fields[F].DataType) = 'TStream' then
|
|
begin
|
|
lFieldsName := lFieldsName + [GetFieldName(qry.Fields[F].FieldName)];
|
|
lTypesName := lTypesName + ['TMemoryStream'];
|
|
end;
|
|
|
|
end;
|
|
|
|
fIntfBuff.WriteString('public' + sLineBreak);
|
|
fIntfBuff.WriteString(' constructor Create; override;' + sLineBreak);
|
|
|
|
fImplBuff.WriteString('constructor ' + lClassName + '.Create;' + sLineBreak);
|
|
fImplBuff.WriteString('begin' + sLineBreak);
|
|
fImplBuff.WriteString(' inherited Create;' + sLineBreak);
|
|
for F := low(lFieldsName) to high(lFieldsName) do
|
|
begin
|
|
fImplBuff.WriteString(' ' + lFieldsName[F] + ' := ' + lTypesName[F] + '.Create;' + sLineBreak);
|
|
end;
|
|
fImplBuff.WriteString('end;' + sLineBreak + sLineBreak);
|
|
|
|
fIntfBuff.WriteString(' destructor Destroy; override;' + sLineBreak);
|
|
fImplBuff.WriteString('destructor ' + lClassName + '.Destroy;' + sLineBreak);
|
|
fImplBuff.WriteString('begin' + sLineBreak);
|
|
for F := low(lFieldsName) to high(lFieldsName) do
|
|
begin
|
|
fImplBuff.WriteString(' ' + lFieldsName[F] + '.Free;' + sLineBreak);
|
|
end;
|
|
fImplBuff.WriteString(' inherited;' + sLineBreak);
|
|
fImplBuff.WriteString('end;' + sLineBreak + sLineBreak);
|
|
|
|
for F := 0 to qry.Fields.Count - 1 do
|
|
begin
|
|
EmitProperty(qry.Fields[F]);
|
|
end;
|
|
|
|
EmitClassEnd;
|
|
end;
|
|
EmitUnitEnd;
|
|
mmOutput.Lines.Text := fIntfBuff.DataString + fImplBuff.DataString;
|
|
|
|
// mmOutput.Lines.SaveToFile(
|
|
// mmConnectionParams.Lines.SaveToFile(FHistoryFileName);
|
|
end;
|
|
|
|
procedure TMainForm.btnGetTablesClick(Sender: TObject);
|
|
var
|
|
lTables: TStringList;
|
|
lTable: string;
|
|
lClassName: string;
|
|
begin
|
|
FDConnection1.Close;
|
|
FDConnection1.Params.Assign(mmConnectionParams.Lines);
|
|
FDConnection1.Connected := True;
|
|
|
|
lTables := TStringList.Create;
|
|
try
|
|
FDConnection1.GetTableNames('', 'public', '', lTables);
|
|
veTablesMapping.Row := 1;
|
|
for lTable in lTables do
|
|
begin
|
|
lClassName := GetClassName(lTable);
|
|
veTablesMapping.InsertRow(lTable, lClassName, True);
|
|
end;
|
|
finally
|
|
lTables.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TMainForm.btnSaveCodeClick(Sender: TObject);
|
|
begin
|
|
FileSaveDialog1.FileName := 'EntitiesU.pas';
|
|
if FileSaveDialog1.Execute then
|
|
begin
|
|
mmOutput.Lines.SaveToFile(FileSaveDialog1.FileName);
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.cboConnectionDefsChange(Sender: TObject);
|
|
begin
|
|
FDManager.GetConnectionDefParams(cboConnectionDefs.Text, mmConnectionParams.Lines);
|
|
// cbSchema.Items.Clear;
|
|
// FDConnection1.GetSchemaNames('', '', cbSchema.Items);
|
|
end;
|
|
|
|
procedure TMainForm.EmitClass(const aTableName, aClassName: string);
|
|
begin
|
|
fIntfBuff.WriteString('[MVCNameCase(ncLowerCase)]' + sLineBreak);
|
|
fIntfBuff.WriteString(Format('[MVCTable(''%s'')]', [aTableName]) + sLineBreak);
|
|
if trim(aClassName) = '' then
|
|
raise Exception.Create('Invalid class name');
|
|
fIntfBuff.WriteString(aClassName + ' = class(TMVCActiveRecord)' + sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitClassEnd;
|
|
begin
|
|
fIntfBuff.WriteString('end;' + sLineBreak + sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitField(F: TField);
|
|
begin
|
|
fIntfBuff.WriteString(Format(' [MVCTableField(''%s'')]', [F.FieldName]) + sLineBreak + ' ' + GetFieldName(F.FieldName) + ': ' +
|
|
GetDelphiType(F.DataType) + ';' + sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitHeaderComments;
|
|
begin
|
|
fIntfBuff.WriteString('// *************************************************************************** }' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// Delphi MVC Framework' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// https://github.com/danieleteti/delphimvcframework' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// Licensed under the Apache License, Version 2.0 (the "License");' + sLineBreak);
|
|
fIntfBuff.WriteString('// you may not use this file except in compliance with the License.' + sLineBreak);
|
|
fIntfBuff.WriteString('// You may obtain a copy of the License at' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// http://www.apache.org/licenses/LICENSE-2.0' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// Unless required by applicable law or agreed to in writing, software' + sLineBreak);
|
|
fIntfBuff.WriteString('// distributed under the License is distributed on an "AS IS" BASIS,' + sLineBreak);
|
|
fIntfBuff.WriteString('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.' + sLineBreak);
|
|
fIntfBuff.WriteString('// See the License for the specific language governing permissions and' + sLineBreak);
|
|
fIntfBuff.WriteString('// limitations under the License.' + sLineBreak);
|
|
fIntfBuff.WriteString('//' + sLineBreak);
|
|
fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak);
|
|
fIntfBuff.WriteString(sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitProperty(F: TField);
|
|
begin
|
|
// Buff.WriteString(Format(' [TableField(''%s'')]', [F.FieldName]) + sLineBreak + ' property ' + GetProperCase(F.FieldName) + ': ' +
|
|
// GetDelphiType(F.DataType) + ';' + sLineBreak);
|
|
fIntfBuff.WriteString(' property ' + GetFieldName(F.FieldName).Substring(1) { remove f } + ': ' + GetDelphiType(F.DataType));
|
|
fIntfBuff.WriteString(' read ' + GetFieldName(F.FieldName) + ' write ' + GetFieldName(F.FieldName));
|
|
fIntfBuff.WriteString(';' + sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitUnit;
|
|
begin
|
|
fIntfBuff.WriteString('unit Entities;' + sLineBreak);
|
|
fIntfBuff.WriteString('' + sLineBreak);
|
|
fIntfBuff.WriteString('interface' + sLineBreak);
|
|
fIntfBuff.WriteString('' + sLineBreak);
|
|
fIntfBuff.WriteString('uses' + sLineBreak);
|
|
fIntfBuff.WriteString(' MVCFramework.Serializer.Commons,' + sLineBreak);
|
|
fIntfBuff.WriteString(' MVCFramework.ActiveRecord,' + sLineBreak);
|
|
fIntfBuff.WriteString(' System.Classes;' + sLineBreak);
|
|
fIntfBuff.WriteString('' + sLineBreak);
|
|
fIntfBuff.WriteString('type' + sLineBreak);
|
|
fIntfBuff.WriteString('' + sLineBreak);
|
|
|
|
fImplBuff.WriteString('implementation' + sLineBreak + sLineBreak);
|
|
end;
|
|
|
|
procedure TMainForm.EmitUnitEnd;
|
|
begin
|
|
fImplBuff.WriteString(sLineBreak + 'end.');
|
|
end;
|
|
|
|
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
fIntfBuff.Free;
|
|
fImplBuff.Free;
|
|
end;
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
fIntfBuff := TStringStream.Create;
|
|
fImplBuff := TStringStream.Create;
|
|
FHistoryFileName := TPath.GetDocumentsPath + PathDelim + 'eg.history';
|
|
try
|
|
if TFile.Exists(FHistoryFileName) then
|
|
mmConnectionParams.Lines.LoadFromFile(FHistoryFileName)
|
|
else
|
|
mmConnectionParams.Lines.Assign(FDConnection1.Params);
|
|
except
|
|
|
|
end;
|
|
|
|
FDManager.LoadConnectionDefFile;
|
|
FDManager.GetConnectionNames(cboConnectionDefs.Items);
|
|
end;
|
|
|
|
function TMainForm.GetClassName(const aTableName: string): string;
|
|
var
|
|
lTableName: string;
|
|
lNextLetter: Integer;
|
|
lNextLetterChar: string;
|
|
begin
|
|
lTableName := aTableName.ToLower;
|
|
Result := 'T' + lTableName.Substring(0, 1).ToUpper + lTableName.Substring(1).ToLower;
|
|
|
|
while Result.IndexOf('_') > -1 do
|
|
begin
|
|
lNextLetter := Result.IndexOf('_') + 1;
|
|
lNextLetterChar := UpperCase(Result.Chars[lNextLetter]);
|
|
Result := Result.Remove(Result.IndexOf('_') + 1, 1);
|
|
Result := Result.Insert(Result.IndexOf('_') + 1, lNextLetterChar);
|
|
Result := Result.Remove(Result.IndexOf('_'), 1);
|
|
end;
|
|
end;
|
|
|
|
function TMainForm.GetDelphiType(FT: TFieldType): string;
|
|
begin
|
|
case FT of
|
|
ftString:
|
|
Result := 'String';
|
|
ftSmallint, ftInteger, ftWord, ftLongWord, ftShortint:
|
|
Result := 'Integer';
|
|
ftByte:
|
|
Result := 'Byte';
|
|
ftLargeint:
|
|
Result := 'Int64';
|
|
ftBoolean:
|
|
Result := 'Boolean';
|
|
ftFloat, ftSingle, ftExtended:
|
|
Result := 'Double';
|
|
ftCurrency, ftBCD:
|
|
Result := 'Currency';
|
|
ftDate:
|
|
Result := 'TDate';
|
|
ftTime:
|
|
Result := 'TTime';
|
|
ftDateTime:
|
|
Result := 'TDateTime';
|
|
ftTimeStamp:
|
|
Result := 'TDateTime {timestamp}';
|
|
ftAutoInc:
|
|
Result := 'Integer; {autoincrement}';
|
|
ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftWideMemo, ftStream:
|
|
Result := 'TStream';
|
|
ftFixedChar:
|
|
Result := 'String; {fixedchar}';
|
|
ftWideString:
|
|
Result := 'String';
|
|
else
|
|
Result := '<UNSUPPORTED TYPE: ' + IntToStr(Ord(FT)) + '>';
|
|
end;
|
|
end;
|
|
|
|
function TMainForm.GetFieldName(const Value: string): string;
|
|
var
|
|
Pieces: TArray<string>;
|
|
s: string;
|
|
begin
|
|
if Value.Length <= 2 then
|
|
exit('f' + Value.ToUpper);
|
|
|
|
Result := '';
|
|
Pieces := Value.ToLower.Split(['_']);
|
|
for s in Pieces do
|
|
begin
|
|
if s = 'id' then
|
|
Result := Result + 'ID'
|
|
else
|
|
Result := Result + UpperCase(s.Chars[0]) + s.Substring(1);
|
|
end;
|
|
Result := 'f' + Result;
|
|
end;
|
|
|
|
end.
|