Delphi-PRAXiS - Delphi multipart/form-data Datei-Upload funktioniert unter XE7 nicht mehr

Ab Indy Revision 5128 vom 9. April 2014 sind die dekodierten Uploads um zwei Zeichen länger als die Originaldatei.

Die zusätzlichen Bytes sind (im Test mit einer Textdatei) ein CR/LF am Dateiende.

Mit Revision 5127 (auch vom 8. April 2014) stimmen die hochgeladenen Dateien mit den Originalen überein.

Im Log steht dass ab Revision 5128 das Default-Encoding 7bit für empfangene Multipart-Daten geht, aber warum diese Änderung nur zum Anhängen eins CR/LF führte konnte ich leider nicht erkennen:

Zitat:

Tweaks to MIME Content-Transfer-Encoding handling. Now defaulting to 7bit when Content-Transfer-Encoding is not present, per RFC 2045.

Ich schlage vor, es einmal mit Revision 5128 zu versuchen um zu bestätigen dass es das gleiche Problem sein könnte. Ich teste nur mit Delphi 2009 und den Unterschied zwischen XE6 und XE7 daher nicht untersuchen.

Hier ist der Server-Code der auf

http://127.0.0.1:8080 ein Upload-Formular liefert:

Delphi-Quellcode:

			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.