(* _ _ * | |__ _ __ ___ ___ | | __ * | '_ \| '__/ _ \ / _ \| |/ / * | |_) | | | (_) | (_) | < * |_.__/|_| \___/ \___/|_|\_\ * * Microframework which helps to develop web Pascal applications. * * Copyright (c) 2012-2021 Silvio Clecio * * Brook framework is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * Brook framework is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with Brook framework; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) program httpuploads; {$IFDEF MSWINDOWS} {$APPTYPE CONSOLE} {$ENDIF} uses SysUtils, IOUtils, BrookUtility, BrookStringMap, BrookHTTPUploads, BrookHTTPRequest, BrookHTTPResponse, BrookHTTPServer; const PAGE_FORM = Concat( '', '', '
', '
', 'Choose the files:', 'File 1:
', 'File 2:
', 'User 1:
', 'User 2:
', '', '
', '
', '', '' ); PAGE_DONE = Concat( '', '', 'Uploads', '', '', 'Uploaded files:
', '%s', 'Users:
', '%s', '', '' ); CONTENT_TYPE = 'text/html; charset=utf-8'; type THTTPServer = class(TBrookHTTPServer) protected procedure DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest; AResponse: TBrookHTTPResponse); override; end; procedure THTTPServer.DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest; AResponse: TBrookHTTPResponse); var VUpload: TBrookHTTPUpload; VField: TBrookStringPair; VFile, VFileList, VUsersList, VError: string; begin if ARequest.IsUploading then begin VFileList := '
    '; for VUpload in ARequest.Uploads do if VUpload.Save(False, VError) then VFileList := Concat(VFileList, '
  1. ', VUpload.Name, '
    2. ') else VFileList := Concat(VFileList, '
  2. ', VUpload.Name, ' - failed - ', VError, '
    3. '); VFileList := Concat(VFileList, '
'); VUsersList := '
    '; for VField in ARequest.Fields do VUsersList := Concat(VUsersList, '
  1. ', VField.Value, '
    2. '); VUsersList := Concat(VUsersList, '
'); AResponse.SendFmt(PAGE_DONE, [VFileList, VUsersList], CONTENT_TYPE, 200); end else begin if ARequest.Params.TryValue('file', VFile) then AResponse.Download(Concat(UploadsDir, PathDelim, VFile)) else AResponse.Send(PAGE_FORM, CONTENT_TYPE, 200); end; end; begin with THTTPServer.Create(nil) do try UploadsDir := TPath.Combine(Sagui.TmpDir, 'uploads'); NoFavicon := True; Open; if not Active then Exit; ForceDirectories(UploadsDir); WriteLn('Server running at http://localhost:', Port); ReadLn; finally Free; end; end.