Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Modernized FileUpload sample

Browse Source
This commit is contained in:
Daniele Teti 2024-04-10 17:12:42 +02:00
parent 59cd33cb40
commit dea575f3df
13 changed files with 158 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
samples/fileupload/FileUploadControllerU.pas
View File

@ -4,6 +4,7 @@ interface
uses
ReqMulti, // this unit is required to enable file uploading
System.Generics.Collections,
MVCFramework,
MVCFramework.Commons,
MVCFramework.Logger;
@ -12,21 +13,21 @@ type
[MVCPath]
TFileUploadController = class(TMVCController)
private const
public const
UPLOAD_FOLDER = 'uploadedfiles';
private
function GetFiles: TList<String>;
protected
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); override;
public
[MVCPath('/')]
[MVCHTTPMethod([httpGET])]
procedure Index;
function Index: string;
[MVCPath('/file/upload')]
[MVCHTTPMethod([httpPOST])]
procedure SaveFile(CTX: TWebContext);
[MVCPath('/file/list')]
[MVCProduces('text/html')]
[MVCHTTPMethod([httpGET])]
procedure FileList(CTX: TWebContext);
function SaveFile: IMVCResponse;
end;
implementation
@ -35,60 +36,94 @@ uses
system.ioutils,
system.Classes,
system.SysUtils,
system.Types;
system.Types,
JsonDataObjects;
{ TFileUploadController }
procedure TFileUploadController.FileList(CTX: TWebContext);
//function TFileUploadController.FileList: String;
//var
// lFileNames: TList<String>;
//begin
// lFileNames := GetFiles;
// try
// ViewData['files'] := lFileNames;
// Result := PageFragment(['filelist']);
// finally
// lFileNames.free;
// end;
//end;
function TFileUploadController.GetFiles: TList<String>;
var
lUploadedFiles: TStringDynArray;
lUploadedFiles: TArray<string>;
lFName: string;
begin
LoadView(['header']);
// ResponseStream.AppendLine('<!doctype html><html><body>');
ResponseStream.AppendLine('<h2>**Upload Folder Content**</h2>');
lUploadedFiles := TDirectory.GetFiles(UPLOAD_FOLDER);
ResponseStream.AppendLine('<ul>');
for lFName in lUploadedFiles do
begin
ResponseStream.AppendLine('<li>' + ExtractFileName(lFName) + '</li>');
Result := TList<String>.Create;
try
for lFName in lUploadedFiles do
begin
Result.Add(ExtractFileName(lFName));
end;
except
Result.Free;
raise;
end;
ResponseStream.AppendLine('</ul>')
.AppendLine('<p><a href="/">&lt;&lt; BACK TO HOME</a></p>');
LoadView(['footer']);
RenderResponseStream;
end;
procedure TFileUploadController.Index;
function TFileUploadController.Index: String;
var
lFileNames: TList<String>;
begin
LoadView(['header', 'fileupload', 'footer']);
RenderResponseStream();
lFileNames := GetFiles;
try
ViewData['files'] := lFileNames;
ViewData['files_count'] := lFileNames.Count;
Result := Page(['fileupload','filelist']);
finally
lFileNames.free;
end;
end;
procedure TFileUploadController.SaveFile(CTX: TWebContext);
procedure TFileUploadController.OnBeforeAction(AContext: TWebContext;
const AActionName: string; var AHandled: Boolean);
begin
inherited;
SetPagesCommonHeaders(['header']);
SetPagesCommonFooters(['footer']);
end;
function TFileUploadController.SaveFile: IMVCResponse;
var
lFName: string;
I: Integer;
lFile: TFileStream;
begin
TDirectory.CreateDirectory(UPLOAD_FOLDER);
for I := 0 to CTX.Request.RawWebRequest.Files.Count - 1 do
if Context.Request.RawWebRequest.Files.Count <> 1 then
begin
lFName := String(CTX.Request.Files[I].FileName);
lFName := TPath.GetFileName(lFName.Trim(['"']));
if not TPath.HasValidFileNameChars(lFName, false) then
raise EMVCException.Create
(lFName + ' is not a valid filename for the hosting OS');
Log('Uploading ' + lFName);
lFile := TFile.Create(TPath.Combine(UPLOAD_FOLDER, lFName));
try
lFile.CopyFrom(CTX.Request.Files[I].Stream, 0);
finally
lFile.free;
end;
Exit(RedirectResponse('/'));
end;
Redirect('/file/list');
lFName := String(Context.Request.Files[0].FileName);
lFName := TPath.GetFileName(lFName.Trim(['"']));
if not TPath.HasValidFileNameChars(lFName, false) then
begin
raise EMVCException.Create
(HTTP_STATUS.BadRequest, lFName + ' is not a valid filename for the hosting OS');
end;
if TFile.Exists(TPath.Combine(UPLOAD_FOLDER, lFName)) then
begin
raise EMVCException.Create
(HTTP_STATUS.BadRequest, lFName + ' already present, cannot override');
end;
Log('Uploading ' + lFName);
lFile := TFile.Create(TPath.Combine(UPLOAD_FOLDER, lFName));
try
lFile.CopyFrom(Context.Request.Files[0].Stream, 0);
finally
lFile.free;
end;
Result := RedirectResponse('/');
end;
end.

