Added credits to the readme

Fixed https://github.com/danieleteti/delphimvcframework/issues/278
This commit is contained in:
Daniele Teti 2019-10-09 23:44:44 +02:00
parent 0d93ace653
commit 510453576f
23 changed files with 312 additions and 4316 deletions

View File

@ -0,0 +1,3 @@
# 3.2.0 (boron) breaking changes
No breaking changes from 3.1.0-lithium to 3.2.0-boron

View File

@ -71,6 +71,10 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
## What's Cooking in the Lab
### DelphiMVCFramework 3.2.0-boron (currently in `RC` phase)
> WARNING! Considering the huge amount of features added in 3.1.1-beryllium during its RC phase, the dmvcframework-3.1.1-beryllium has been renamed to dmvcframework-3.2.0-boron
- New! Added Swagger support (thanks to [João Antônio Duarte]() and [Geoffrey Smith](https://github.com/geoffsmith82))
- New! Added SQLGenerator and RQL compiler for PostgreSQL, SQLite and MSSQLServer (in addition to MySQL, MariaDB, Firebird and Interbase)
- Improved! Greatly improved support for [HATEOAS](https://en.wikipedia.org/wiki/HATEOAS) in renders. Check `TRenderSampleController.GetPeople_AsObjectList_HATEOS` and all the others actions end with `HATEOS` in `renders.dproj` sample)
@ -133,6 +137,7 @@ Render(lPerson, False,
- Improved! `ActiveRecordShowCase` sample is much better now.
- Improved! In case of unhandled exception `TMVCEngine` is compliant with the default response content-type (usually it did would reply using `text/plain`).
- Fix! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184).
- Fix! [issue278](https://github.com/danieleteti/delphimvcframework/issues/278)
- Breaking Change! In `MVCActiveRecord` attribute `MVCPrimaryKey` has been removed and merged with `MVCTableField`, so now `TMVCActiveRecordFieldOption` is a set of `foPrimaryKey`, `foAutoGenerated`, `foTransient` (check `activerecord_showcase.dproj` sample).
- Breaking Change! `TDataSetHolder` doesn't renders dataset in a property called `items` but in a property named `data` (to be more standard)
- Added! New overloads for all the Log\* calls. Now it is possible to call `LogD(lMyObject)` to get logged `lMyObject` as JSON (custom type serializers not supported in log).

View File

@ -2,7 +2,7 @@
<PropertyGroup>
<ProjectGuid>{5B9408E7-46AC-4431-9716-C9EB9F8589B1}</ProjectGuid>
<MainSource>SwagDoc.dpk</MainSource>
<ProjectVersion>18.6</ProjectVersion>
<ProjectVersion>18.7</ProjectVersion>
<FrameworkType>None</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
@ -271,6 +271,12 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
@ -307,6 +313,36 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
@ -331,6 +367,12 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@ -429,6 +471,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024x768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -440,6 +493,39 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668x2388">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -451,6 +537,61 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x2732">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2224">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2388x1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2732x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -462,6 +603,116 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768x1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1125">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1136x640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242x2688">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1334">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1792">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2208">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2436">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2688x1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -495,6 +746,28 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch750">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch828">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>

View File

@ -42,14 +42,13 @@ requires
FireDACMySQLDriver,
loggerproRT,
SwagDoc,
FireDACPgDriver,
FireDACCommonODBC;
FireDACPgDriver;
contains
Web.ApacheConst in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheConst.pas',
Web.Win.IsapiHTTP in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.Win.IsapiHTTP.pas',
Web.ApacheHTTP in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheHTTP.pas',
Web.HTTPDMethods in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.HTTPDMethods.pas',
Web.ApacheConst,
Web.Win.IsapiHTTP,
Web.ApacheHTTP,
Web.HTTPDMethods,
Web.HTTPDImpl,
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
@ -83,6 +82,7 @@ contains
MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas',
MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas',
MVCFramework.RQL.AST2SQLite in '..\..\sources\MVCFramework.RQL.AST2SQLite.pas',
MVCFramework.RQL.Parser in '..\..\sources\MVCFramework.RQL.Parser.pas',
MVCFramework.Rtti.Utils in '..\..\sources\MVCFramework.Rtti.Utils.pas',
MVCFramework.Serializer.Abstract in '..\..\sources\MVCFramework.Serializer.Abstract.pas',
@ -101,7 +101,8 @@ contains
MVCFramework.SQLGenerators.MySQL in '..\..\sources\MVCFramework.SQLGenerators.MySQL.pas',
MVCFramework.SQLGenerators.PostgreSQL in '..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas',
MVCFramework.SQLGenerators.Sqlite in '..\..\sources\MVCFramework.SQLGenerators.Sqlite.pas',
MVCFramework.RQL.AST2SQLite in '..\..\sources\MVCFramework.RQL.AST2SQLite.pas';
MVCFramework.Swagger.Commons in '..\..\sources\MVCFramework.Swagger.Commons.pas',
MVCFramework.Middleware.Swagger in '..\..\sources\MVCFramework.Middleware.Swagger.pas';
end.

View File

@ -123,7 +123,6 @@
<DCCReference Include="loggerproRT.dcp"/>
<DCCReference Include="SwagDoc.dcp"/>
<DCCReference Include="FireDACPgDriver.dcp"/>
<DCCReference Include="FireDACCommonODBC.dcp"/>
<DCCReference Include="c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheConst.pas"/>
<DCCReference Include="c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.Win.IsapiHTTP.pas"/>
<DCCReference Include="c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheHTTP.pas"/>
@ -160,6 +159,7 @@
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2MySQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2SQLite.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Rtti.Utils.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.Abstract.pas"/>
@ -178,7 +178,8 @@
<DCCReference Include="..\..\sources\MVCFramework.SQLGenerators.MySQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.SQLGenerators.Sqlite.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2SQLite.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Swagger.Commons.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Middleware.Swagger.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View File

@ -1,772 +0,0 @@
unit DelphiUnit;
interface
uses
classes,
system.json,
System.SysUtils,
System.Rtti,
System.TypInfo,
System.Generics.Collections,
System.Generics.Defaults
;
type
TUnitTypeDefinition = class;
TUnitFieldDefinition = class
private
FFieldName: string;
FFieldType: string;
FAttributes: TStringList;
FDescription: string;
public
property FieldName: string read FFieldName write FFieldName;
property FieldType: string read FFieldType write FFieldType;
property Description: string read FDescription write FDescription;
procedure AddAttribute(const inAttribute: string);
function GenerateInterface: string;
constructor Create;
destructor Destroy; override;
end;
TUnitParameter = class
private
FFlags: TParamFlags;
FType: TUnitTypeDefinition;
FParamName: string;
FAttributes: TStringList;
public
property Attributes: TStringList read FAttributes write FAttributes;
property ParamName: string read FParamName write FParamName;
property Flags: TParamFlags read FFlags write FFlags;
property ParamType: TUnitTypeDefinition read FType write FType;
procedure AddAttribute(const inAttribute: string);
constructor Create;
destructor Destroy; override;
end;
TUnitMethod = class
private
FAttributes: TStringList;
FMethodKind: TMethodKind;
FVisibility: TMemberVisibility;
FName: string;
FIsStatic: Boolean;
FIsClassMethod: Boolean;
FReturnType: TUnitTypeDefinition;
FParams: TObjectList<TUnitParameter>;
FVars: TObjectList<TUnitParameter>;
FContent: TStringList;
function MethodKindToDelphiString(var LHasReturn: Boolean): string;
procedure ParametersToDelphiString(var AParamString: string; AIncludeAttributes: Boolean);
procedure MethodLocalVarsToDelphiString(LFuncSL: TStringList);
function GetIsConstructor: Boolean;
function GetIsDestructor: Boolean;
public
property Content: TStringList read FContent write FContent;
property MethodKind: TMethodKind read FMethodKind write FMethodKind;
property Visibility: TMemberVisibility read FVisibility write FVisibility;
property Name: string read FName write FName;
property IsConstructor: Boolean read GetIsConstructor;
property IsDestructor: Boolean read GetIsDestructor;
property IsClassMethod: Boolean read FIsClassMethod write FIsClassMethod;
// Static: No 'Self' parameter
property IsStatic: Boolean read FIsStatic write FIsStatic;
property ReturnType: TUnitTypeDefinition read FReturnType write FReturnType;
function GetParameters: TArray<TUnitParameter>;
procedure AddParameter(param: TUnitParameter);
procedure AddLocalVariable(inVar: TUnitParameter);
procedure AddAttribute(const inAttribute: string);
function GenerateInterface: string;
function GenerateImplementation(inOnType: TUnitTypeDefinition): string;
constructor Create;
destructor Destroy; override;
end;
TUnitTypeDefinition = class
private
FTypeName: string;
FTypeInheritedFrom: string;
FAttributes: TStringList;
FTypeKind: TTypeKind;
FForwardDeclare: Boolean;
FGuid : TGUID;
public
Fields: TObjectList<TUnitFieldDefinition>;
FMethods: TObjectList<TUnitMethod>;
property Guid: TGUID read FGuid write FGuid;
property TypeName: string read FTypeName write FTypeName;
property TypeKind: TTypeKind read FTypeKind write FTypeKind;
property TypeInherited: string read FTypeInheritedFrom write FTypeInheritedFrom;
property ForwardDeclare: Boolean read FForwardDeclare write FForwardDeclare;
function GetMethods(): TArray<TUnitMethod>;
procedure AddAttribute(const inAttribute: string);
function GenerateInterface: string;
function GenerateForwardInterface: string;
constructor Create;
destructor Destroy; override;
end;
TDelphiUnit = class
private
FInterfaceUses: TStringList;
FImplementationUses: TStringList;
FInterfaceConstant: TStringList;
FImplementationConstant: TStringList;
FUnitName: string;
FTitle: String;
FDescription: string;
FLicense: string;
public
TypeDefinitions: TObjectList<TUnitTypeDefinition>;
function GenerateInterfaceSectionStart: string; virtual;
function GenerateInterfaceUses: string; virtual;
function GenerateImplementationSectionStart: string; virtual;
function GenerateImplementationUses: string; virtual;
function GenerateImplementationConstants: string; virtual;
function CreateGUID: TGuid;
public
property UnitFile: string read FUnitName write FUnitName;
property Title: String read FTitle write FTitle;
property Description: string read FDescription write FDescription;
property License: string read FLicense write FLicense;
procedure AddInterfaceUnit(const inFilename: string); virtual;
procedure AddInterfaceConstant(const inName:string; const inValue:string);
procedure AddImplementationUnit(const inFilename: string); virtual;
procedure AddImplementationConstant(const inName:string; const inValue:string);
procedure AddType(inTypeInfo: TUnitTypeDefinition);
procedure SortTypeDefinitions;
function Generate: string;
constructor Create; virtual;
destructor Destroy; override;
end;
implementation
function DelphiVarName(const inVarname: string):string;
begin
Result := inVarname;
if Result.ToLower = 'type' then
Result := '&' + Result
else if Result.ToLower = 'file' then
Result := '&' + Result;
end;
{ TDelphiUnit }
procedure TDelphiUnit.AddImplementationConstant(const inName, inValue: string);
begin
FImplementationConstant.AddPair(inName, inValue);
end;
procedure TDelphiUnit.AddImplementationUnit(const inFilename: string);
var
IntIndex : Integer;
begin
IntIndex := FInterfaceUses.IndexOf(inFilename);
if IntIndex < 0 then
begin
if FImplementationUses.IndexOf(inFilename) < 0 then
FImplementationUses.Add(inFilename);
end;
end;
procedure TDelphiUnit.AddInterfaceConstant(const inName, inValue: string);
begin
FInterfaceConstant.AddPair(inName, inValue);
end;
procedure TDelphiUnit.AddInterfaceUnit(const inFilename: string);
var
ImpIndex : Integer;
begin
ImpIndex := FImplementationUses.IndexOf(inFilename);
if ImpIndex >= 0 then
FImplementationUses.Delete(ImpIndex);
if FInterfaceUses.IndexOf(inFilename) < 0 then
FInterfaceUses.Add(inFilename);
end;
procedure TDelphiUnit.AddType(inTypeInfo: TUnitTypeDefinition);
begin
TypeDefinitions.Add(inTypeInfo);
end;
constructor TDelphiUnit.Create;
begin
FInterfaceUses := TStringList.Create;
FInterfaceConstant := TStringList.Create;
FImplementationConstant := TStringList.Create;
FImplementationUses := TStringList.Create;
TypeDefinitions := TObjectList<TUnitTypeDefinition>.Create;
end;
destructor TDelphiUnit.Destroy;
begin
FreeAndNil(FInterfaceUses);
FreeAndNil(FImplementationUses);
FreeAndNil(FInterfaceConstant);
FreeAndNil(FImplementationConstant);
FreeAndNil(TypeDefinitions);
inherited;
end;
function TDelphiUnit.GenerateImplementationConstants: string;
var
SL : TStringList;
i : Integer;
begin
SL := TStringList.Create;
try
if FImplementationConstant.Count > 0 then
begin
SL.Add('const');
for i := 0 to FImplementationConstant.Count - 1 do
begin
SL.Add(' ' + FImplementationConstant.Names[i] + ' = ' + FImplementationConstant.ValueFromIndex[i] + ';');
end;
end;
Result := SL.Text;
finally
FreeAndNil(SL);
end;
end;
function TDelphiUnit.GenerateImplementationSectionStart: string;
var
LImplementationSection: TStringList;
begin
LImplementationSection := TStringList.Create;
try
LImplementationSection.Add('');
LImplementationSection.Add('implementation');
LImplementationSection.Add('');
Result := LImplementationSection.Text;
finally
FreeAndNil(LImplementationSection);
end;
end;
function TDelphiUnit.GenerateImplementationUses: string;
var
LUsesSL: TStringList;
i: Integer;
begin
LUsesSL := TStringList.Create;
try
if FImplementationUses.Count > 0 then
begin
LUsesSL.Add('uses');
for i := 0 to FImplementationUses.Count - 1 do
begin
if i = 0 then
LUsesSL.Add(' ' + FImplementationUses[i])
else
LUsesSL.Add(' , ' + FImplementationUses[i]);
end;
LUsesSL.Add(' ;');
end;
LUsesSL.Add('');
Result := LUsesSL.Text;
finally
FreeAndNil(LUsesSL);
end;
end;
function TDelphiUnit.GenerateInterfaceSectionStart: string;
var
LInterfaceSection: TStringList;
begin
LInterfaceSection := TStringList.Create;
try
LInterfaceSection.Add('unit ' + UnitFile + ';');
LInterfaceSection.Add('');
LInterfaceSection.Add('interface');
LInterfaceSection.Add('');
Result := LInterfaceSection.Text;
finally
FreeAndNil(LInterfaceSection);
end;
end;
function TDelphiUnit.GenerateInterfaceUses: string;
var
LUsesSL: TStringList;
i: Integer;
begin
LUsesSL := TStringList.Create;
try
if FInterfaceUses.Count > 0 then
begin
LUsesSL.Add('uses');
for i := 0 to FInterfaceUses.Count - 1 do
begin
if i = 0 then
LUsesSL.Add(' ' + FInterfaceUses[i])
else
LUsesSL.Add(' , ' + FInterfaceUses[i]);
end;
LUsesSL.Add(' ;');
end;
LUsesSL.Add('');
Result := LUsesSL.Text;
finally
FreeAndNil(LUsesSL);
end;
end;
function TDelphiUnit.Generate:string;
var
i: Integer;
j: Integer;
LMethod: TUnitMethod;
LMvcFile: TStringList;
LForwardAlreadyDeclared : Boolean;
begin
LForwardAlreadyDeclared := False;
LMvcFile := TStringList.Create;
try
LMvcFile.Add(GenerateInterfaceSectionStart);
LMvcFile.Add(GenerateInterfaceUses);
LMvcFile.Add('(*');
LMvcFile.Add('Title: ' + Title);
LMvcFile.Add('Description: ' + Description);
LMvcFile.Add('License: ' + License);
LMvcFile.Add('*)');
LMvcFile.Add('');
LMvcFile.Add('type');
SortTypeDefinitions;
if FInterfaceConstant.Count > 0 then
begin
LMvcFile.Add('const');
for i := 0 to FInterfaceConstant.Count - 1 do
begin
LMvcFile.Add(' ' + FInterfaceConstant.Names[i] + ' = ' + FInterfaceConstant.ValueFromIndex[i] + ';');
end;
end;
for i := 0 to TypeDefinitions.Count - 1 do
begin
if TypeDefinitions[i].ForwardDeclare then
begin
if not LForwardAlreadyDeclared then
LMvcFile.Add(' // Forward Declarations');
LMvcFile.Add(TypeDefinitions[i].GenerateForwardInterface);
LForwardAlreadyDeclared := True;
end;
end;
for i := 0 to TypeDefinitions.Count - 1 do
begin
LMvcFile.Add(TypeDefinitions[i].GenerateInterface);
end;
LMvcFile.Add(GenerateImplementationSectionStart);
LMvcFile.Add(GenerateImplementationUses);
LMvcFile.Add('');
GenerateImplementationConstants;
for j := 0 to TypeDefinitions.Count - 1 do
begin
for LMethod in TypeDefinitions[j].GetMethods do
begin
LMvcFile.Add(LMethod.GenerateImplementation(TypeDefinitions[j]));
end;
end;
LMvcFile.Add('end.');
Result := LMvcFile.Text;
finally
FreeAndNil(LMvcFile);
end;
end;
function TDelphiUnit.CreateGUID:TGuid;
var
guid : TGUID;
begin
System.SysUtils.CreateGuid(guid);
Result := guid;
end;
procedure TDelphiUnit.SortTypeDefinitions;
begin
{ TODO : Make this much more advanced to handle dependency ordering of declarations }
TypeDefinitions.Sort(TComparer<TUnitTypeDefinition>.Construct(function (const L, R: TUnitTypeDefinition): integer
begin
if L.TypeName = 'TMyMVCController' then
Result := 1
else if R.TypeName = 'TMyMVCController' then
Result := -1
else
Result := CompareText(L.TypeName, R.TypeName);
end));
end;
{ TTypeDefinition }
procedure TUnitTypeDefinition.AddAttribute(const inAttribute: string);
begin
FAttributes.Add(inAttribute);
end;
constructor TUnitTypeDefinition.Create;
begin
FAttributes := TStringList.Create;
Fields := TObjectList<TUnitFieldDefinition>.Create;
FMethods := TObjectList<TUnitMethod>.Create;
FTypeKind := tkClass;
FForwardDeclare := False;
end;
destructor TUnitTypeDefinition.Destroy;
begin
FreeAndNil(FAttributes);
FreeAndNil(Fields);
FreeAndNil(FMethods);
inherited;
end;
function TUnitTypeDefinition.GenerateForwardInterface: string;
begin
if FTypeKind = tkClass then
Result := ' ' + TypeName + ' : class;'
else if FTypeKind = tkInterface then
Result := ' ' + TypeName + ' : interface;'
else
Result := ' ' + TypeName + 'xxxx';
end;
function TUnitTypeDefinition.GenerateInterface: string;
var
LInterfaceSL: TStringList;
i: Integer;
j: Integer;
begin
LInterfaceSL := TStringList.Create;
try
for i := 0 to FAttributes.Count - 1 do
begin
LInterfaceSL.Add(FAttributes[i]);
end;
if FTypeKind = tkClass then
begin
if TypeInherited.Length > 0 then
LInterfaceSL.Add(' ' + TypeName + ' = class(' + TypeInherited + ')')
else
LInterfaceSL.Add(' ' + TypeName + ' = class');
end
else if FTypeKind = tkInterface then
begin
if TypeInherited.Length > 0 then
begin
LInterfaceSL.Add(' ' + TypeName + ' = interface(' + TypeInherited + ')');
LInterfaceSL.Add(' [' + GUIDToString(FGuid).QuotedString + ']');
end
else
begin
LInterfaceSL.Add(' ' + TypeName + ' = interface');
LInterfaceSL.Add(' [' + GUIDToString(FGuid).QuotedString + ']');
end;
end;
for j := 0 to Fields.Count - 1 do
begin
LInterfaceSL.Add(Fields[j].GenerateInterface);
end;
for j := 0 to FMethods.Count - 1 do
begin
LInterfaceSL.Add(TrimRight(FMethods[j].GenerateInterface));
LInterfaceSL.Add('');
end;
LInterfaceSL.Add(' end;');
Result := LInterfaceSL.Text;
finally
FreeAndNil(LInterfaceSL);
end;
end;
function TUnitTypeDefinition.GetMethods: TArray<TUnitMethod>;
var
i: Integer;
begin
SetLength(Result, FMethods.Count);
for i := 0 to FMethods.Count - 1 do
begin
Result[i] := FMethods[i];
end;
end;
{ TFieldDefinition }
procedure TUnitFieldDefinition.AddAttribute(const inAttribute: string);
begin
FAttributes.Add(inAttribute);
end;
constructor TUnitFieldDefinition.Create;
begin
FAttributes := TStringList.Create;
end;
destructor TUnitFieldDefinition.Destroy;
begin
FreeAndNil(FAttributes);
inherited;
end;
function TUnitFieldDefinition.GenerateInterface: string;
var
i : Integer;
SL : TStringList;
LType : string;
begin
SL := TStringList.Create;
try
LType := FFieldType;
for i := 0 to FAttributes.Count - 1 do
begin
SL.Add(' ' + FAttributes[i]);
end;
if Description.Length > 0 then
SL.Add(' [MVCDoc(' + QuotedStr(Description) + ')]');
SL.Add(' ' + DelphiVarName(FFieldName) + ' : ' + LType + ';');
Result := SL.Text;
finally
FreeAndNil(SL);
end;
end;
{ TUnitMethod }
procedure TUnitMethod.AddAttribute(const inAttribute: string);
begin
FAttributes.Add(inAttribute);
end;
procedure TUnitMethod.AddLocalVariable(inVar: TUnitParameter);
begin
FVars.Add(inVar);
end;
procedure TUnitMethod.AddParameter(param: TUnitParameter);
begin
FParams.Add(param);
end;
constructor TUnitMethod.Create;
begin
FParams := TObjectList<TUnitParameter>.Create;
FAttributes := TStringList.Create;
FVars := TObjectList<TUnitParameter>.Create;
FContent := TStringList.Create;
end;
destructor TUnitMethod.Destroy;
begin
FreeAndNil(FParams);
FreeAndNil(FAttributes);
FreeAndNil(FVars);
FreeAndNil(FContent);
inherited;
end;
procedure TUnitMethod.MethodLocalVarsToDelphiString(LFuncSL: TStringList);
var
i: Integer;
begin
if FVars.Count > 0 then
begin
LFuncSL.Add('var');
for i := 0 to FVars.Count - 1 do
begin
LFuncSL.Add(' ' + FVars[i].ParamName + ' : ' + FVars[i].ParamType.TypeName + ';');
end;
end;
end;
procedure TUnitMethod.ParametersToDelphiString(var AParamString: string; AIncludeAttributes: Boolean);
var
LParam: TUnitParameter;
LParamFlagString: string;
LParamName: string;
LParamAttributeString : string;
I: Integer;
begin
AParamString := '(';
for LParam in GetParameters do
begin
LParamFlagString := '';
if pfConst in LParam.Flags then
LParamFlagString := 'const'
else if pfVar in LParam.Flags then
LParamFlagString := 'var'
else if pfOut in LParam.Flags then
LParamFlagString := 'out'
else if pfArray in LParam.Flags then
LParamFlagString := 'array of';
if LParamFlagString.Length > 0 then
LParamFlagString := LParamFlagString + ' ';
if AIncludeAttributes then
begin
for I := 0 to LParam.Attributes.Count - 1 do
begin
LParamAttributeString := LParamAttributeString + ' ' + LParam.Attributes[i];
end;
LParamAttributeString := Trim(LParamAttributeString) + ' ';
end;
LParamName := DelphiVarName(LParam.ParamName);
AParamString := AParamString + LParamAttributeString + LParamFlagString + LParamName + ': ' + LParam.FType.FTypeName + '; ';
end;
if AParamString.EndsWith('; ') then
AParamString := AParamString.Remove(AParamString.Length - 2);
AParamString := AParamString + ')';
if AParamString = '()' then
AParamString := '';
end;
function TUnitMethod.MethodKindToDelphiString(var LHasReturn: Boolean): string;
begin
case MethodKind of
mkProcedure:
Result := 'procedure';
mkFunction:
begin
Result := 'function';
LHasReturn := True;
end;
mkDestructor:
Result := 'destructor';
mkConstructor:
Result := 'constructor';
mkClassFunction:
begin
Result := 'class function';
LHasReturn := True;
end;
mkClassProcedure:
Result := 'class procedure';
mkClassConstructor:
Result := 'class constructor';
mkClassDestructor:
Result := 'class destructor';
else
Result := 'unknown';
end;
end;
function TUnitMethod.GenerateImplementation(inOnType: TUnitTypeDefinition): string;
var
LProcTypeString: string;
LHasReturn: Boolean;
LParamString: string;
LClassNameProcIn: string;
LFuncSL: TStringList;
begin
LHasReturn := False;
LClassNameProcIn := '';
LProcTypeString := MethodKindToDelphiString(LHasReturn);
if Assigned(inOnType) then
LClassNameProcIn := inOnType.TypeName + '.';
ParametersToDelphiString(LParamString, False);
if LHasReturn then
Result := LProcTypeString + ' ' + LClassNameProcIn + FName + LParamString + ': ' + ReturnType.FTypeName + ';'
else
Result := LProcTypeString + ' ' + LClassNameProcIn + FName + LParamString + ';';
LFuncSL := TStringList.Create;
try
LFuncSL.Text := Result;
MethodLocalVarsToDelphiString(LFuncSL);
LFuncSL.Add('begin');
LFuncSL.Add(Content.Text);
LFuncSL.Add('end;');
Result := LFuncSL.Text;
finally
FreeAndNil(LFuncSL);
end;
end;
function TUnitMethod.GenerateInterface: string;
var
LProcTypeString: string;
LHasReturn: Boolean;
LParamString: string;
LAttributeString: string;
begin
LHasReturn := False;
LProcTypeString := MethodKindToDelphiString(LHasReturn);
ParametersToDelphiString(LParamString, True);
if LHasReturn then
Result := ' ' + LProcTypeString + ' ' + FName + LParamString + ': ' + ReturnType.FTypeName + ';'
else
Result := ' ' + LProcTypeString + ' ' + FName + LParamString + ';';
LAttributeString := FAttributes.Text;
Result := LAttributeString + Result;
end;
function TUnitMethod.GetIsConstructor: Boolean;
begin
Result := MethodKind = mkConstructor;
end;
function TUnitMethod.GetIsDestructor: Boolean;
begin
Result := MethodKind = mkDestructor;
end;
function TUnitMethod.GetParameters: TArray<TUnitParameter>;
var
i: Integer;
begin
setLength(Result, FParams.Count);
for i := 0 to FParams.Count - 1 do
begin
Result[i] := FParams[i];
end;
end;
{ TUnitParameter }
procedure TUnitParameter.AddAttribute(const inAttribute: string);
begin
FAttributes.Add(inAttribute);
end;
constructor TUnitParameter.Create;
begin
FAttributes := TStringList.Create;
end;
destructor TUnitParameter.Destroy;
begin
FreeAndNil(FAttributes);
inherited;
end;
end.

View File

@ -1,15 +0,0 @@
program DelphiUnitTester;
uses
Vcl.Forms,
Unit2 in 'Unit2.pas' {Form2},
DelphiUnit in 'DelphiUnit.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm2, Form2);
Application.Run;
end.

View File

@ -1,886 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{BE4A7B85-C0EC-4905-AB12-2115731644B8}</ProjectGuid>
<ProjectVersion>18.7</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>DelphiUnitTester.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<SanitizedProjectName>DelphiUnitTester</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;PKIEDB26;emsclientfiredac;DataSnapFireDAC;svnui;tethering;JvGlobus;FireDACADSDriver;JvPluginSystem;hclcore_xe103;tmswizdXE12;DBXMSSQLDriver;JvMM;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;JvBands;vcldb;bindcompfmx;svn;PKIECtrl26;DBXOracleDriver;JvJans;JvNet;inetdb;JvAppFrm;FmxTeeUI;emsedge;JvDotNetCtrls;FireDACIBDriver;fmx;fmxdae;RadiantShapesFmx;AbbreviaVCLD;vclib;frxTee26;JvWizards;FireDACDBXDriver;dbexpress;IndyCore;vclx;JvPageComps;dsnap;DataSnapCommon;emsclient;FireDACCommon;JvDB;RESTBackendComponents;DataSnapConnectors;pkfindfile;VCLRESTComponents;soapserver;JclDeveloperTools;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;JvCmp;JvHMI;frx26;FireDACCommonODBC;FireDACCommonDriver;OpenSSL;DataSnapClient;inet;OverbyteIcsD103Run;bindcompdbx;IndyIPCommon;JvCustom;vcl;IndyIPServer;DBXSybaseASEDriver;JvXPCtrls;frxDB26;IndySystem;FireDACDb2Driver;dsnapcon;tmsxlsdXE12;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;Jcl;JvCore;emshosting;frxe26;JvCrypt;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;tmsdXE12;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;JvDlgs;JvRuntimeDesign;ibxpress;Tee;JvManagedThreads;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;JvTimeFramework;CustomIPTransport;vcldsnap;htmlcomp_xe103;JvSystem;JvStdCtrls;DOSCommandDR;AsyncProDR;CodeSiteLoggingPkg;bindcomp;appanalytics;CodeSiteDBToolsPkg;DBXInformixDriver;tmsexdXE12;IndyIPClient;EurekaLogCore;bindcompvcl;TeeUI;JvDocking;dbxcds;VclSmp;JvPascalInterpreter;adortl;FireDACODBCDriver;RadiantShapesFmx_Design;FixInsight_10_3;JclVcl;DataSnapIndy10ServerTransport;htmlcompfm_xe103;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;JvControls;JvPrintPreview;MidiComponents2010;JclContainers;NewAC_XE10;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;PKIEDB26;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;PKIECtrl26;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;RadiantShapesFmx;AbbreviaVCLD;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;pkfindfile;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;OverbyteIcsD103Run;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;tmsxlsdXE12;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;tmsdXE12;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;DOSCommandDR;bindcomp;appanalytics;DBXInformixDriver;tmsexdXE12;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;RadiantShapesFmx_Design;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit2.pas">
<Form>Form2</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="DelphiUnit.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiUnitTester.dpr</Source>
</Source>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\DelphiUnitTester.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>DelphiUnitTester.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024x768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668x2388">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x2732">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2224">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2388x1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2732x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768x1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1125">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1136x640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242x2688">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1334">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1792">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2208">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2436">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2688x1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640x1136">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch750">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch828">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug">
<Platform Name="OSX64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

View File

@ -1,86 +0,0 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Sample Api with Documentation Swagger using SwagDoc'
ClientHeight = 685
ClientWidth = 605
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
object btnGenerateDelphiMVCController: TButton
Position.X = 128.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 185.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
Text = 'Generate DelphiMVCController'
OnClick = btnGenerateDelphiMVCControllerClick
end
object TabControl1: TTabControl
Align = Bottom
Position.Y = 40.000000000000000000
Size.Width = 605.000000000000000000
Size.Height = 645.000000000000000000
Size.PlatformDefault = False
TabIndex = 1
TabOrder = 3
TabPosition = PlatformDefault
Sizes = (
605s
619s
605s
619s)
object TabItem1: TTabItem
CustomIcon = <
item
end>
IsSelected = False
Size.Width = 98.000000000000000000
Size.Height = 26.000000000000000000
Size.PlatformDefault = False
StyleLookup = ''
TabOrder = 0
Text = 'Swagger JSON'
ExplicitSize.cx = 98.000000000000000000
ExplicitSize.cy = 26.000000000000000000
object Memo1: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Align = Client
Size.Width = 605.000000000000000000
Size.Height = 619.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Viewport.Width = 601.000000000000000000
Viewport.Height = 615.000000000000000000
end
end
object TabItem2: TTabItem
CustomIcon = <
item
end>
IsSelected = True
Size.Width = 136.000000000000000000
Size.Height = 26.000000000000000000
Size.PlatformDefault = False
StyleLookup = ''
TabOrder = 0
Text = 'DelphiMVC Controller'
ExplicitSize.cx = 136.000000000000000000
ExplicitSize.cy = 26.000000000000000000
object Memo2: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Align = Client
Size.Width = 605.000000000000000000
Size.Height = 619.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Viewport.Width = 601.000000000000000000
Viewport.Height = 615.000000000000000000
end
end
end
end

View File

@ -1,95 +0,0 @@
{******************************************************************************}
{ }
{ Delphi SwagDoc Library }
{ Copyright (c) 2018 Marcelo Jaloto }
{ https://github.com/marcelojaloto/SwagDoc }
{ }
{******************************************************************************}
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{ http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{******************************************************************************}
unit Sample.Main;
interface
uses
System.SysUtils,
System.Types,
System.UITypes,
System.Classes,
System.Variants,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Controls.Presentation,
FMX.StdCtrls,
FMX.ScrollBox,
FMX.Memo,
FMX.TabControl
;
type
TForm1 = class(TForm)
Memo1: TMemo;
btnGenerateDelphiMVCController: TButton;
TabControl1: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
Memo2: TMemo;
procedure btnGenerateDelphiMVCControllerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
uses
Swag.Doc,
Sample.SwagDoc.DelphiMVCFramework,
System.IOUtils
;
procedure TForm1.btnGenerateDelphiMVCControllerClick(Sender: TObject);
var
mvcFramework : TSwagDocToDelphiMVCFrameworkBuilder;
swagDoc : TSwagDoc;
filename : string;
begin
mvcFramework := nil;
try
swagDoc := TSwagDoc.Create;
swagDoc.LoadFromFile(TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..\swagger.json'));
mvcFramework := TSwagDocToDelphiMVCFrameworkBuilder.Create(swagDoc);
memo2.Lines.Text := mvcFramework.Generate;
filename := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..\mvccontroller.pas');
TFile.WriteAllText(filename, memo2.Lines.Text);
finally
FreeAndNil(mvcFramework);
end;
end;
initialization
ReportMemoryLeaksOnShutdown := True;
end.

View File

@ -1,554 +0,0 @@
unit Sample.SwagDoc.DelphiMVCFramework;
interface
uses
classes,
system.json,
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
Swag.Doc,
Swag.Common.Types,
Swag.Doc.Path.Operation,
Swag.Doc.Path.Operation.Response,
Swag.Doc.Path.Operation.RequestParameter,
DelphiUnit
;
type
TSwagDocToDelphiMVCFrameworkBuilder = class(TObject)
private
FSwagDoc : TSwagDoc;
function CapitalizeFirstLetter(const typeName: string): string;
function RewriteUriToSwaggerWay(const uri:string): string;
function OperationIdToFunctionName(inOperation: TSwagPathOperation): string;
function GenerateUnitText(delphiUnit: TDelphiUnit): string;
function ConvertSwaggerTypeToDelphiType(inSwaggerType: TSwagRequestParameter): TUnitTypeDefinition;
function ConvertRefToType(const inRef:String): string;
function ConvertRefToVarName(const inRef:String): string;
procedure ChildType(DelphiUnit : TDelphiUnit; json: TJSONPair);
procedure HandleArray(inField: TUnitFieldDefinition; json: TJSONPair);
procedure ConvertSwaggerDefinitionsToTypeDefinitions(delphiUnit: TDelphiUnit);
procedure ConvertSwaggerRequestParametersToDelphi(AMethod: TUnitMethod; AParameters: TObjectList<TSwagRequestParameter>);
procedure ConvertSwaggerResponsesToDelphiMethods(ADelphiUnit: TDelphiUnit; AMethod: TUnitMethod; AOperation: TSwagPathOperation);
function SwaggerTypeAsString(ASwaggerType: TSwagTypeParameter): string;
procedure CreatePathParam(ASwagParam: TSwagRequestParameter; AParam: TUnitParameter);
function HandleFormatOnParameter(const inParamType:string; param: TSwagRequestParameter): string;
procedure CreateNonPathParam(ASwagParam: TSwagRequestParameter; AMethod : TUnitMethod);
function InLocationAsString(ASwaggerType: TSwagRequestParameterInLocation): string;
public
constructor Create(SwagDoc: TSwagDoc);
function Generate: string;
end;
implementation
uses
Json.Common.Helpers
, Winapi.Windows
, System.IOUtils
, MVCFramework.Commons
, TypInfo
;
{ TSwagDocToDelphiMVCFrameworkBuilder }
function TSwagDocToDelphiMVCFrameworkBuilder.OperationIdToFunctionName(inOperation: TSwagPathOperation):string;
begin
Result := inOperation.OperationId.Replace('{','').Replace('}','').Replace('-','');
if not CharInSet(Result[1], ['a'..'z','A'..'Z']) then
Result := 'F' + Result;
Result := CapitalizeFirstLetter(Result);
end;
function TSwagDocToDelphiMVCFrameworkBuilder.RewriteUriToSwaggerWay(const uri:string):string;
begin
Result := uri.Replace('{','($').Replace('}',')');
end;
function TSwagDocToDelphiMVCFrameworkBuilder.CapitalizeFirstLetter(const typeName: string): string;
begin
if typeName.Length > 2 then
Result := Copy(typeName, 1, 1).ToUpper + Copy(typeName, 2, typeName.Length - 1)
else
Result := typeName;
end;
constructor TSwagDocToDelphiMVCFrameworkBuilder.Create(SwagDoc: TSwagDoc);
begin
FSwagDoc := SwagDoc;
end;
function TSwagDocToDelphiMVCFrameworkBuilder.ConvertRefToType(const inRef:String):string;
begin
Result := Copy(inRef, inRef.LastIndexOf('/') + 2);
Result := Copy(Result,1,1).ToUpper + Copy(Result,2);
Result := 'T' + Result;
end;
function TSwagDocToDelphiMVCFrameworkBuilder.ConvertRefToVarName(const inRef:String):string;
begin
Result := Copy(inRef, inRef.LastIndexOf('/') + 2);
end;
function TSwagDocToDelphiMVCFrameworkBuilder.Generate: string;
var
i: Integer;
j: Integer;
LDelphiUnit : TDelphiUnit;
LMVCController : TUnitTypeDefinition;
LMethod : TUnitMethod;
begin
LDelphiUnit := nil;
try
LDelphiUnit := TDelphiUnit.Create;
LDelphiUnit.UnitFile := 'mvccontroller';
LDelphiUnit.AddInterfaceUnit('MVCFramework');
LDelphiUnit.AddInterfaceUnit('MVCFramework.Commons');
LDelphiUnit.AddInterfaceUnit('MVCFramework.Logger');
LDelphiUnit.AddInterfaceUnit('MVCFramework.JWT');
LDelphiUnit.AddInterfaceUnit('Generics.Collections');
LDelphiUnit.AddInterfaceUnit('Swag.Common.Types');
LDelphiUnit.AddImplementationUnit('Swag.Doc');
ConvertSwaggerDefinitionsToTypeDefinitions(LDelphiUnit);
LMVCController := TUnitTypeDefinition.Create;
LMVCController.TypeName := 'TMyMVCController';
LMVCController.TypeInherited := 'TMVCController';
LMVCController.AddAttribute(' [MVCPath(''' + fSwagDoc.BasePath + ''')]');
LDelphiUnit.AddType(LMVCController);
for i := 0 to fSwagDoc.Paths.Count - 1 do
begin
for j := 0 to fSwagDoc.Paths[i].Operations.Count - 1 do
begin
LMethod := TUnitMethod.Create;
if fSwagDoc.Paths[i].Operations[j].Description.Trim.Length > 0 then
LMethod.AddAttribute(' [MVCDoc(' + QuotedStr(fSwagDoc.Paths[i].Operations[j].Description) + ')]');
LMethod.AddAttribute(' [MVCPath(''' + RewriteUriToSwaggerWay(fSwagDoc.Paths[i].Uri) + ''')]');
LMethod.AddAttribute(' [MVCHTTPMethod([http' + fSwagDoc.Paths[i].Operations[j].OperationToString.ToUpper + '])]');
LMethod.Name := OperationIdToFunctionName(fSwagDoc.Paths[i].Operations[j]);
ConvertSwaggerRequestParametersToDelphi(LMethod, FSwagDoc.Paths[i].Operations[j].Parameters);
ConvertSwaggerResponsesToDelphiMethods(LDelphiUnit, LMethod, FSwagDoc.Paths[i].Operations[j]);
LMVCController.FMethods.Add(LMethod);
end;
end;
LDelphiUnit.SortTypeDefinitions;
Result := GenerateUnitText(LDelphiUnit);
finally
LDelphiUnit.Free;
end;
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.CreateNonPathParam(ASwagParam: TSwagRequestParameter; AMethod : TUnitMethod);
var
param1 : string;
param2 : string;
paramType : string;
param4 : string;
param5 : string;
params : string;
begin
param1 := ASwagParam.Name;
param2 := InLocationAsString(ASwagParam.InLocation);
paramType := SwaggerTypeAsString(ASwagParam.TypeParameter);
param4 := ASwagParam.Pattern;
param5 := ASwagParam.Format;
if ASwagParam.TypeParameter = stpNotDefined then
begin
if ASwagParam.Schema.JsonSchema.Values['$ref']<>nil then
paramType := ConvertRefToType(ASwagParam.Schema.JsonSchema.Values['$ref'].Value);
end;
if param1.Length = 0 then
raise Exception.Create('Parameter name not specified');
if ASwagParam.InLocation = rpiNotDefined then
raise Exception.Create('Parameter location not specified');
if paramType.Length = 0 then
raise Exception.Create('Parameter type not specified');
params := param1.QuotedString + ', ' + param2 + ', '+ paramType;
if param5.Length > 0 then
params := params + ', ' + param4.QuotedString + ', ' + param5.QuotedString
else if param4.Length > 0 then
params := params + ', ' + param4.QuotedString;
AMethod.AddAttribute('[MVCParam(' + params + ')]');
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.CreatePathParam(ASwagParam: TSwagRequestParameter; AParam: TUnitParameter);
var
param1 : string;
param2 : string;
param3 : string;
params : string;
begin
param1 := SwaggerTypeAsString(ASwagParam.TypeParameter);
param2 := ASwagParam.Pattern;
param3 := ASwagParam.Format;
params := param1;
if param3.Length > 0 then
params := params + ', ' + param2.QuotedString + ', ' + param3.QuotedString
else if param2.Length > 0 then
params := params + ', ' + param2.QuotedString;
if ASwagParam.Description.Trim <> '' then
begin
AParam.AddAttribute('[MVCDoc(' + ASwagParam.Description.QuotedString + ')]');
end;
AParam.AddAttribute('[MVCPathParam(' + params + ')]');
end;
function ReturnStatusCode(inStatusCode: string):string;
begin
inStatusCode := inStatusCode.ToLower;
if (inStatusCode = 'default') or (inStatusCode = '200') then
Result := 'HTTP_STATUS.OK'
else if inStatusCode = '400' then
Result := 'HTTP_STATUS.BadRequest'
else if inStatusCode = '404' then
Result := 'HTTP_STATUS.NotFound'
else if inStatusCode = '405' then
Result := 'HTTP_STATUS.MethodNotAllowed'
else
Result := inStatusCode;
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.ConvertSwaggerResponsesToDelphiMethods(ADelphiUnit: TDelphiUnit; AMethod: TUnitMethod; AOperation: TSwagPathOperation);
var
LResponse: System.Generics.Collections.TPair<string, TSwagResponse>;
LSchemaObj: TJSONObject;
LRef: string;
LResultParam: TUnitParameter;
begin
for LResponse in AOperation.Responses do
begin
LSchemaObj := LResponse.Value.Schema.JsonSchema;
if LSchemaObj = nil then // No Return Info to Http Method
begin
AMethod.Content.Add(' // ' + LResponse.Key + ' ' + LResponse.Value.Description);
AMethod.AddAttribute(' [MVCResponse(' + ReturnStatusCode(LResponse.Key) + ', ' + QuotedStr(LResponse.Value.Description) + ')]');
continue;
end
else if LSchemaObj.TryGetValue('$ref', LRef) then
begin
AMethod.AddAttribute(' [MVCResponse(' + ReturnStatusCode(LResponse.Key) + ', ' + QuotedStr(LResponse.Value.Description) + ', ' + ConvertRefToType(LRef) + ')]');
LResultParam := TUnitParameter.Create;
LResultParam.ParamName := ConvertRefToVarName(LRef);
LResultParam.ParamType := TUnitTypeDefinition.Create;
LResultParam.ParamType.TypeName := ConvertRefToType(LRef);
AMethod.AddLocalVariable(LResultParam);
AMethod.Content.Add(' ' + ConvertRefToVarName(LRef) + ' := ' + ConvertRefToType(LRef) + '.Create;');
AMethod.Content.Add('');
AMethod.Content.Add(' {TODO: Implement filling ' + ConvertRefToVarName(LRef) + ' }');
AMethod.Content.Add(' Render(' + ReturnStatusCode(LResponse.Key) + ', ' + ConvertRefToVarName(LRef) + ');');
end
else
begin
if not LSchemaObj.TryGetValue('items', LSchemaObj) then
continue;
if LSchemaObj.TryGetValue('$ref', LRef) then
begin
ADelphiUnit.AddInterfaceUnit('Generics.Collections');
AMethod.AddAttribute(' [MVCResponseList(' + ReturnStatusCode(LResponse.Key) + ', ' + QuotedStr(LResponse.Value.Description) + ', ' + ConvertRefToType(LRef) + ')]');
LResultParam := TUnitParameter.Create;
LResultParam.ParamName := ConvertRefToVarName(LRef);
LResultParam.ParamType := TUnitTypeDefinition.Create;
LResultParam.ParamType.TypeName := 'TObjectList<' + ConvertRefToType(LRef) + '>';
AMethod.AddLocalVariable(LResultParam);
AMethod.Content.Add(' ' + ConvertRefToVarName(LRef) + ' := Context.Request.BodyAsListOf<' + ConvertRefToType(LRef) + '>;');
AMethod.Content.Add('');
AMethod.Content.Add(' {TODO: Implement filling ' + ConvertRefToVarName(LRef) + ' }');
AMethod.Content.Add('');
AMethod.Content.Add(' Render(' + ReturnStatusCode(LResponse.Key) + ', ' + ConvertRefToVarName(LRef) + ');');
end
else
begin
AMethod.AddAttribute(' [MVCResponse(' + LResponse.Key + ', ' + QuotedStr(LResponse.Value.Description) + ')]');
end;
end;
end;
end;
function TSwagDocToDelphiMVCFrameworkBuilder.HandleFormatOnParameter(const inParamType:string; param: TSwagRequestParameter): string;
begin
if param.Format.ToLower = 'int64' then
begin
Result := 'Int64';
if inParamType.ToLower <> 'integer' then
raise Exception.Create('Parameter Type and Format do not match');
end
else
begin
Result := inParamType;
end;
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.ConvertSwaggerRequestParametersToDelphi(AMethod: TUnitMethod; AParameters: TObjectList<TSwagRequestParameter>);
var
LType: string;
LParam: TUnitParameter;
LParamType: TUnitTypeDefinition;
LSwagParam : TSwagRequestParameter;
LResultParam : TUnitParameter;
begin
for LSwagParam in AParameters do
begin
if LSwagParam.InLocation = rpiBody then
begin
LResultParam := TUnitParameter.Create;
LResultParam.ParamName := 'param' + CapitalizeFirstLetter(LSwagParam.Name);
LResultParam.ParamType := ConvertSwaggerTypeToDelphiType(LSwagParam);
CreateNonPathParam(LSwagParam, AMethod);
AMethod.AddLocalVariable(LResultParam);
if LResultParam.ParamType.TypeName.StartsWith('array of') then
begin
LType := Trim(Copy(LResultParam.ParamType.TypeName, 9));
LResultParam.ParamType.TypeName := 'TObjectList<' + LType + '>';
AMethod.Content.Add(' param' + CapitalizeFirstLetter(LSwagParam.Name) + ' := Context.Request.BodyAsListOf<' + LType + '>;');
end
else
AMethod.Content.Add(' param' + CapitalizeFirstLetter(LSwagParam.Name) + ' := Context.Request.BodyAs<' + LResultParam.ParamType.TypeName + '>;');
end
else if LSwagParam.InLocation <> rpiPath then
begin
LResultParam := TUnitParameter.Create;
LResultParam.ParamName := 'param' + CapitalizeFirstLetter(LSwagParam.Name);
LResultParam.ParamType := TUnitTypeDefinition.Create;
CreateNonPathParam(LSwagParam, AMethod);
LResultParam.ParamType.TypeName := 'String';
AMethod.AddLocalVariable(LResultParam);
AMethod.Content.Add(' param' + CapitalizeFirstLetter(LSwagParam.Name) + ' := Context.Request.Params[' + QuotedStr(LSwagParam.Name) + '];');
end
else
begin
LParam := TUnitParameter.Create;
LParam.ParamName := LSwagParam.Name;
CreatePathParam(LSwagParam, LParam);
LParamType := ConvertSwaggerTypeToDelphiType(LSwagParam);
LParamType.TypeName := HandleFormatOnParameter(LParamType.TypeName, LSwagParam);
LParam.ParamType := LParamType;
AMethod.AddParameter(LParam);
end;
end;
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.HandleArray(inField : TUnitFieldDefinition; json: TJSONPair);
var
jsonObj : TJSONObject;
jsonVal : TJSONValue;
LType : String;
begin
if Assigned(((json.JsonValue as TJSONObject).Values['items'] as TJSONObject).Values['type']) then
begin
LType := ((json.JsonValue as TJSONObject).Values['items'] as TJSONObject).Values['type'].Value;
if LType.ToLower <> 'string' then
LType := 'T' + LType;
inField.FieldType := 'array of ' + LType;
end
else
begin
OutputDebugString(PChar(json.ToJSON));
jsonVal := (json.JsonValue as TJSONObject).Values['items'] as TJSONObject;
OutputDebugString(PChar(jsonVal.ToJSON));
jsonObj := jsonVal as TJSONObject;
jsonVal := jsonObj.Values['$ref'];
OutputDebugString(PChar(jsonVal.Value));
inField.FieldType := 'array of ' + ConvertRefToType(jsonVal.value);
end;
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.ChildType(DelphiUnit : TDelphiUnit; json: TJSONPair);
var
LTypeInfo: TUnitTypeDefinition;
LJsonProps: TJSONObject;
LFieldInfo: TUnitFieldDefinition;
LTypeObj: TJSONObject;
j: Integer;
LValue : string;
begin
OutputDebugString(PChar('Child: ' + json.ToJSON));
LTypeInfo := TUnitTypeDefinition.Create;
LTypeInfo.TypeName := 'T' + CapitalizeFirstLetter(json.JSONString.Value);
LJsonProps := (json.JSONValue as TJSONObject).Values['properties'] as TJSONObject;
for j := 0 to LJsonProps.Count - 1 do
begin
OutputDebugString(PChar(LJsonProps.Pairs[j].ToJSON));
LFieldInfo := TUnitFieldDefinition.Create;
LFieldInfo.FieldName := LJsonProps.Pairs[j].JsonString.Value;
LTypeObj := LJsonProps.Pairs[j].JsonValue as TJSONObject;
LFieldInfo.FieldType := LTypeObj.Values['type'].Value;
if LFieldInfo.FieldType = 'number' then
LFieldInfo.FieldType := 'Double'
else if LFieldInfo.FieldType = 'object' then
begin
LFieldInfo.FieldType := 'T' + CapitalizeFirstLetter(LJsonProps.Pairs[j].JsonString.Value);
ChildType(DelphiUnit, LJsonProps.Pairs[j]);
end;
if LTypeObj.TryGetValue('description', LValue) then
LFieldInfo.AddAttribute('[MVCDoc(' + QuotedStr(LValue) + ')]');
if LTypeObj.TryGetValue('format', LValue) then
begin
if (LFieldInfo.FieldType.ToLower = 'integer') and (LValue.ToLower = 'int64') then
LFieldInfo.FieldType := 'Int64';
LFieldInfo.AddAttribute('[MVCFormat(' + QuotedStr(LValue) + ')]');
end;
if LTypeObj.TryGetValue('maxLength', LValue) then
LFieldInfo.AddAttribute('[MVCMaxLength(' + LValue + ')]');
LTypeInfo.Fields.Add(LFieldInfo);
end;
delphiUnit.AddType(LTypeInfo);
end;
procedure TSwagDocToDelphiMVCFrameworkBuilder.ConvertSwaggerDefinitionsToTypeDefinitions(delphiUnit: TDelphiUnit);
var
LTypeInfo: TUnitTypeDefinition;
LJsonProps: TJSONObject;
LFieldInfo: TUnitFieldDefinition;
LTypeObj: TJSONObject;
i: Integer;
j: Integer;
LValue : string;
begin
for i := 0 to fSwagDoc.Definitions.Count - 1 do
begin
LTypeInfo := TUnitTypeDefinition.Create;
LTypeInfo.TypeName := 'T' + CapitalizeFirstLetter(fSwagDoc.Definitions[i].Name);
LJsonProps := fSwagDoc.Definitions[i].JsonSchema.Values['properties'] as TJSONObject;
for j := 0 to LJsonProps.Count - 1 do
begin
OutputDebugString(PChar(LJsonProps.Pairs[j].ToJSON));
LFieldInfo := TUnitFieldDefinition.Create;
LFieldInfo.FieldName := LJsonProps.Pairs[j].JsonString.Value;
LTypeObj := LJsonProps.Pairs[j].JsonValue as TJSONObject;
if Assigned(LTypeObj.Values['type']) then
LFieldInfo.FieldType := LTypeObj.Values['type'].Value
else
LFieldInfo.FieldType := ConvertRefToType(LTypeObj.Values['$ref'].Value);
if LFieldInfo.FieldType = 'number' then
LFieldInfo.FieldType := 'Double'
else if LFieldInfo.FieldType = 'object' then
begin
LFieldInfo.FieldType := 'T' + CapitalizeFirstLetter(LJsonProps.Pairs[j].JsonString.Value);
ChildType(DelphiUnit, LJsonProps.Pairs[j]);
end
else if LFieldInfo.FieldType = 'array' then
begin
HandleArray(LFieldInfo, LJsonProps.Pairs[j]);
end;
if LTypeObj.TryGetValue('description', LValue) then
begin
if LValue.Trim.Length > 0 then
LFieldInfo.AddAttribute('[MVCDoc(' + QuotedStr(LValue) + ')]');
end;
if LTypeObj.TryGetValue('format', LValue) then
begin
if (LFieldInfo.FieldType.ToLower = 'integer') and (LValue.ToLower = 'int64') then
LFieldInfo.FieldType := 'Int64';
LFieldInfo.AddAttribute('[MVCFormat(' + QuotedStr(LValue) + ')]');
end;
if LTypeObj.TryGetValue('maxLength', LValue) then
LFieldInfo.AddAttribute('[MVCMaxLength(' + LValue + ')]');
if LTypeObj.TryGetValue('minimum', LValue) then
LFieldInfo.AddAttribute('[MVCMinimum(' + LValue + ')]');
if LTypeObj.TryGetValue('maximum', LValue) then
LFieldInfo.AddAttribute('[MVCMaximum(' + LValue + ')]');
LTypeInfo.Fields.Add(LFieldInfo);
end;
delphiUnit.AddType(LTypeInfo);
end;
end;
function TSwagDocToDelphiMVCFrameworkBuilder.SwaggerTypeAsString(ASwaggerType: TSwagTypeParameter):string;
begin
Result := TypInfo.GetEnumName(System.TypeInfo(TSwagTypeParameter), Integer(ASwaggerType));
end;
function TSwagDocToDelphiMVCFrameworkBuilder.InLocationAsString(ASwaggerType: TSwagRequestParameterInLocation):string;
begin
Result := TypInfo.GetEnumName(System.TypeInfo(TSwagRequestParameterInLocation), Integer(ASwaggerType));
end;
function TSwagDocToDelphiMVCFrameworkBuilder.ConvertSwaggerTypeToDelphiType(inSwaggerType: TSwagRequestParameter): TUnitTypeDefinition;
var
LSwaggerType : TSwagTypeParameter;
json : TJSONObject;
begin
Result := TUnitTypeDefinition.Create;
LSwaggerType := inSwaggerType.TypeParameter;
case LSwaggerType of
stpNotDefined:
begin
if Assigned(inSwaggerType.Schema.JsonSchema.Values['$ref']) then
Result.TypeName := ConvertRefToType(inSwaggerType.Schema.JsonSchema.Values['$ref'].Value)
else
begin
Result.TypeName := inSwaggerType.Schema.JsonSchema.Values['type'].Value;
if Result.TypeName = 'array' then
begin
if Assigned(inSwaggerType.Schema.JsonSchema.Values['items']) then
if Assigned((inSwaggerType.Schema.JsonSchema.Values['items'] as TJSONObject).Values['$ref']) then
Result.TypeName := 'array of ' + ConvertRefToType((inSwaggerType.Schema.JsonSchema.Values['items'] as TJSONObject).Values['$ref'].Value);
end;
end;
end;
stpString: Result.TypeName := 'String';
stpNumber: Result.TypeName := 'Double';
stpInteger: Result.TypeName := 'Integer';
stpBoolean: Result.TypeName := 'Boolean';
stpArray:
begin
json := inSwaggerType.Schema.JsonSchema;
if Assigned(json) then
begin
OutputDebugString(PChar('TYPE: ' + json.ToJson));
Result.TypeName := 'array of ' + inSwaggerType.Schema.JsonSchema.Values['type'].Value;
end
else
begin
if Assigned(inSwaggerType.Items.Values['type']) then
begin
Result.TypeName := 'array of ' + inSwaggerType.Items.Values['type'].Value;
end
else
Result.TypeName := 'array of ';
end;
end;
stpFile: Result.TypeName := 'err File';
end;
end;
function TSwagDocToDelphiMVCFrameworkBuilder.GenerateUnitText(delphiUnit: TDelphiUnit): string;
begin
delphiUnit.Title := fSwagDoc.Info.Title;
delphiUnit.Description := FSwagDoc.Info.Description;
delphiUnit.License := FSwagDoc.Info.License.Name;
Result := delphiUnit.Generate;
end;
end.

View File

@ -1,17 +0,0 @@
program SampleApi;
uses
System.StartUpCopy,
FMX.Forms,
Sample.Main in 'Sample.Main.pas' {Form1},
mvccontroller in 'mvccontroller.pas',
Sample.SwagDoc.DelphiMVCFramework in 'Sample.SwagDoc.DelphiMVCFramework.pas',
DelphiUnit in 'DelphiUnit.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

View File

@ -1,34 +0,0 @@
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 0
Top = 0
Width = 635
Height = 25
Align = alTop
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 0
Top = 25
Width = 635
Height = 274
Align = alClient
TabOrder = 1
end
end

View File

@ -1,150 +0,0 @@
unit Unit2;
interface
uses
Winapi.Windows
, Winapi.Messages
, System.SysUtils
, System.Variants
, System.Classes
, System.TypInfo
, Vcl.Graphics
, Vcl.Controls
, Vcl.Forms
, Vcl.Dialogs
, Vcl.StdCtrls
, DelphiUnit
;
type
TForm2 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var
delphi : TDelphiUnit;
i: Integer;
NewType : TUnitTypeDefinition;
AddressType : TUnitTypeDefinition;
newField : TUnitFieldDefinition;
method : TUnitMethod;
param : TUnitParameter;
begin
delphi := TDelphiUnit.Create;
try
delphi.UnitFile := 'delphitest';
delphi.AddInterfaceUnit('SysUtils');
AddressType := TUnitTypeDefinition.Create;
AddressType.TypeName := 'TAddress';
AddressType.AddAttribute('[MVCDoc(''This is an Address'')]');
newField := TUnitFieldDefinition.Create;
newField.AddAttribute('[MVCDoc(''Address'')]');
newField.FieldName := 'Addr';
newField.FieldType := 'String';
AddressType.Fields.Add(newField);
newField := TUnitFieldDefinition.Create;
newField.AddAttribute('[MVCDoc(''Address'')]');
newField.FieldName := 'Addr';
newField.FieldType := 'String';
AddressType.Fields.Add(newField);
newField := TUnitFieldDefinition.Create;
newField.AddAttribute('[MVCDoc(''Enter Your City'')]');
newField.FieldName := 'City';
newField.FieldType := 'String';
AddressType.Fields.Add(newField);
newField := TUnitFieldDefinition.Create;
newField.AddAttribute('[MVCDoc(''Enter Your Postcode'')]');
newField.FieldName := 'Postcode';
newField.FieldType := 'String';
AddressType.Fields.Add(newField);
delphi.AddType(AddressType);
NewType := TUnitTypeDefinition.Create;
NewType.TypeName := 'TEmployee';
NewType.AddAttribute('[MVCDoc(''This is some text'')]');
newField := TUnitFieldDefinition.Create;
newField.AddAttribute('[MVCDoc(''Employee Number'')]');
newField.AddAttribute('[MVCContraint(0, 10000)]');
newField.FieldName := 'EmpNo';
newField.FieldType := 'Integer';
NewType.Fields.Add(newField);
newField := TUnitFieldDefinition.Create;
newField.FieldName := 'EmpName';
newField.FieldType := 'String';
NewType.Fields.Add(newField);
newField := TUnitFieldDefinition.Create;
newField.FieldName := 'Address';
newField.FieldType := 'TAddress';
NewType.Fields.Add(newField);
method := TUnitMethod.Create;
method.Name := 'TestMethod';
method.MethodKind := TMethodKind.mkFunction;
method.ReturnType := AddressType;
param := TUnitParameter.Create;
param.ParamName := 'inFirstParam';
param.Flags := [pfVar];
param.ParamType := AddressType;
method.AddParameter(param);
NewType.FMethods.Add(method);
delphi.AddType(NewType);
Memo1.Lines.Add(delphi.GenerateInterfaceSectionStart);
Memo1.Lines.Add(delphi.GenerateInterfaceUses);
if delphi.TypeDefinitions.Count > 0 then
Memo1.Lines.Add('type');
for i := 0 to delphi.TypeDefinitions.Count - 1 do
begin
Memo1.Lines.Add(delphi.TypeDefinitions[i].GenerateInterface);
end;
Memo1.Lines.Add(delphi.GenerateImplementationSectionStart);
Memo1.Lines.Add(delphi.GenerateImplementationUses);
for i := 0 to delphi.TypeDefinitions.Count - 1 do
begin
for method in delphi.TypeDefinitions[i].GetMethods do
begin
Memo1.Lines.Add(method.GenerateImplementation(delphi.TypeDefinitions[i]));
end;
end;
Memo1.Lines.Add('end.');
finally
FreeAndNil(delphi);
end;
end;
end.

View File

@ -1,475 +0,0 @@
unit mvccontroller;
interface
uses
MVCFramework
, MVCFramework.Commons
, MVCFramework.Logger
, MVCFramework.JWT
, Generics.Collections
, Swag.Common.Types
;
(*
Title: Swagger Petstore
Description: This is a sample server Petstore server. You can find out more about Swagger at [http://swagger.io](http://swagger.io) or on [irc.freenode.net, #swagger](http://swagger.io/irc/). For this sample, you can use the api key `special-key` to test the authorization filters.
License: Apache 2.0
*)
type
TApiResponse = class
[MVCFormat('int32')]
code : integer;
&type : string;
message : string;
end;
TCategory = class
[MVCFormat('int64')]
id : Int64;
name : string;
end;
TOrder = class
[MVCFormat('int64')]
id : Int64;
[MVCFormat('int64')]
petId : Int64;
[MVCFormat('int32')]
quantity : integer;
[MVCFormat('date-time')]
shipDate : string;
[MVCDoc('Order Status')]
status : string;
complete : boolean;
end;
TTag = class
[MVCFormat('int64')]
id : Int64;
name : string;
end;
TPet = class
[MVCFormat('int64')]
id : Int64;
category : TCategory;
name : string;
photoUrls : array of string;
tags : array of TTag;
[MVCDoc('pet status in the store')]
status : string;
end;
TUser = class
[MVCFormat('int64')]
id : Int64;
username : string;
firstName : string;
lastName : string;
email : string;
password : string;
phone : string;
[MVCDoc('User Status')]
[MVCFormat('int32')]
userStatus : integer;
end;
[MVCPath('/v2')]
TMyMVCController = class(TMVCController)
[MVCPath('/pet')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('body', rpiBody, TPet)]
[MVCResponse(HTTP_STATUS.MethodNotAllowed, 'Invalid input')]
procedure AddPet;
[MVCPath('/pet')]
[MVCHTTPMethod([httpPUT])]
[MVCParam('body', rpiBody, TPet)]
[MVCResponse(HTTP_STATUS.MethodNotAllowed, 'Validation exception')]
[MVCResponse(HTTP_STATUS.NotFound, 'Pet not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid ID supplied')]
procedure UpdatePet;
[MVCDoc('Multiple status values can be provided with comma separated strings')]
[MVCPath('/pet/findByStatus')]
[MVCHTTPMethod([httpGET])]
[MVCParam('status', rpiQuery, stpArray)]
[MVCResponseList(HTTP_STATUS.OK, 'successful operation', TPet)]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid status value')]
procedure FindPetsByStatus;
[MVCDoc('Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing.')]
[MVCPath('/pet/findByTags')]
[MVCHTTPMethod([httpGET])]
[MVCParam('tags', rpiQuery, stpArray)]
[MVCResponseList(HTTP_STATUS.OK, 'successful operation', TPet)]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid tag value')]
procedure FindPetsByTags;
[MVCDoc('Returns a single pet')]
[MVCPath('/pet/($petId)')]
[MVCHTTPMethod([httpGET])]
[MVCResponse(HTTP_STATUS.OK, 'successful operation', TPet)]
[MVCResponse(HTTP_STATUS.NotFound, 'Pet not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid ID supplied')]
procedure GetPetById([MVCDoc('ID of pet to return')] [MVCPathParam(stpInteger, '', 'int64')] petId: Int64);
[MVCPath('/pet/($petId)')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('name', rpiFormData, stpString)]
[MVCParam('status', rpiFormData, stpString)]
[MVCResponse(HTTP_STATUS.MethodNotAllowed, 'Invalid input')]
procedure UpdatePetWithForm([MVCDoc('ID of pet that needs to be updated')] [MVCPathParam(stpInteger, '', 'int64')] petId: Int64);
[MVCPath('/pet/($petId)')]
[MVCHTTPMethod([httpDELETE])]
[MVCParam('api_key', rpiHeader, stpString)]
[MVCResponse(HTTP_STATUS.NotFound, 'Pet not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid ID supplied')]
procedure DeletePet([MVCDoc('Pet id to delete')] [MVCPathParam(stpInteger, '', 'int64')] petId: Int64);
[MVCPath('/pet/($petId)/uploadImage')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('additionalMetadata', rpiFormData, stpString)]
[MVCParam('file', rpiFormData, stpFile)]
[MVCResponse(HTTP_STATUS.OK, 'successful operation', TApiResponse)]
procedure UploadFile([MVCDoc('ID of pet to update')] [MVCPathParam(stpInteger, '', 'int64')] petId: Int64);
[MVCDoc('Returns a map of status codes to quantities')]
[MVCPath('/store/inventory')]
[MVCHTTPMethod([httpGET])]
procedure GetInventory;
[MVCPath('/store/order')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('body', rpiBody, TOrder)]
[MVCResponse(HTTP_STATUS.OK, 'successful operation', TOrder)]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid Order')]
procedure PlaceOrder;
[MVCDoc('For valid response try integer IDs with value >= 1 and <= 10. Other values will generated exceptions')]
[MVCPath('/store/order/($orderId)')]
[MVCHTTPMethod([httpGET])]
[MVCResponse(HTTP_STATUS.OK, 'successful operation', TOrder)]
[MVCResponse(HTTP_STATUS.NotFound, 'Order not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid ID supplied')]
procedure GetOrderById([MVCDoc('ID of pet that needs to be fetched')] [MVCPathParam(stpInteger, '', 'int64')] orderId: Int64);
[MVCDoc('For valid response try integer IDs with positive integer value. Negative or non-integer values will generate API errors')]
[MVCPath('/store/order/($orderId)')]
[MVCHTTPMethod([httpDELETE])]
[MVCResponse(HTTP_STATUS.NotFound, 'Order not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid ID supplied')]
procedure DeleteOrder([MVCDoc('ID of the order that needs to be deleted')] [MVCPathParam(stpInteger, '', 'int64')] orderId: Int64);
[MVCDoc('This can only be done by the logged in user.')]
[MVCPath('/user')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('body', rpiBody, TUser)]
[MVCResponse(HTTP_STATUS.OK, 'successful operation')]
procedure CreateUser;
[MVCPath('/user/createWithArray')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('body', rpiBody, stpNotDefined)]
[MVCResponse(HTTP_STATUS.OK, 'successful operation')]
procedure CreateUsersWithArrayInput;
[MVCPath('/user/createWithList')]
[MVCHTTPMethod([httpPOST])]
[MVCParam('body', rpiBody, stpNotDefined)]
[MVCResponse(HTTP_STATUS.OK, 'successful operation')]
procedure CreateUsersWithListInput;
[MVCPath('/user/login')]
[MVCHTTPMethod([httpGET])]
[MVCParam('username', rpiQuery, stpString)]
[MVCParam('password', rpiQuery, stpString)]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid username/password supplied')]
procedure LoginUser;
[MVCPath('/user/logout')]
[MVCHTTPMethod([httpGET])]
[MVCResponse(HTTP_STATUS.OK, 'successful operation')]
procedure LogoutUser;
[MVCPath('/user/($username)')]
[MVCHTTPMethod([httpGET])]
[MVCResponse(HTTP_STATUS.OK, 'successful operation', TUser)]
[MVCResponse(HTTP_STATUS.NotFound, 'User not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid username supplied')]
procedure GetUserByName([MVCDoc('The name that needs to be fetched. Use user1 for testing. ')] [MVCPathParam(stpString)] username: String);
[MVCDoc('This can only be done by the logged in user.')]
[MVCPath('/user/($username)')]
[MVCHTTPMethod([httpPUT])]
[MVCParam('body', rpiBody, TUser)]
[MVCResponse(HTTP_STATUS.NotFound, 'User not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid user supplied')]
procedure UpdateUser([MVCDoc('name that need to be updated')] [MVCPathParam(stpString)] username: String);
[MVCDoc('This can only be done by the logged in user.')]
[MVCPath('/user/($username)')]
[MVCHTTPMethod([httpDELETE])]
[MVCResponse(HTTP_STATUS.NotFound, 'User not found')]
[MVCResponse(HTTP_STATUS.BadRequest, 'Invalid username supplied')]
procedure DeleteUser([MVCDoc('The name that needs to be deleted')] [MVCPathParam(stpString)] username: String);
end;
implementation
uses
Swag.Doc
;
procedure TMyMVCController.AddPet;
var
paramBody : TPet;
begin
paramBody := Context.Request.BodyAs<TPet>;
// 405 Invalid input
end;
procedure TMyMVCController.UpdatePet;
var
paramBody : TPet;
begin
paramBody := Context.Request.BodyAs<TPet>;
// 405 Validation exception
// 404 Pet not found
// 400 Invalid ID supplied
end;
procedure TMyMVCController.FindPetsByStatus;
var
paramStatus : String;
Pet : TObjectList<TPet>;
begin
paramStatus := Context.Request.Params['status'];
Pet := Context.Request.BodyAsListOf<TPet>;
{TODO: Implement filling Pet }
Render(HTTP_STATUS.OK, Pet);
// 400 Invalid status value
end;
procedure TMyMVCController.FindPetsByTags;
var
paramTags : String;
Pet : TObjectList<TPet>;
begin
paramTags := Context.Request.Params['tags'];
Pet := Context.Request.BodyAsListOf<TPet>;
{TODO: Implement filling Pet }
Render(HTTP_STATUS.OK, Pet);
// 400 Invalid tag value
end;
procedure TMyMVCController.GetPetById(petId: Int64);
var
Pet : TPet;
begin
Pet := TPet.Create;
{TODO: Implement filling Pet }
Render(HTTP_STATUS.OK, Pet);
// 404 Pet not found
// 400 Invalid ID supplied
end;
procedure TMyMVCController.UpdatePetWithForm(petId: Int64);
var
paramName : String;
paramStatus : String;
begin
paramName := Context.Request.Params['name'];
paramStatus := Context.Request.Params['status'];
// 405 Invalid input
end;
procedure TMyMVCController.DeletePet(petId: Int64);
var
paramApi_key : String;
begin
paramApi_key := Context.Request.Params['api_key'];
// 404 Pet not found
// 400 Invalid ID supplied
end;
procedure TMyMVCController.UploadFile(petId: Int64);
var
paramAdditionalMetadata : String;
paramFile : String;
ApiResponse : TApiResponse;
begin
paramAdditionalMetadata := Context.Request.Params['additionalMetadata'];
paramFile := Context.Request.Params['file'];
ApiResponse := TApiResponse.Create;
{TODO: Implement filling ApiResponse }
Render(HTTP_STATUS.OK, ApiResponse);
end;
procedure TMyMVCController.GetInventory;
begin
end;
procedure TMyMVCController.PlaceOrder;
var
paramBody : TOrder;
Order : TOrder;
begin
paramBody := Context.Request.BodyAs<TOrder>;
Order := TOrder.Create;
{TODO: Implement filling Order }
Render(HTTP_STATUS.OK, Order);
// 400 Invalid Order
end;
procedure TMyMVCController.GetOrderById(orderId: Int64);
var
Order : TOrder;
begin
Order := TOrder.Create;
{TODO: Implement filling Order }
Render(HTTP_STATUS.OK, Order);
// 404 Order not found
// 400 Invalid ID supplied
end;
procedure TMyMVCController.DeleteOrder(orderId: Int64);
begin
// 404 Order not found
// 400 Invalid ID supplied
end;
procedure TMyMVCController.CreateUser;
var
paramBody : TUser;
begin
paramBody := Context.Request.BodyAs<TUser>;
// default successful operation
end;
procedure TMyMVCController.CreateUsersWithArrayInput;
var
paramBody : TObjectList<TUser>;
begin
paramBody := Context.Request.BodyAsListOf<TUser>;
// default successful operation
end;
procedure TMyMVCController.CreateUsersWithListInput;
var
paramBody : TObjectList<TUser>;
begin
paramBody := Context.Request.BodyAsListOf<TUser>;
// default successful operation
end;
procedure TMyMVCController.LoginUser;
var
paramUsername : String;
paramPassword : String;
begin
paramUsername := Context.Request.Params['username'];
paramPassword := Context.Request.Params['password'];
// 400 Invalid username/password supplied
end;
procedure TMyMVCController.LogoutUser;
begin
// default successful operation
end;
procedure TMyMVCController.GetUserByName(username: String);
var
User : TUser;
begin
User := TUser.Create;
{TODO: Implement filling User }
Render(HTTP_STATUS.OK, User);
// 404 User not found
// 400 Invalid username supplied
end;
procedure TMyMVCController.UpdateUser(username: String);
var
paramBody : TUser;
begin
paramBody := Context.Request.BodyAs<TUser>;
// 404 User not found
// 400 Invalid user supplied
end;
procedure TMyMVCController.DeleteUser(username: String);
begin
// 404 User not found
// 400 Invalid username supplied
end;
end.

File diff suppressed because one or more lines are too long

View File

@ -1,7 +1,7 @@
object Form1: TForm1
object MainForm: TMainForm
Left = 271
Top = 114
Caption = 'Form1'
Caption = 'Swagger Doc API'
ClientHeight = 165
ClientWidth = 376
Color = clBtnFace

View File

@ -18,7 +18,7 @@ uses
IdContext;
type
TForm1 = class(TForm)
TMainForm = class(TForm)
ButtonStart: TButton;
ButtonStop: TButton;
EditPort: TEdit;
@ -43,7 +43,7 @@ type
end;
var
Form1: TForm1;
MainForm: TMainForm;
implementation
@ -52,14 +52,14 @@ implementation
uses
WinApi.Windows, Winapi.ShellApi;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
ButtonStart.Enabled := not FServer.Active;
ButtonStop.Enabled := FServer.Active;
EditPort.Enabled := not FServer.Active;
end;
procedure TForm1.ButtonOpenBrowserClick(Sender: TObject);
procedure TMainForm.ButtonOpenBrowserClick(Sender: TObject);
var
LURL: string;
begin
@ -68,36 +68,36 @@ begin
ShellExecute(0, nil, PChar(LURL), nil, nil, SW_SHOWNOACTIVATE);
end;
procedure TForm1.ButtonStartClick(Sender: TObject);
procedure TMainForm.ButtonStartClick(Sender: TObject);
begin
StartServer;
end;
procedure TForm1.ButtonStopClick(Sender: TObject);
procedure TMainForm.ButtonStopClick(Sender: TObject);
begin
FServer.Active := False;
FServer.Bindings.Clear;
end;
procedure TForm1.FormCreate(Sender: TObject);
procedure TMainForm.FormCreate(Sender: TObject);
begin
FServer := TIdHTTPWebBrokerBridge.Create(Self);
FServer.OnParseAuthentication := OnParseAuthentication;
end;
procedure TForm1.FormShow(Sender: TObject);
procedure TMainForm.FormShow(Sender: TObject);
begin
ButtonOpenBrowser.Click;
end;
procedure TForm1.OnParseAuthentication(AContext: TIdContext; const AAuthType, AAuthData: String; var VUsername,
procedure TMainForm.OnParseAuthentication(AContext: TIdContext; const AAuthType, AAuthData: String; var VUsername,
VPassword: String; var VHandled: Boolean);
begin
if SameText(AAuthType, 'Bearer') then
VHandled := True;
end;
procedure TForm1.StartServer;
procedure TMainForm.StartServer;
begin
if not FServer.Active then
begin

View File

@ -5,7 +5,7 @@ uses
Vcl.Forms,
Web.WebReq,
IdHTTPWebBrokerBridge,
MainFormU in 'MainFormU.pas' {Form1},
MainFormU in 'MainFormU.pas' {MainForm},
WebModuleMainU in 'WebModuleMainU.pas' {WebModule1: TWebModule},
MyController1U in 'MyController1U.pas',
MyController2U in 'MyController2U.pas',
@ -19,6 +19,6 @@ begin
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

View File

@ -102,7 +102,7 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="MainFormU.pas">
<Form>Form1</Form>
<Form>MainForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="WebModuleMainU.pas">

View File

@ -554,6 +554,10 @@ begin
begin
Exit(LowerCase(AProperty.Name));
end;
ncCamelCase:
begin
Exit(LowerCase(AProperty.Name.Chars[0]) + AProperty.Name.Substring(1));
end;
end;
end;
end;

View File

@ -7,7 +7,6 @@
// https://github.com/danieleteti/delphimvcframework
//
// Collaborators on this file:
// Ezequiel Juliano Müller (ezequieljuliano@gmail.com)
// João Antônio Duarte (https://github.com/joaoduarte19)
//
// ***************************************************************************