You are not logged in.
Pages: 1
Hi Arnaud,
we are working on our MVC Server and got this Exception Uploading a File (We want to store a image in DB)
HTML-Code:
<form action="Upload " method="post" enctype="multipart/form-data">
<input name="Data" type="file" size="50">
<input type="submit" name="submit" value="Upload">
</form>
Exception at Line 30015 in mORMot.pas:
function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
var Names,ContentTypes: TRawUTF8DynArray; var Values: TRawByteStringDynArray): boolean;
var boundary: RawUTF8;
i: integer;
begin
result := false;
i := PosEx('boundary=',MimeType);
if i=0 then
exit;
boundary := '--'+trim(copy(MimeType,i+9,200));
// to be done
raise ECommunicationException.Create('multipart/form-data not implemented yet');
end;
Are there any plans to implement the feature ?
Rad Studio 12.1 Santorini
Offline
Hi Arnaud,
i found a Indy Sample Program here: http://www.delphipraxis.net/182835-mult … -mehr.html
It simulates File Upload with Indy.
What we need is in the little Box in First Post. The HTML - Form calls Action=Upload. In Upload it would be nice to have access to the uploaded File.
Sry i'm not the best http - Programmer but i think you made some suggestions as you wrote the Exception - code ?!
program IndyMultipartUploadDemo;
{$APPTYPE CONSOLE}
uses
IdHTTPServer, IdCustomHTTPServer, IdContext, IdSocketHandle, IdGlobal,
IdMessageCoder, IdGlobalProtocols, IdMessageCoderMIME, IdMultiPartFormData,
SysUtils, Classes;
type
TMimeHandler = procedure(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo) of object;
TMyServer = class(TIdHTTPServer)
private
procedure ProcessMimePart(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo);
function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
function MediaTypeMatches(const AValue, AMediaType: String): Boolean;
function GetUploadFolder: string;
procedure HandleMultipartUpload(Request: TIdHTTPRequestInfo; Response:
TIdHTTPResponseInfo; MimeHandler: TMimeHandler);
public
procedure InitComponent; override;
procedure DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override;
end;
procedure Demo;
var
Server: TMyServer;
begin
ReportMemoryLeaksOnShutdown := True;
Server := TMyServer.Create;
try
try
Server.Active := True;
except
on E: Exception do
begin
WriteLn(E.ClassName + ' ' + E.Message);
end;
end;
WriteLn('Hit any key to terminate.');
ReadLn;
finally
Server.Free;
end;
end;
procedure TMyServer.InitComponent;
var
Binding: TIdSocketHandle;
begin
inherited;
Bindings.Clear;
Binding := Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 8080;
KeepAlive := True;
end;
procedure TMyServer.DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentType := 'text/html';
AResponseInfo.CharSet := 'UTF-8';
if ARequestInfo.CommandType = hcGET then
begin
AResponseInfo.ContentText :=
'<!DOCTYPE HTML>' + #13#10
+ '<html>' + #13#10
+ ' <head>' + #13#10
+ ' <title>Multipart Upload Example</title>' + #13#10
+ ' </head>' + #13#10
+ ' <body> ' + #13#10
+ ' <form enctype="multipart/form-data" method="post">' + #13#10
+ ' <fieldset>' + #13#10
+ ' <legend>Standard file upload</legend>' + #13#10
+ ' <label>File input</label>' + #13#10
+ ' <input type="file" class="input-file" name="upload" />' + #13#10
+ ' <button type="submit" class="btn btn-default">Upload</button>' + #13#10
+ ' </fieldset>' + #13#10
+ ' </form>' + #13#10
+ ' </body>' + #13#10
+ '</html>' + #13#10;
end
else
begin
if ARequestInfo.CommandType = hcPOST then
begin
if IsHeaderMediaType(ARequestInfo.ContentType, 'multipart/form-data') then
begin
HandleMultipartUpload(ARequestInfo, AResponseInfo, ProcessMimePart);
end;
end;
end;
end;
// based on code on the Indy and Winsock Forum articles
// http://forums2.atozed.com/viewtopic.php?f=7&t=10924
// http://embarcadero.newsgroups.archived.at/public.delphi.internet.winsock/201107/1107276163.html
procedure TMyServer.ProcessMimePart(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo);
var
LMStream: TMemoryStream;
LNewDecoder: TIdMessageDecoder;
UploadFile: string;
begin
LMStream := TMemoryStream.Create;
try
LNewDecoder := VDecoder.ReadBody(LMStream, VMsgEnd);
if VDecoder.Filename <> '' then
begin
try
LMStream.Position := 0;
Response.ContentText := Response.ContentText
+ Format('<p>%s %d bytes</p>' + #13#10,
[VDecoder.Filename, LMStream.Size]);
// write stream to upload folder
UploadFile := GetUploadFolder + VDecoder.Filename;
LMStream.SaveToFile(UploadFile);
Response.ContentText := Response.ContentText
+ '<p>' + UploadFile + ' written</p>';
except
LNewDecoder.Free;
raise;
end;
end;
VDecoder.Free;
VDecoder := LNewDecoder;
finally
LMStream.Free;
end;
end;
function TMyServer.IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
begin
Result := MediaTypeMatches(ExtractHeaderItem(AHeaderLine), AMediaType);
end;
function TMyServer.MediaTypeMatches(const AValue, AMediaType: String): Boolean;
begin
if Pos('/', AMediaType) > 0 then begin
Result := TextIsSame(AValue, AMediaType);
end else begin
Result := TextStartsWith(AValue, AMediaType + '/');
end;
end;
function TMyServer.GetUploadFolder: string;
begin
Result := ExtractFilePath(ParamStr(0)) + 'upload\';
ForceDirectories(Result);
end;
procedure TMyServer.HandleMultipartUpload(Request: TIdHTTPRequestInfo;
Response: TIdHTTPResponseInfo; MimeHandler: TMimeHandler);
var
LBoundary, LBoundaryStart, LBoundaryEnd: string;
LDecoder: TIdMessageDecoder;
LLine: string;
LBoundaryFound, LIsStartBoundary, LMsgEnd: Boolean;
begin
LBoundary := ExtractHeaderSubItem(Request.ContentType, 'boundary',
QuoteHTTP);
if LBoundary = '' then
begin
Response.ResponseNo := 400;
Response.CloseConnection := True;
Response.WriteHeader;
Exit;
end;
LBoundaryStart := '--' + LBoundary;
LBoundaryEnd := LBoundaryStart + '--';
LDecoder := TIdMessageDecoderMIME.Create(nil);
try
TIdMessageDecoderMIME(LDecoder).MIMEBoundary := LBoundary;
LDecoder.SourceStream := Request.PostStream;
LDecoder.FreeSourceStream := False;
LBoundaryFound := False;
LIsStartBoundary := False;
repeat
LLine := ReadLnFromStream(Request.PostStream, -1, True);
if LLine = LBoundaryStart then
begin
LBoundaryFound := True;
LIsStartBoundary := True;
end
else if LLine = LBoundaryEnd then
begin
LBoundaryFound := True;
end;
until LBoundaryFound;
if (not LBoundaryFound) or (not LIsStartBoundary) then
begin
Response.ResponseNo := 400;
Response.CloseConnection := True;
Response.WriteHeader;
Exit;
end;
LMsgEnd := False;
repeat
TIdMessageDecoderMIME(LDecoder).MIMEBoundary := LBoundary;
LDecoder.SourceStream := Request.PostStream;
LDecoder.FreeSourceStream := False;
LDecoder.ReadHeader;
case LDecoder.PartType of
mcptText, mcptAttachment:
begin
MimeHandler(LDecoder, LMsgEnd, Response);
end;
mcptIgnore:
begin
LDecoder.Free;
LDecoder := TIdMessageDecoderMIME.Create(nil);
end;
mcptEOF:
begin
LDecoder.Free;
LMsgEnd := True;
end;
end;
until (LDecoder = nil) or LMsgEnd;
finally
LDecoder.Free;
end;
end;
begin
Demo;
end.
Rad Studio 12.1 Santorini
Offline
One way could be to use:
https://github.com/blueimp/jQuery-File-Upload
It has an option 'sequentialUploads' which divides up a request into single part multipart/form-data requests. That should make it fairly easy to extract the file from the posted data by just stripping out the headers and two boundary strings. But it wouldn't completely handle multipart/form-data requests.
Offline
I tried to make a first implementation.
1. Added MultiPartFormDataDecode() to decode multipart/form-data POST requests
See http://synopse.info/fossil/info/2358980405
2. Added TSQLRestServerURIContext.InputAsMultiPart() method
See http://synopse.info/fossil/info/d9099ee94b
But be warned!
I've coded this directly, WITHOUT ANY TESTING!
So your feedback is very welcome.
Offline
Hi Arnaud, i testet it an found a very little BUG in SynCommons.pas (24355)
you have to change the PosEx Params to
j := PosEx(boundary,Body,i);
then MultiPartFormDataDecode works as expected i think. Now our all Params are set and "Datei" (filename) has the Image Data as value.
tyvm
function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
var MultiPart: TMultiPartDynArray): boolean;
var boundary: RawUTF8;
i,j: integer;
P: PUTF8Char;
part: TMultiPart;
begin
result := false;
i := PosEx('boundary=',MimeType);
if i=0 then
exit;
boundary := '--'+trim(copy(MimeType,i+9,200))+#13#10;
i := PosEx(boundary,Body);
if i<>0 then
repeat
inc(i,length(boundary));
if i=length(body) then
exit; // reached the end
P := PUTF8Char(Pointer(Body))+i-1;
Finalize(part);
repeat
if IdemPCharAndGetNextItem(P,
'CONTENT-DISPOSITION: FORM-DATA; NAME="',part.Name,'"') then
IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
if IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) or
IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding) then;
GetNextLineBegin(P,P);
if P=nil then
exit;
until PWord(P)^=13+10 shl 8;
i := P-PUTF8Char(Pointer(Body))+3; // i = just after header
j := PosEx(boundary,Body,i);
if j=0 then
exit;
part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
{$ifdef UNICODE}
if part.ContentType='' then
SetCodePage(part.Content,CP_UTF8) else // ensure raw field value is UTF-8
{$endif}
if part.Encoding='base64' then // "quoted-printable" not yet handled here
part.Content := Base64ToBin(part.Content);
SetLength(MultiPart,length(MultiPart)+1);
MultiPart[high(MultiPart)] := part;
result := true;
i := j;
until false;
end;
Rad Studio 12.1 Santorini
Offline
One thing: In the Form we posted i entered german umlaute äöü they where convertet to UTF8 chars i think. After loading them back (Refresh of the page)
ü --> ü
ä --> ä
is this depending on the above routine in other "normal" Forms we do not have this behaviour
Rad Studio 12.1 Santorini
Offline
Thanks for the feedback!
I've included the "j := PosEx(boundary,Body,i)" fix.
About UTF-8, I guess that you may be switching string types.
We use RawUTF8 for all our UTF-8 storage.
Which version of Delphi are you using?
Then by default, all content is UTF-8 encoded.
Did you declare your HTML pages as UTF-8 encoded?
Offline
@ab, the WideCharUtf8 function is not working correctly, for example with 8221 decimal code from an UTF8 character. I convert a XML file with SuperObject, the XML file content no base64 characters (”,€, etc.), then SuperObject convert to Unicode with \u201D,\u20AC codes (following the example). I can see that ü --> ü can be converted correctly using only WideChar(aWideChar) in WideCharToUtf8.
My code converting the XML file to JSON using SuperXMLParser and SuperObject:
var
lConns: RawUTF8;
begin
lFileName := 'cm.daconnections';
lConns := XMLParseString(AnyTextFileToString(lFileName, True)).AsJSON;
fDBConnections := _JSON(lConns);
end;
AnyTextFileToString load OK the file: Database=”Éö±¢§¥¤;UserID=`f`QON;Password=rp{|u‚z|qo;Server=‰‘£‘Ÿ£;
XMLParseString converto OK to JSON: Database=\u201d\u00c9\u00c3\u00b6\u00b1\u00a2\u00a7\u00ad\u00a5\u00a4;UserID=`f`QON;Password=\u0081rp{|u\u201az|qo;Server=\u2030\u2018\u00a3\u009d\u2018\u0178\u00a3;
But _JSON convert as: Database=â€Éö±¢§¥¤;UserID=`f`QON;Password=rp{|u‚z|qo;Server=‰‘£â€˜Å¸£;
The problem is with decimal over 2047: \u201d = 8221 = ” and you can see that the bad conversion is: \u201d = 8221 = â€.
Can you fix it ?
TIA.
Esteban
Offline
Sorry for my bad english. Can you try this code ?
procedure TTestDBService.TestJSONUTF8;
var
lJSONUTF8: RawUTF8;
begin
lJSONUTF8 := '{"Database":"\u201d\u00c9\u00c3\u00b6\u00b1\u00a2\u00a7\u00ad\u00a5\u00a4"}';
Check(_JSON(lJSONUTF8) = '{"Database":"”Éö±¢§¥¤"}', 'Invalid database value');
end;
Debug the SynCommons.WideCharToUtf8, you can see the erroneous conversion of the first char and the rest.
Thanks.
Esteban
Offline
All sounds correct to me.
\u201D is stored as E2 80 9D in UTF-8.
WideCharToUtf8() is perfectly correct (and has been tested as such).
I'm afraid you may be confused about how UTF-8 encoding works.
See http://www.endmemo.com/unicode/unicodeconverter.php
Also ensure that you understand that _JSON() returns a variant, not some text.
Take a look at this code:
V := _JsonFast('{"Database":"\u201d\u00c9\u00c3\u00b6\u00b1\u00a2\u00a7\u00ad\u00a5\u00a4"}');
j := V.Database;
Check((j<>'')and(j[1]=#$E2)and(j[2]=#$80)and(j[3]=#$9D));
So everything works as expected.
Offline
Hi Arnaud back to my topic
It's not easy to explain but i try to...
I debugged my mvcserver and compared 2 HTML - Form Inputs. Form 1 has no enctype and Form 2 has multipart.
I entered öäü in one text field in each form -
and i found a little difference in GetInputAsTDocVariant. (At this point the decision between multipart and normal is done.)
Now the difference:
in Form 1 the loop (mormot.pas - line 30811)adds v = 'öäü' at AddValue(fInput[i*2],v); -> that leads to correct öäü in form1
in Form 2 in the Loop (mormot.pas - line 30821) the v is not correct calculated:
multipart[ i ].content = 'öäü'
but RawUTF8ToVariant sets v to 'öäü'
so you Call AddValue(name, 'öäü') where AddValue(name, 'öäü') would be correct
as result i get 'öäü' in form2
I think: Here is something wrong!
Last edited by itSDS (2015-02-19 11:07:36)
Rad Studio 12.1 Santorini
Offline
In fact, multipart[ i ].content should be a RawByteString, with a code page of CP_UTF8.
So multipart[ i ].content should already be a RawUTF8.
So RawUTF8ToVariant() would just create a varString pointing to this RawUTF8.
What is part.ContentType?
Is SetCodePage(part.Content,CP_UTF8) executed in MultiPartFormDataDecode()?
You may try with http://synopse.info/fossil/info/eb6decc7ea
Offline
Thanks @ab, I now understand. And I this code works for me:
procedure TTestDBService.TestJSONUTF8;
var
lJSONUTF8: RawUTF8;
V: Variant;
begin
lJSONUTF8 := '{"Database":"\u201d\u00c9\u00c3\u00b6\u00b1\u00a2\u00a7\u00ad\u00a5\u00a4"}';
TDocVariantData(V).InitJSON(UTF8ToString(_JSON(lJSONUTF8)));
Check(V.Database='”Éö±¢§¥¤', 'Invalid database value');
end;
Esteban
Offline
the Problem with the German Umlaute is fixed. After SetCodepage ist called the part.content shows the correct öäü instead off 'öäü'
Next week i have time to test if the Filedata of Images is transmitted as expected.
Rad Studio 12.1 Santorini
Offline
Hi AB,
there is a small fix for the multipart feature:
the last boundary ends with '-'
function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
var MultiPart: TMultiPartDynArray): boolean;
var boundary,EndBoundary: RawUTF8;
i,j: integer;
P: PUTF8Char;
part: TMultiPart;
begin
result := false;
i := PosEx('boundary=',MimeType);
if i=0 then
exit;
boundary := '--'+trim(copy(MimeType,i+9,200))+#13#10;
Endboundary := '--'+trim(copy(MimeType,i+9,200))+'--'+#13#10;
i := PosEx(boundary,Body);
if i<>0 then
repeat
inc(i,length(boundary));
if i=length(body) then
exit; // reached the end
P := PUTF8Char(Pointer(Body))+i-1;
Finalize(part);
repeat
if IdemPCharAndGetNextItem(P,
'CONTENT-DISPOSITION: FORM-DATA; NAME="',part.Name,'"') then
IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
if IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) or
IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding) then;
GetNextLineBegin(P,P);
if P=nil then
exit;
until PWord(P)^=13+10 shl 8;
i := P-PUTF8Char(Pointer(Body))+3; // i = just after header
j := PosEx(boundary,Body,i);
if j=0 then
begin // try last bondary
j := PosEx(endboundary,Body,i);
if j=0 then
exit;
end;
part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
{$ifdef UNICODE}
if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then
SetCodePage(part.Content,CP_UTF8,false) else // ensure raw field value is UTF-8
{$endif}
if IdemPropNameU(part.Encoding,'base64') then
part.Content := Base64ToBin(part.Content);
// note: "quoted-printable" not yet handled here
SetLength(MultiPart,length(MultiPart)+1);
MultiPart[high(MultiPart)] := part;
result := true;
i := j;
until false;
end;
Offline
Should have been included by http://synopse.info/fossil/info/8670757265
Thanks a lot!
Offline
Hi AB atm i'm testing the File-Upload again - It does not work or we don't understand how !
We're stuck at
function TSQLRestServerURIContext.GetInputAsTDocVariant: variant;
we upload a png image named test.png.
mutlipart[1].Name = 'ADatei'
mutlipart[1].FileName = 'test.png'
mutlipart[1].ContentType = 'image/png'
mutlipart[1].Encoding = ''
mutlipart[1].Content = '<Binary PNG - Data containing #0 !!>'
Now we have to Problem:
1. RawUTF8ToVariant(Content,v); cuts the Binary data at the first occurance of #0
2. Result contains 2 Variants: ADatei and ADatei-filename afterwards with multipart[1].Filename in ADatei-Filename and "Broken" content in ADatei. How is it possible to access ADatei-Filename ? Which type must the Interface Function have ? Actual we have variant. How can i access ADatei-filename or Directly the complete MultiPart ?
Pls Help
Last edited by itSDS (2015-05-12 13:48:42)
Rad Studio 12.1 Santorini
Offline
Why are you using InputAsTDocVariant?
For a multi-part request, try InputAsMultiPart function directly.
I've enhanced InputAsTDocVariant anyway, for better support of multi-part content.
See http://synopse.info/fossil/info/1262283708
But you should better use InputAsMultiPart() in your case.
Offline
Sry for the missunderstanding, we don't use this function directly
the only thing i wan't to do is writing a interface handler function which gets the multipart as param. And here was the Problem cause we don't know how to get the multipart as one param.
Rad Studio 12.1 Santorini
Offline
Hi Arnaud, with your changes in InputAsTDocVariant it seems to work now. We specified the Interface Param as Variant now. If we use TMultiPart we get an Exception.
Rad Studio 12.1 Santorini
Offline
A ver como realizar una pregunta en este foro y no morir en el intento sin que te manden a leer la peor documentación del mundo
Como agregar enviar un servidor via http.
Tengo esto y funciona.
procedure TForm2.Button5Click(Sender: TObject);
Var
D: Variant;
begin
TDocVariantData(D).AddValue('campo','Nice guy');
Memo1.Text := TWinHTTP.Post('https://utc24h.s1.com.ve/campo', D, 'Content-Type: application/json', true, nil);
end;
Ahora quiere enviar una imagen.
intente esto y no funciona
procedure TForm2.Button3Click(Sender: TObject);
Var
D: Variant;
Imagen: TMemoryStream;
LRawBytes : RawByteString;
begin
Imagen := TMemoryStream.Create;
Try
Imagen.LoadFromFile('C:\Users\Administrador\Desktop\yomismo.jpg');
LRawBytes := StreamToRawByteString(Imagen);
TDocVariantData(D).AddValue('archivo', LRawBytes);
Memo1.Text := TWinHTTP.Post('https://utc24h.s1.com.ve/archivo', D, 'Content-Type: Application/octet-stream', true, nil);
Finally
Imagen.Free;
End;
end;
esto tampoco
procedure TForm2.Button3Click(Sender: TObject);
Var
D: Variant;
Imagen: TMemoryStream;
LRawBytes : RawByteString;
begin
Imagen := TMemoryStream.Create;
Try
Imagen.LoadFromFile('C:\Users\Administrador\Desktop\yomismo.jpg');
LRawBytes := StreamToRawByteString(Imagen);
TDocVariantData(D).AddValue('archivo', LRawBytes);
Memo1.Text := TWinHTTP.Post('https://utc24h.s1.com.ve/archivo', D, 'Content-Type: multipart/form-data; boundary=' +IntToHex(Random(MaxInt), 8) + '_info_boundary', true, nil);
Finally
Imagen.Free;
End;
end;
Offline
No es un framework fácil y la documentación es buena pero hay que leer un poco el código, así lo aprendí. Igual te recomiendo que hagas en inglés las consultas, usá el Google Translator o DeepL Translator.
This is my code uploading files using interface based services using TSQLRestClientURI:
function UpLoadFiles(const aSourceFiles, aDestFolder: RawUTF8; out aNotUploadedFiles: RawUTF8): Boolean;
var
I: Integer;
lMultiPart: TMultiPartDynArray;
lMultiPartFormData: RawUTF8;
lMultiPartContentType: RawUTF8;
lSourceFiles: TRawUTF8DynArray;
lResp: RawUTF8;
begin
Result := False;
CSVToRawUTF8DynArray(aSourceFiles, ',', '', lSourceFiles);
if Length(lSourceFiles)=0 then
Exit;
for I := 0 to Length(lSourceFiles)-1 do begin
MultiPartFormDataAddFile(lSourceFiles[I], lMultiPart);
if MultiPartFormDataEncode(lMultiPart, lMultiPartContentType, lMultiPartFormData) then
// fClient = instance of TSQLRestClientURI and logged
// change 'root' for your root
fClient.URI(FormatUTF8('%/UpFile?path=%', ['root', aDestFolder]),
'POST', @lResp, @lMultiPartContentType, @lMultiPartFormData)
else
AddToCSV(lSourceFiles[I],aNotUploadedFiles);
end;
Result := True;
end;
Use as reference for using TWinHTTP.
Saludos.
Esteban
Offline
Pages: 1