12
samples/fileupload/FilesUploadDemo.dpr
View File

@ -10,12 +10,11 @@ uses
Winapi.ShellAPI,
{$ENDIF }
IdHTTPWebBrokerBridge,
MVCFramework.Logger,
Web.WebReq,
Web.WebBroker,
WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
FileUploadControllerU in 'FileUploadControllerU.pas',
MVCFramework.View.Renderers.TemplatePro in '..\serversideviewcustom\MVCFramework.View.Renderers.TemplatePro.pas',
TemplateProU in '..\serversideviewcustom\lib\TemplateProU.pas';
FileUploadControllerU in 'FileUploadControllerU.pas', System.IOUtils;
{$R *.res}
@ -24,12 +23,12 @@ procedure RunServer(APort: Integer);
var
LServer: TIdHTTPWebBrokerBridge;
begin
Writeln(Format('Starting HTTP Server or port %d', [APort]));
LogI(Format('Starting HTTP Server or port %d', [APort]));
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
LServer.Active := True;
Writeln('Press RETURN to stop the server');
LogI('Press RETURN to stop the server');
{$IFDEF MSWINDOWS}
ShellExecute(0, 'open', 'http://localhost:3000', nil, nil, SW_SHOW);
@ -42,13 +41,14 @@ begin
end;
begin
TDirectory.CreateDirectory(TFileUploadController.UPLOAD_FOLDER);
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
RunServer(3000);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
LogE(E.ClassName + ': ' + E.Message);
end
end.

17
samples/fileupload/FilesUploadDemo.dproj
View File

@ -50,7 +50,7 @@
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
@ -76,6 +76,7 @@
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppDPIAwarenessMode>none</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
@ -92,8 +93,6 @@
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<DCCReference Include="FileUploadControllerU.pas"/>
<DCCReference Include="..\serversideviewcustom\MVCFramework.View.Renderers.TemplatePro.pas"/>
<DCCReference Include="..\serversideviewcustom\lib\TemplateProU.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@ -156,8 +155,10 @@
<VersionInfoKeys Name="CFBundleDevelopmentRegion"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k170.bpl">Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp170.bpl">Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="4">
@ -180,6 +181,12 @@
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx64\libcgsqlite3.dylib" Class="DependencyModule"/>
<DeployFile LocalName="Win32\Debug\FilesUploadDemo.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Debug\FilesUploadDemo.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FilesUploadDemo.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>

1
samples/fileupload/WebModuleUnit1.dfm
View File

@ -1,5 +1,4 @@
object WebModule1: TWebModule1
OldCreateOrder = False
OnCreate = WebModuleCreate
Actions = <
item

9
samples/fileupload/WebModuleUnit1.pas
View File

@ -27,7 +27,7 @@ implementation
uses
FileUploadControllerU,
MVCFramework.Commons,
MVCFramework.View.Renderers.TemplatePro,
MVCFramework.View.Renderers.Mustache,
MVCFramework.Middleware.Trace,
MVCFramework.Middleware.StaticFiles;
@ -40,17 +40,16 @@ begin
procedure(Config: TMVCConfig)
begin
Config[TMVCConfigKey.ViewPath] :=
ExtractFilePath(GetModuleName(HInstance)) + '..\..\templates';
ExtractFilePath(GetModuleName(HInstance)) + '..\templates';
Config[TMVCConfigKey.DefaultContentType] := TMVCMediaType.TEXT_HTML;
end);
MVC.AddController(TFileUploadController);
MVC.AddMiddleware(TMVCTraceMiddleware.Create);
MVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(
'/static', { StaticFilesPath }
ExtractFilePath(GetModuleName(HInstance)) + '..\..\document_root', { DocumentRoot }
ExtractFilePath(GetModuleName(HInstance)) + '..\www', { DocumentRoot }
'index.html' { IndexDocument - Before it was named fallbackresource }
));
MVC.SetViewEngine(TMVCTemplateProViewEngine);
MVC.SetViewEngine(TMVCMustacheViewEngine);
end;

11
samples/fileupload/document_root/milligram.min.css vendored
View File

File diff suppressed because one or more lines are too long

2
samples/fileupload/templates/error.html Normal file
View File

@ -0,0 +1,2 @@
<h3>❌ {{error}}</h3>
<div><a href="/">👉 Back to home</a></div>

