mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
Merge branch 'master' of https://github.com/pedrooliveira01/delphimvcframework
This commit is contained in:
Pedro
commit
0a49f8e539
@ -9,9 +9,10 @@ object dmMain: TdmMain
|
||||
'B'
|
||||
'User_Name=sysdba'
|
||||
'Password=masterkey'
|
||||
'Protocol=TCPIP'
|
||||
'Server=localhost'
|
||||
'DriverID=FB')
|
||||
ConnectedStoredUsage = []
|
||||
Connected = True
|
||||
LoginPrompt = False
|
||||
BeforeConnect = ConnectionBeforeConnect
|
||||
Left = 64
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{300F83FF-8F7B-43FD-B740-A3DFDF7238ED}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>jsonrpcclientwithobjects.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{AF5FBC36-0D1D-4C07-B2E3-C2A2E688AC6F}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>jsonrpcserverwithobjects.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
|
||||
@ -105,7 +105,7 @@ type
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/customers/($id).html')]
|
||||
[MVCProduces('text/html')]
|
||||
procedure GetPerson_AsHTML(CTX: TWebContext);
|
||||
procedure GetPerson_AsHTML;
|
||||
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/customers.csv')]
|
||||
@ -114,7 +114,7 @@ type
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/customers/unicode/($id).html')]
|
||||
[MVCProduces('text/html', 'UTF-8')]
|
||||
procedure GetUnicodeText_AsHTML(CTX: TWebContext);
|
||||
procedure GetUnicodeText_AsHTML;
|
||||
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/customers/($id)')]
|
||||
@ -133,7 +133,16 @@ type
|
||||
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/images/customers/($id)')]
|
||||
procedure GetPersonPhotoAsStream(CTX: TWebContext);
|
||||
procedure GetPersonPhotoAsStream;
|
||||
|
||||
[MVCHTTPMethod([httpPOST])]
|
||||
[MVCConsumes(TMVCMediaType.MULTIPART_FORM_DATA)]
|
||||
[MVCPath('/files')]
|
||||
procedure UploadBinaryData;
|
||||
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/files/($filename)')]
|
||||
procedure GetBinaryData(const filename: string);
|
||||
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
[MVCPath('/exception')]
|
||||
@ -153,7 +162,9 @@ uses
|
||||
MVCFramework.DataSet.Utils,
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.Serializer.Defaults,
|
||||
MVCFramework.Logger,
|
||||
MyDataModuleU,
|
||||
System.IOUtils,
|
||||
System.Classes,
|
||||
System.SysUtils,
|
||||
WebModuleU,
|
||||
@ -161,11 +172,12 @@ uses
|
||||
InMemoryDataU,
|
||||
JsonDataObjects,
|
||||
MVCFramework.Serializer.JsonDataObjects,
|
||||
Data.DB;
|
||||
Data.DB,
|
||||
Web.HTTPApp;
|
||||
|
||||
{ TRoutingSampleController }
|
||||
|
||||
procedure TRenderSampleController.GetUnicodeText_AsHTML(CTX: TWebContext);
|
||||
procedure TRenderSampleController.GetUnicodeText_AsHTML;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
@ -192,6 +204,76 @@ begin
|
||||
Render(IntToStr(10 div a));
|
||||
end;
|
||||
|
||||
procedure TRenderSampleController.UploadBinaryData;
|
||||
var
|
||||
lFile: TAbstractWebRequestFile;
|
||||
lFileExt: string;
|
||||
lOutputFileName: string;
|
||||
lOutputFullPath: string;
|
||||
lOutFile: TFileStream;
|
||||
lOutputFolder: string;
|
||||
begin
|
||||
if Context.Request.Files.Count <> 1 then
|
||||
begin
|
||||
raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Expected exactly 1 file');
|
||||
end;
|
||||
lFile := Context.Request.Files[0];
|
||||
|
||||
LogI(Format('Upload: [FieldName: %s] [FileName: %s] [ContentType: %s] [Size: %d bytes]',
|
||||
[lFile.FieldName, lFile.filename, lFile.ContentType, lFile.Stream.Size]));
|
||||
|
||||
{ Be sure that our data directory always exists. We could also do it in the server startup. }
|
||||
lOutputFolder := TPath.Combine(AppPath, 'uploadedfiles');
|
||||
if not TDirectory.Exists(lOutputFolder) then
|
||||
begin
|
||||
TDirectory.CreateDirectory(lOutputFolder);
|
||||
end;
|
||||
|
||||
lFileExt := TPath.GetExtension(lFile.filename);
|
||||
{
|
||||
Here we could check for allowed extensions or check the file contents looking for
|
||||
accepted file headers (e.g. Zip, PNG, BMP, TIFF etc).
|
||||
In this case we just use the extension of the filename sent by the client.
|
||||
}
|
||||
|
||||
{ Find a valid random filename to store the stream on disk. }
|
||||
repeat
|
||||
lOutputFileName := TPath.ChangeExtension(TPath.GetRandomFileName, lFileExt);
|
||||
lOutputFullPath := TPath.Combine(lOutputFolder, lOutputFileName);
|
||||
until not TFile.Exists(lOutputFullPath);
|
||||
|
||||
lOutFile := TFileStream.Create(lOutputFullPath, fmCreate);
|
||||
try
|
||||
lOutFile.CopyFrom(lFile.Stream, 0);
|
||||
finally
|
||||
lOutFile.Free;
|
||||
end;
|
||||
|
||||
{ Inform the client about the name assigned to the file
|
||||
on disk and how to retrieve it. }
|
||||
Context.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
|
||||
Context.Response.StatusCode := HTTP_STATUS.OK;
|
||||
Render(Dict(['filename', 'ref'], [lOutputFileName, '/files/' + lOutputFileName]));
|
||||
end;
|
||||
|
||||
procedure TRenderSampleController.GetBinaryData(const filename: string);
|
||||
var
|
||||
lFilesFolder: string;
|
||||
lFullFilePath: string;
|
||||
begin
|
||||
lFilesFolder := TPath.Combine(AppPath, 'uploadedfiles');
|
||||
lFullFilePath := TPath.Combine(lFilesFolder, filename);
|
||||
if not TFile.Exists(lFullFilePath) then
|
||||
begin
|
||||
raise EMVCException.Create('File not found');
|
||||
end;
|
||||
Context.Response.ContentType := TMVCMediaType.APPLICATION_OCTET_STREAM;
|
||||
Context.Response.StatusCode := HTTP_STATUS.OK;
|
||||
Context.Response.CustomHeaders.Values['Content-Disposition'] := 'attachment; filename=' +
|
||||
filename + ';';
|
||||
Render(TFileStream.Create(lFullFilePath, fmOpenRead or fmShareDenyNone));
|
||||
end;
|
||||
|
||||
procedure TRenderSampleController.GetCustomerByID_AsTObject(const id: Integer);
|
||||
var
|
||||
Cust: TCustomer;
|
||||
@ -302,7 +384,7 @@ begin
|
||||
Render<TPerson>(GetPeopleList, False);
|
||||
end;
|
||||
|
||||
procedure TRenderSampleController.GetPerson_AsHTML(CTX: TWebContext);
|
||||
procedure TRenderSampleController.GetPerson_AsHTML;
|
||||
begin
|
||||
ResponseStream.Append('<html><body><ul>').Append('<li>FirstName: Daniele</li>')
|
||||
.Append('<li>LastName: Teti')
|
||||
@ -537,7 +619,7 @@ begin
|
||||
SendFile('..\..\_\customer.png');
|
||||
end;
|
||||
|
||||
procedure TRenderSampleController.GetPersonPhotoAsStream(CTX: TWebContext);
|
||||
procedure TRenderSampleController.GetPersonPhotoAsStream;
|
||||
var
|
||||
LPhoto: TFileStream;
|
||||
begin
|
||||
|
||||
@ -315,31 +315,31 @@
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\RenderSampleControllerU\default.txaPackage" Configuration="Release" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Release" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Debug" Class="ProjectFile">
|
||||
<Platform Name="Linux64">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\default.txvpck" Configuration="Release" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Debug" Class="ProjectFile">
|
||||
<Platform Name="Linux64">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\RenderSampleControllerU\default.txaPackage" Configuration="Release" Class="ProjectFile">
|
||||
<DeployFile LocalName="ModelSupport_renders\default.txvpck" Configuration="Release" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
@ -357,7 +357,7 @@
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Release" Class="ProjectFile">
|
||||
<DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
|
||||
@ -725,7 +725,7 @@ var
|
||||
begin
|
||||
lQry := TFDQuery.Create(nil);
|
||||
try
|
||||
lQry.FetchOptions.Unidirectional := True;
|
||||
lQry.FetchOptions.Unidirectional := False; //True;
|
||||
if Connection = nil then
|
||||
begin
|
||||
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
|
||||
|
||||
@ -43,16 +43,17 @@ uses
|
||||
|
||||
{$I dmvcframeworkbuildconsts.inc}
|
||||
|
||||
|
||||
type
|
||||
|
||||
TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD, httpOPTIONS, httpPATCH, httpTRACE);
|
||||
TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD, httpOPTIONS, httpPATCH,
|
||||
httpTRACE);
|
||||
|
||||
TMVCHTTPMethods = set of TMVCHTTPMethodType;
|
||||
|
||||
TMVCMediaType = record
|
||||
public const
|
||||
APPLICATION_ATOM_XML = 'application/atom+xml';
|
||||
APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded';
|
||||
APPLICATION_JSON = 'application/json';
|
||||
APPLICATION_OCTET_STREAM = 'application/octet-stream';
|
||||
APPLICATION_SVG_XML = 'application/svg+xml';
|
||||
@ -61,6 +62,7 @@ type
|
||||
APPLICATION_OCTETSTREAM = 'application/octet-stream';
|
||||
MEDIA_TYPE_WILDCARD = '*';
|
||||
MULTIPART_FORM_DATA = 'multipart/form-data';
|
||||
APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded';
|
||||
TEXT_HTML = 'text/html';
|
||||
TEXT_PLAIN = 'text/plain';
|
||||
TEXT_XML = 'text/xml';
|
||||
@ -288,7 +290,8 @@ type
|
||||
{ protected declarations }
|
||||
public
|
||||
constructor Create(const AMsg: string); overload; virtual;
|
||||
constructor Create(const AMsg: string; const ADetailedMessage: string; const AAppErrorCode: UInt16;
|
||||
constructor Create(const AMsg: string; const ADetailedMessage: string;
|
||||
const AAppErrorCode: UInt16;
|
||||
const AHttpErrorCode: UInt16 = HTTP_STATUS.InternalServerError); overload; virtual;
|
||||
constructor Create(const AHttpErrorCode: UInt16; const AMsg: string); overload; virtual;
|
||||
constructor CreateFmt(const AMsg: string; const AArgs: array of const); reintroduce;
|
||||
@ -354,7 +357,8 @@ type
|
||||
protected
|
||||
FDict: TDictionary<string, string>;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
constructor Create; overload; virtual;
|
||||
constructor Create(const aKey, aValue: String); overload; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function Add(const Name, Value: string): TMVCStringDictionary;
|
||||
@ -416,7 +420,7 @@ type
|
||||
|
||||
function GetValue(const AIndex: string): string;
|
||||
function GetValueAsInt64(const AIndex: string): Int64;
|
||||
procedure SetValue(const AIndex: string; const AValue: string);
|
||||
procedure SetValue(const AIndex: string; const aValue: string);
|
||||
protected
|
||||
{ protected declarations }
|
||||
public
|
||||
@ -451,9 +455,9 @@ function AppPath: string;
|
||||
function IsReservedOrPrivateIP(const AIP: string): Boolean; inline;
|
||||
function IP2Long(const AIP: string): UInt32; inline;
|
||||
|
||||
function B64Encode(const AValue: string): string; overload;
|
||||
function B64Encode(const AValue: TBytes): string; overload;
|
||||
function B64Decode(const AValue: string): string;
|
||||
function B64Encode(const aValue: string): string; overload;
|
||||
function B64Encode(const aValue: TBytes): string; overload;
|
||||
function B64Decode(const aValue: string): string;
|
||||
|
||||
function URLSafeB64encode(const Value: string; IncludePadding: Boolean): string; overload;
|
||||
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): string; overload;
|
||||
@ -466,12 +470,17 @@ procedure SplitContentMediaTypeAndCharset(const aContentType: string; var aConte
|
||||
var aContentCharSet: string);
|
||||
function BuildContentType(const aContentMediaType: string; const aContentCharSet: string): string;
|
||||
|
||||
function Dict: TMVCStringDictionary; overload;
|
||||
function Dict(const aKeys: array of string; const aValues: array of string)
|
||||
: TMVCStringDictionary; overload;
|
||||
|
||||
const
|
||||
MVC_HTTP_METHODS_WITHOUT_CONTENT: TMVCHTTPMethods = [httpGET, httpDELETE, httpHEAD, httpOPTIONS];
|
||||
MVC_HTTP_METHODS_WITH_CONTENT: TMVCHTTPMethods = [httpPOST, httpPUT, httpPATCH];
|
||||
|
||||
const
|
||||
MVC_COMPRESSION_TYPE_AS_STRING: array [TMVCCompressionType] of string = ('none', 'deflate', 'gzip');
|
||||
MVC_COMPRESSION_TYPE_AS_STRING: array [TMVCCompressionType] of string = ('none',
|
||||
'deflate', 'gzip');
|
||||
MVC_COMPRESSION_ZLIB_WINDOW_BITS: array [TMVCCompressionType] of Integer = (0, -15, 31);
|
||||
// WindowBits: http://zlib.net/manual.html#Advanced
|
||||
|
||||
@ -480,15 +489,19 @@ var
|
||||
|
||||
const
|
||||
RESERVED_IPS: array [1 .. 11] of array [1 .. 2] of string = (('0.0.0.0', '0.255.255.255'),
|
||||
('10.0.0.0', '10.255.255.255'), ('127.0.0.0', '127.255.255.255'), ('169.254.0.0', '169.254.255.255'),
|
||||
('10.0.0.0', '10.255.255.255'), ('127.0.0.0', '127.255.255.255'),
|
||||
('169.254.0.0', '169.254.255.255'),
|
||||
('172.16.0.0', '172.31.255.255'), ('192.0.2.0', '192.0.2.255'), ('192.88.99.0', '192.88.99.255'),
|
||||
('192.168.0.0', '192.168.255.255'), ('198.18.0.0', '198.19.255.255'), ('224.0.0.0', '239.255.255.255'),
|
||||
('192.168.0.0', '192.168.255.255'), ('198.18.0.0', '198.19.255.255'),
|
||||
('224.0.0.0', '239.255.255.255'),
|
||||
('240.0.0.0', '255.255.255.255'));
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
IdCoder3to4, JsonDataObjects, MVCFramework.Serializer.JsonDataObjects;
|
||||
IdCoder3to4,
|
||||
JsonDataObjects,
|
||||
MVCFramework.Serializer.JsonDataObjects;
|
||||
|
||||
var
|
||||
GlobalAppName, GlobalAppPath, GlobalAppExe: string;
|
||||
@ -517,7 +530,8 @@ begin
|
||||
if AIP.IsEmpty then
|
||||
Exit(0);
|
||||
lPieces := AIP.Split(['.']);
|
||||
Result := (StrToInt(lPieces[0]) * 16777216) + (StrToInt(lPieces[1]) * 65536) + (StrToInt(lPieces[2]) * 256) +
|
||||
Result := (StrToInt(lPieces[0]) * 16777216) + (StrToInt(lPieces[1]) * 65536) +
|
||||
(StrToInt(lPieces[2]) * 256) +
|
||||
StrToInt(lPieces[3]);
|
||||
end;
|
||||
|
||||
@ -526,22 +540,22 @@ end;
|
||||
// Result := IdGlobal.IPv4ToUInt32(AIP);
|
||||
// end;
|
||||
|
||||
function B64Encode(const AValue: string): string; overload;
|
||||
function B64Encode(const aValue: string): string; overload;
|
||||
begin
|
||||
// Do not use TNetEncoding
|
||||
Result := TIdEncoderMIME.EncodeString(AValue);
|
||||
Result := TIdEncoderMIME.EncodeString(aValue);
|
||||
end;
|
||||
|
||||
function B64Encode(const AValue: TBytes): string; overload;
|
||||
function B64Encode(const aValue: TBytes): string; overload;
|
||||
begin
|
||||
// Do not use TNetEncoding
|
||||
Result := TIdEncoderMIME.EncodeBytes(TIdBytes(AValue));
|
||||
Result := TIdEncoderMIME.EncodeBytes(TIdBytes(aValue));
|
||||
end;
|
||||
|
||||
function B64Decode(const AValue: string): string;
|
||||
function B64Decode(const aValue: string): string;
|
||||
begin
|
||||
// Do not use TNetEncoding
|
||||
Result := TIdDecoderMIME.DecodeString(AValue);
|
||||
Result := TIdDecoderMIME.DecodeString(aValue);
|
||||
end;
|
||||
|
||||
function ByteToHex(AInByte: Byte): string;
|
||||
@ -576,7 +590,8 @@ begin
|
||||
begin
|
||||
Result := lContentMediaType;
|
||||
end
|
||||
else if lContentMediaType.StartsWith('text/') or lContentMediaType.StartsWith('application/') then
|
||||
else if lContentMediaType.StartsWith('text/') or lContentMediaType.StartsWith('application/')
|
||||
then
|
||||
begin
|
||||
Result := lContentMediaType + ';charset=' + aContentCharSet.ToLower;
|
||||
end
|
||||
@ -596,7 +611,8 @@ begin
|
||||
begin
|
||||
lContentTypeValues := aContentType.Split([';']);
|
||||
aContentMediaType := Trim(lContentTypeValues[0]);
|
||||
if (Length(lContentTypeValues) > 1) and (lContentTypeValues[1].Trim.StartsWith('charset', True)) then
|
||||
if (Length(lContentTypeValues) > 1) and (lContentTypeValues[1].Trim.StartsWith('charset', True))
|
||||
then
|
||||
begin
|
||||
aContentCharSet := lContentTypeValues[1].Trim.Split(['='])[1].Trim;
|
||||
end
|
||||
@ -622,7 +638,8 @@ begin
|
||||
FAppErrorCode := 0;
|
||||
end;
|
||||
|
||||
constructor EMVCException.Create(const AMsg, ADetailedMessage: string; const AAppErrorCode, AHttpErrorCode: UInt16);
|
||||
constructor EMVCException.Create(const AMsg, ADetailedMessage: string;
|
||||
const AAppErrorCode, AHttpErrorCode: UInt16);
|
||||
begin
|
||||
Create(AMsg);
|
||||
FHttpErrorCode := AHttpErrorCode;
|
||||
@ -667,7 +684,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCCriticalSectionHelper.DoWithLockTimeout(const AAction: TProc; const ATimeOut: UInt32): TWaitResult;
|
||||
function TMVCCriticalSectionHelper.DoWithLockTimeout(const AAction: TProc; const ATimeOut: UInt32)
|
||||
: TWaitResult;
|
||||
begin
|
||||
Result := Self.WaitFor(ATimeOut);
|
||||
if (Result = TWaitResult.wrSignaled) then
|
||||
@ -716,7 +734,8 @@ var
|
||||
lStreamReader: TStreamReader;
|
||||
lSer: TMVCJsonDataObjectsSerializer;
|
||||
begin
|
||||
lStreamReader := TStreamReader.Create(TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite), TEncoding.ASCII);
|
||||
lStreamReader := TStreamReader.Create(TFileStream.Create(AFileName,
|
||||
fmOpenRead or fmShareDenyWrite), TEncoding.ASCII);
|
||||
try
|
||||
lStreamReader.OwnStream;
|
||||
lConfigString := lStreamReader.ReadToEnd;
|
||||
@ -738,9 +757,9 @@ begin
|
||||
TFile.WriteAllText(AFileName, ToString, TEncoding.ASCII);
|
||||
end;
|
||||
|
||||
procedure TMVCConfig.SetValue(const AIndex, AValue: string);
|
||||
procedure TMVCConfig.SetValue(const AIndex, aValue: string);
|
||||
begin
|
||||
FConfig.Add(AIndex, AValue);
|
||||
FConfig.Add(AIndex, aValue);
|
||||
end;
|
||||
|
||||
function TMVCConfig.ToString: string;
|
||||
@ -778,6 +797,12 @@ begin
|
||||
Result := FDict.Count;
|
||||
end;
|
||||
|
||||
constructor TMVCStringDictionary.Create(const aKey, aValue: String);
|
||||
begin
|
||||
Create;
|
||||
Add(aKey, aValue);
|
||||
end;
|
||||
|
||||
constructor TMVCStringDictionary.Create;
|
||||
begin
|
||||
inherited;
|
||||
@ -877,7 +902,8 @@ type
|
||||
end;
|
||||
|
||||
const
|
||||
GURLSafeBase64CodeTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
|
||||
GURLSafeBase64CodeTable
|
||||
: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
|
||||
{ Do not Localize }
|
||||
|
||||
procedure TURLSafeEncode.InitComponent;
|
||||
@ -984,12 +1010,35 @@ begin
|
||||
Self.WriteBuffer(UFTStr[Low(UFTStr)], Length(UFTStr));
|
||||
end;
|
||||
|
||||
function Dict: TMVCStringDictionary; overload;
|
||||
begin
|
||||
Result := TMVCStringDictionary.Create;
|
||||
end;
|
||||
|
||||
function Dict(const aKeys: array of string; const aValues: array of string)
|
||||
: TMVCStringDictionary; overload;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if Length(aKeys) <> Length(aValues) then
|
||||
begin
|
||||
raise EMVCException.CreateFmt('Dict error. Got %d keys but %d values',
|
||||
[Length(aKeys), Length(aValues)]);
|
||||
end;
|
||||
Result := Dict();
|
||||
for I := Low(aKeys) to High(aKeys) do
|
||||
begin
|
||||
Result.Add(aKeys[i], aValues[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
Lock := TObject.Create;
|
||||
|
||||
// SGR 2017-07-03 : Initialize decoding table for URLSafe Gb64 encoding
|
||||
TURLSafeDecode.ConstructDecodeTable(GURLSafeBase64CodeTable, TURLSafeDecode.GSafeBaseBase64DecodeTable);
|
||||
TURLSafeDecode.ConstructDecodeTable(GURLSafeBase64CodeTable,
|
||||
TURLSafeDecode.GSafeBaseBase64DecodeTable);
|
||||
|
||||
GlobalAppExe := ExtractFileName(GetModuleName(HInstance));
|
||||
GlobalAppName := ChangeFileExt(GlobalAppExe, EmptyStr);
|
||||
|
||||
@ -79,8 +79,7 @@ uses
|
||||
LoggerPro,
|
||||
IdGlobal,
|
||||
IdGlobalProtocols,
|
||||
IdURI,
|
||||
MVCFramework.Commons;
|
||||
IdURI, MVCFramework.Commons;
|
||||
|
||||
type
|
||||
|
||||
@ -438,7 +437,7 @@ type
|
||||
procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = '');
|
||||
// Serializer access
|
||||
function Serializer: IMVCSerializer; overload;
|
||||
function Serializer(const AContentType: string): IMVCSerializer; overload;
|
||||
function Serializer(const AContentType: string; const ARaiseExcpIfNotExists: Boolean = True): IMVCSerializer; overload;
|
||||
end;
|
||||
|
||||
IMVCAuthenticationHandler = interface
|
||||
@ -465,7 +464,7 @@ type
|
||||
procedure Redirect(const AUrl: string); virtual;
|
||||
procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); virtual;
|
||||
function Serializer: IMVCSerializer; overload;
|
||||
function Serializer(const AContentType: string): IMVCSerializer; overload;
|
||||
function Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean = True): IMVCSerializer; overload;
|
||||
procedure SendStream(const AStream: TStream; const AOwns: Boolean = True; const ARewind: Boolean = False); virtual;
|
||||
procedure SendFile(const AFileName: string); virtual;
|
||||
procedure RenderResponseStream; virtual;
|
||||
@ -712,7 +711,7 @@ type
|
||||
procedure HTTP404(const AContext: TWebContext);
|
||||
procedure HTTP500(const AContext: TWebContext; const AReasonString: string = '');
|
||||
procedure SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
|
||||
const AReasonString: string);
|
||||
const AReasonString: string; const AClassName: String = '');
|
||||
|
||||
property ViewEngineClass: TMVCViewEngineClass read GetViewEngineClass;
|
||||
property WebModule: TWebModule read FWebModule;
|
||||
@ -1893,7 +1892,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]));
|
||||
SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]), E.ClassName);
|
||||
end;
|
||||
end;
|
||||
on E: EInvalidOp do
|
||||
@ -1907,7 +1906,7 @@ begin
|
||||
else
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
|
||||
Format('[%s] %s', [E.Classname, E.Message]));
|
||||
Format('[%s] %s', [E.Classname, E.Message]), E.Classname);
|
||||
end;
|
||||
end;
|
||||
on E: Exception do
|
||||
@ -1922,7 +1921,7 @@ begin
|
||||
else
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
|
||||
Format('[%s] %s', [E.Classname, E.Message]));
|
||||
Format('[%s] %s', [E.Classname, E.Message]), E.Classname);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -2177,7 +2176,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
|
||||
const AReasonString: string);
|
||||
const AReasonString: string; const AClassName: String);
|
||||
var
|
||||
lSer: IMVCSerializer;
|
||||
lError: TMVCErrorResponse;
|
||||
@ -2188,7 +2187,7 @@ begin
|
||||
begin
|
||||
lError := TMVCErrorResponse.Create;
|
||||
try
|
||||
lError.Classname := '';
|
||||
lError.Classname := AClassName;
|
||||
lError.StatusCode := HTTPStatusCode;
|
||||
lError.Message := AReasonString;
|
||||
AContext.Response.SetContent(lSer.SerializeObject(lError));
|
||||
@ -2201,7 +2200,6 @@ begin
|
||||
begin
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
|
||||
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
|
||||
AContext.Response.SetContent(GetServerSignature(AContext) + sLineBreak + 'HTTP ' + HTTPStatusCode.ToString + ': ' +
|
||||
AReasonString);
|
||||
end;
|
||||
@ -2702,15 +2700,27 @@ begin
|
||||
GetContext.Response.RawWebResponse.FreeContentStream := True;
|
||||
end;
|
||||
|
||||
function TMVCRenderer.Serializer(const AContentType: string): IMVCSerializer;
|
||||
function TMVCRenderer.Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean): IMVCSerializer;
|
||||
var
|
||||
lContentMediaType: string;
|
||||
lContentCharSet: string;
|
||||
begin
|
||||
SplitContentMediaTypeAndCharset(AContentType.ToLower, lContentMediaType, lContentCharSet);
|
||||
if not Engine.Serializers.ContainsKey(lContentMediaType) then
|
||||
raise EMVCException.CreateFmt('The serializer for %s could not be found.', [lContentMediaType]);
|
||||
Result := Engine.Serializers.Items[lContentMediaType];
|
||||
if Engine.Serializers.ContainsKey(lContentMediaType) then
|
||||
begin
|
||||
Result := Engine.Serializers.Items[lContentMediaType];
|
||||
end
|
||||
else
|
||||
begin
|
||||
if ARaiseExceptionIfNotExists then
|
||||
begin
|
||||
raise EMVCException.CreateFmt('The serializer for %s could not be found.', [lContentMediaType]);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCController.SessionAs<T>: T;
|
||||
@ -2973,6 +2983,10 @@ begin
|
||||
R.Items.Add(I);
|
||||
end;
|
||||
end;
|
||||
if Serializer(GetContentType, False) = nil then
|
||||
begin
|
||||
GetContext.Response.ContentType := GetConfig[TMVCConfigKey.DefaultContentType];
|
||||
end;
|
||||
Render(R, False);
|
||||
finally
|
||||
R.Free;
|
||||
|
||||
@ -42,8 +42,13 @@ uses
|
||||
Vcl.Grids,
|
||||
Vcl.ValEdit,
|
||||
FireDAC.Phys.MySQLDef,
|
||||
FireDAC.Phys.MySQL, FireDAC.Phys.PGDef, FireDAC.Phys.PG, FireDAC.Phys.IBDef,
|
||||
FireDAC.Phys.IB, FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteDef,
|
||||
FireDAC.Phys.MySQL,
|
||||
FireDAC.Phys.PGDef,
|
||||
FireDAC.Phys.PG,
|
||||
FireDAC.Phys.IBDef,
|
||||
FireDAC.Phys.IB,
|
||||
FireDAC.Stan.ExprFuncs,
|
||||
FireDAC.Phys.SQLiteDef,
|
||||
FireDAC.Phys.SQLite;
|
||||
|
||||
type
|
||||
@ -153,7 +158,8 @@ begin
|
||||
fImplBuff.WriteString(' inherited Create;' + sLineBreak);
|
||||
for F := low(lFieldsName) to high(lFieldsName) do
|
||||
begin
|
||||
fImplBuff.WriteString(' ' + lFieldsName[F] + ' := ' + lTypesName[F] + '.Create;' + sLineBreak);
|
||||
fImplBuff.WriteString(' ' + lFieldsName[F] + ' := ' + lTypesName[F] + '.Create;' +
|
||||
sLineBreak);
|
||||
end;
|
||||
fImplBuff.WriteString('end;' + sLineBreak + sLineBreak);
|
||||
|
||||
@ -237,46 +243,81 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMainForm.EmitField(F: TField);
|
||||
var
|
||||
lAttrib, lField: String;
|
||||
begin
|
||||
fIntfBuff.WriteString(Format(' [MVCTableField(''%s'')]', [F.FieldName]) + sLineBreak + ' ' + GetFieldName(F.FieldName) + ': ' +
|
||||
GetDelphiType(F.DataType) + ';' + sLineBreak);
|
||||
lAttrib := Format(' [MVCTableField(''%s'')]', [F.FieldName]);
|
||||
lField := GetFieldName(F.FieldName) + ': ' + GetDelphiType(F.DataType) + ';' + sLineBreak;
|
||||
|
||||
if GetDelphiType(F.DataType).ToUpper.Contains('UNSUPPORTED TYPE') then
|
||||
begin
|
||||
lAttrib := ' //' + lAttrib;
|
||||
lField := ' //' + lField;
|
||||
end
|
||||
else
|
||||
begin
|
||||
lField := ' ' + lField;
|
||||
lAttrib := ' ' + lAttrib;
|
||||
end;
|
||||
fIntfBuff.WriteString(lAttrib + sLineBreak + lField);
|
||||
end;
|
||||
|
||||
procedure TMainForm.EmitHeaderComments;
|
||||
begin
|
||||
fIntfBuff.WriteString('// *************************************************************************** }' + sLineBreak);
|
||||
fIntfBuff.WriteString
|
||||
('// *************************************************************************** }' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Delphi MVC Framework' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// https://github.com/danieleteti/delphimvcframework' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak);
|
||||
fIntfBuff.WriteString
|
||||
('// ***************************************************************************' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Licensed under the Apache License, Version 2.0 (the "License");' + sLineBreak);
|
||||
fIntfBuff.WriteString('// you may not use this file except in compliance with the License.' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Licensed under the Apache License, Version 2.0 (the "License");' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('// you may not use this file except in compliance with the License.' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('// You may obtain a copy of the License at' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// http://www.apache.org/licenses/LICENSE-2.0' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Unless required by applicable law or agreed to in writing, software' + sLineBreak);
|
||||
fIntfBuff.WriteString('// distributed under the License is distributed on an "AS IS" BASIS,' + sLineBreak);
|
||||
fIntfBuff.WriteString('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.' + sLineBreak);
|
||||
fIntfBuff.WriteString('// See the License for the specific language governing permissions and' + sLineBreak);
|
||||
fIntfBuff.WriteString('// Unless required by applicable law or agreed to in writing, software' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('// distributed under the License is distributed on an "AS IS" BASIS,' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString
|
||||
('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.' + sLineBreak);
|
||||
fIntfBuff.WriteString('// See the License for the specific language governing permissions and' +
|
||||
sLineBreak);
|
||||
fIntfBuff.WriteString('// limitations under the License.' + sLineBreak);
|
||||
fIntfBuff.WriteString('//' + sLineBreak);
|
||||
fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak);
|
||||
fIntfBuff.WriteString
|
||||
('// ***************************************************************************' + sLineBreak);
|
||||
fIntfBuff.WriteString(sLineBreak);
|
||||
end;
|
||||
|
||||
procedure TMainForm.EmitProperty(F: TField);
|
||||
var
|
||||
lProp: String;
|
||||
begin
|
||||
// Buff.WriteString(Format(' [TableField(''%s'')]', [F.FieldName]) + sLineBreak + ' property ' + GetProperCase(F.FieldName) + ': ' +
|
||||
// GetDelphiType(F.DataType) + ';' + sLineBreak);
|
||||
fIntfBuff.WriteString(' property ' + GetFieldName(F.FieldName).Substring(1) { remove f } + ': ' + GetDelphiType(F.DataType));
|
||||
fIntfBuff.WriteString(' read ' + GetFieldName(F.FieldName) + ' write ' + GetFieldName(F.FieldName));
|
||||
fIntfBuff.WriteString(';' + sLineBreak);
|
||||
lProp := 'property ' + GetFieldName(F.FieldName).Substring(1) { remove f } + ': ' +
|
||||
GetDelphiType(F.DataType) +
|
||||
' read ' + GetFieldName(F.FieldName) + ' write ' + GetFieldName(F.FieldName) + ';' + sLineBreak;
|
||||
|
||||
if GetDelphiType(F.DataType).ToUpper.Contains('UNSUPPORTED TYPE') then
|
||||
begin
|
||||
lProp := ' //' + lProp
|
||||
end
|
||||
else
|
||||
begin
|
||||
lProp := ' ' + lProp;
|
||||
end;
|
||||
fIntfBuff.WriteString(lProp)
|
||||
end;
|
||||
|
||||
procedure TMainForm.EmitUnit;
|
||||
@ -359,7 +400,7 @@ begin
|
||||
Result := 'Boolean';
|
||||
ftFloat, ftSingle, ftExtended:
|
||||
Result := 'Double';
|
||||
ftCurrency, ftBCD:
|
||||
ftCurrency, ftBCD, ftFMTBcd:
|
||||
Result := 'Currency';
|
||||
ftDate:
|
||||
Result := 'TDate';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user