7
samples/fileupload/templates/filelist.html Normal file
View File

@ -0,0 +1,7 @@
<h3>There are {{files_count}} uploaded files</h3>
<ul>
{{#files}}
<li>{{.}}</li>
{{/files}}
</ul>

3
samples/fileupload/templates/fileupload.html
View File

@ -1,4 +1,5 @@
<form action="/file/upload" method="post" enctype="multipart/form-data">
<input class="btn" type="file" name="fupload">
<input type="submit">
<hr>
<input type="submit" value="Upload">
</form>

3
samples/fileupload/templates/header.html
View File

@ -1,6 +1,7 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="/static/milligram.min.css"/>
<link rel="stylesheet" href="/static/milligram.min.css"/>
</head>
<body>
<div class="container">

3
samples/fileupload/www/milligram.min.css vendored Normal file
View File

File diff suppressed because one or more lines are too long

10
sources/MVCFramework.Commons.pas
View File

@ -247,7 +247,17 @@ type
/// </summary>
NotModified = 304;
UseProxy = 305;
/// <summary>
/// HTTP 307 Temporary Redirect redirect status response code indicates that the resource requested has been temporarily moved to the URL given by the Location headers.
/// The method and the body of the original request are reused to perform the redirected request. In the cases where you want the method used to be changed to GET, use 303 See Other instead. This is useful when you want to give an answer to a PUT method that is not the uploaded resources, but a confirmation message (like "You successfully uploaded XYZ").
/// The only difference between 307 and 302 is that 307 guarantees that the method and the body will not be changed when the redirected request is made. With 302, some old clients were incorrectly changing the method to GET: the behavior with non-GET methods and 302 is then unpredictable on the Web, whereas the behavior with 307 is predictable. For GET requests, their behavior is identical.
/// </summary>
TemporaryRedirect = 307;
/// <summary>
/// The HyperText Transfer Protocol (HTTP) 308 Permanent Redirect redirect status response code indicates that the resource requested has been definitively moved to the URL given by the Location headers. A browser redirects to this page and search engines update their links to the resource (in 'SEO-speak', it is said that the 'link-juice' is sent to the new URL).
/// The request method and the body will not be altered, whereas 301 may incorrectly sometimes be changed to a GET method.
/// </summary>
PermanentRedirect = 308;
// Client Error 4xx
/// <summary>
/// The request could not be understood by the server due to malformed syntax. The client SHOULD NOT repeat the request without modifications.

35
sources/MVCFramework.pas
View File

@ -742,6 +742,7 @@ type
UnsupportedMediaTypeResult
ConflictResult
InternalServerErrorResult
RedirectResult
}
function OKResponse(const Body: TObject): IMVCResponse; overload;
@ -754,7 +755,8 @@ type
function BadRequestResponse(const Error: TObject): IMVCResponse; overload;
function CreatedResponse(const Location: string = ''; const Body: TObject = nil): IMVCResponse;
function AcceptedResponse(const Location: string = ''; const Body: TObject = nil): IMVCResponse;
function ConflictResult: IMVCResponse;
function ConflictResponse: IMVCResponse;
function RedirectResponse(Location: String; Permanent: Boolean = False; PreserveMethod: Boolean = False): IMVCResponse;
function InternalServerErrorResponse: IMVCResponse;
/// <summary>
@ -3968,7 +3970,7 @@ begin
Result := StatusCodeResponseWithOptionalBody(HTTP_STATUS.BadRequest, Error);
end;
function TMVCRenderer.ConflictResult: IMVCResponse;
function TMVCRenderer.ConflictResponse: IMVCResponse;
begin
Result := StatusCodeResponseWithOptionalBody(HTTP_STATUS.Conflict, nil);
end;
@ -4078,6 +4080,35 @@ end;
end;
function TMVCRenderer.RedirectResponse(Location: String; Permanent: Boolean = False; PreserveMethod: Boolean = False): IMVCResponse;
var
lBuilder: IMVCResponseBuilder;
begin
lBuilder := MVCResponseBuilder.Header('location', Location);
if Permanent then
begin
if PreserveMethod then
begin
Result := lBuilder.StatusCode(HTTP_STATUS.TemporaryRedirect).Build;
end
else
begin
Result := lBuilder.StatusCode(HTTP_STATUS.MovedPermanently).Build;
end;
end
else
begin
if PreserveMethod then
begin
Result := lBuilder.StatusCode(HTTP_STATUS.PermanentRedirect).Build;
end
else
begin
Result := lBuilder.StatusCode(HTTP_STATUS.Found).Build;
end;
end;
end;
function TMVCRenderer.InternalServerErrorResponse: IMVCResponse;
begin
Result := StatusCodeResponseWithOptionalBody(HTTP_STATUS.InternalServerError, nil);