Fatal编程技术网
  • delphi/
  • Delphi 多部分/表单数据请求的Indy MIME解码返回尾部CR/LF

Delphi 多部分/表单数据请求的Indy MIME解码返回尾部CR/LF

delphi http

Delphi 多部分/表单数据请求的Indy MIME解码返回尾部CR/LF,delphi,http,indy,multipartform-data,Delphi,Http,Indy,Multipartform Data,Indy 10.6修订版5128似乎包含了一个更改，它打破了以下HTTP表单上传的代码 接收到的数据在末尾包含两个附加字节，即CR/LF对 阅读5127和5128之间更改的代码行并没有找到根本原因 当我找到时间并将结果发布在这里时，我将尝试调试它（但可能有人更快） 这是一个独立的演示应用程序，它在http://127.0.0.1:8080 program IndyMultipartUploadDemo; {$APPTYPE CONSOLE} uses IdHTTPServer, IdCu

Indy 10.6修订版5128似乎包含了一个更改，它打破了以下HTTP表单上传的代码

接收到的数据在末尾包含两个附加字节，即CR/LF对

阅读5127和5128之间更改的代码行并没有找到根本原因

当我找到时间并将结果发布在这里时，我将尝试调试它（但可能有人更快）

这是一个独立的演示应用程序，它在
http://127.0.0.1:8080

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.

程序IndyMultipartUploadDemo；
{$APPTYPE控制台}
使用
IdHTTPServer、IdCustomHTTPServer、IdContext、IdSocketHandle、IdGlobal、，
IdMessageCoder、IdGlobalProtocols、IdMessageCoderMIME、IdMultiPartFormData、，
系统、类；
类型
TMimeHandler=过程（var VDecoder:TIdMessageDecoder；
var VMsgEnd:Boolean；const-Response:TIdHTTPResponseInfo）对象；
TMyServer=class（TIdHTTPServer）
私有的
过程过程mimepart（var-VDecoder:TIdMessageDecoder；
var VMsgEnd:Boolean；const-Response:TIdHTTPResponseInfo）；
函数IsHeaderMediaType（const AHeaderLine，AMediaType:String）：布尔值；
函数MediaTypeMatches（const AValue，AMediaType:String）：布尔值；
函数GetUploadFolder:string；
过程HandleMultipartUpload（请求：TIdHTTPRequestInfo；响应：
TIdHTTPResponseInfo；MimeHandler:TMimeHandler）；
公众的
程序初始化组件；推翻
过程DoCommandGet（AContext:TIdContext；
ARequestInfo:TIdHTTPRequestInfo；AResponseInfo:TIdHTTPResponseInfo）；推翻
结束；
程序演示；
变量
服务器：TMyServer；
开始
ReportMemoryLeaksOnShutdown:=True；
服务器：=TMyServer.Create；
尝试
尝试
Server.Active:=True；
除了
关于E:Exception-do
开始
WriteLn（E.ClassName+“”+E.Message）；
结束；
结束；
WriteLn（'按任意键终止'）；
ReadLn；
最后
免费服务器；
结束；
结束；
程序TMyServer.InitComponent；
变量
装订：三折；
开始
继承；
绑定。清晰；
绑定：=绑定。添加；
Binding.IP:=“127.0.0.1”；
绑定端口：=8080；
KeepAlive:=真；
结束；
过程TMyServer.DoCommandGet（AContext:TIdContext；
ARequestInfo:TIdHTTPRequestInfo；AResponseInfo:TIdHTTPResponseInfo）；
开始
AResponseInfo.ContentType:=“文本/html”；
AResponseInfo.CharSet:=“UTF-8”；
如果ARequestInfo.CommandType=hcGET，则
开始
AResponseInfo.ContentText：=
'' + #13#10
+ '' + #13#10
+ ' ' + #13#10
+“多部分上传示例”+#13#10
+ ' ' + #13#10
+ '  ' + #13#10
+ ' ' + #13#10
+ ' ' + #13#10
+“标准文件上传”+#13#10
+“文件输入”+#13#10
+ ' ' + #13#10
+“上传”+#13#10
+ ' ' + #13#10
+ ' ' + #13#10
+ ' ' + #13#10
+ '' + #13#10;
结束
其他的
开始
如果ARequestInfo.CommandType=hcPOST，则
开始
如果IsHeaderMediaType（ARequestInfo.ContentType，“多部分/表单数据”），则
开始
HandleMultipartUpload（ARequestInfo、AResponseInfo、ProcessMimePart）；
结束；
结束；
结束；
结束；
//基于Indy和Winsock论坛文章上的代码
// http://forums2.atozed.com/viewtopic.php?f=7&t=10924
// http://embarcadero.newsgroups.archived.at/public.delphi.internet.winsock/201107/1107276163.html
过程TMyServer.ProcessMimePart（var-VDecoder:TIdMessageDecoder；
var VMsgEnd:Boolean；const-Response:TIdHTTPResponseInfo）；
变量
LMStream:tmemorestream；
LNewDecoder:TIdMessageDecoder；
上传文件：字符串；
开始
LMStream:=TMemoryStream.Create；
尝试
LNewDecoder:=VDecoder.ReadBody（LMStream，VMsgEnd）；
如果VDecoder.Filename为“”，则
开始
尝试
LMStream.Position:=0；
Response.ContentText:=Response.ContentText
+格式（'%s%d字节
'+#13#10，
[VDecoder.Filename，LMStream.Size]）；
//将流写入上载文件夹
UploadFile:=GetUploadFolder+VDecoder.Filename；
LMStream.SaveToFile（上传文件）；
Response.ContentText:=Response.ContentText
+“”+上传文件+”写入“”；
除了
LNewDecoder.Free；
提高；
结束；
结束；
VDecoder.Free；
VDecoder:=LNewDecoder；
最后
LMStream.Free；
结束；
结束；
函数TMyServer.ishaderMediaType（常量AHeaderLine，AMediaType:String）：布尔值；
开始
结果：=MediaTypeMatches（ExtractHeaderItem（AHeaderLine），AMediaType）；
结束；
函数TMyServer.MediaTypeMatches（const AValue，AMediaType:String）：布尔值；
开始
如果Pos（'/'，AMediaType）>0，则开始
结果：=textisame（AValue，ameditype）；
结束，否则开始
结果：=TextStartsWith（AValue，AMediaType+'/'）；
结束；
结束；
函数TMyServer.GetUploadFolder:string；
开始
结果：=ExtractFilePath（ParamStr（0））+“upload\”；
结果;；
结束；
过程TMyServer.HandleMultipartUpload（请求：TIdHTTPRequestInfo；
响应：TIdHTTPResponseInfo；MimeHandler:TMimeHandler）；
变量
LBoundary，LBoundaryStart，LBoundaryEnd:字符串；
LDecoder:TIdMessageDecoder；
莉莲：弦；
LBoundaryFound，LIsStartBoundary，LMsgEnd:Boolean；
开始
LBoundary:=ExtractHeaderSubItem（Request.ContentType，'boundary'，
QuoteHTTP）；
如果LBoundary=''，则
开始
Response.ResponseNo:=400；
Response.CloseConnection:=True；
Response.WriteHeader；
出口
结束；
LBoundaryStart:='--'+LBoundary；
LBoundaryEnd:=LBoundaryStart+'--'；
LDecoder:=TIdMessageDecoderMIME.Create（无）；
尝试
TIdMessageDecoderMIME（LDecoder）.MIMEBoundary:=LBoundary；
ldeconder.SourceStream:=Request.PostStream；
ldeconder.FreeSourceStream:=False；
LBoundaryFound:=False；
LIsStartBoundary:=False；
重复
LLine:=ReadLnFromStream（Request.PostStream，-1，True）；
如果LLine=LBoundaryStart，则
开始
LBoundaryFound:=真；
LIsStartBoundary：=

if LContentTransferEncoding = '' then begin
  // RLebeau 04/08/2014: According to RFC 2045 Section 6.1:
  // "Content-Transfer-Encoding: 7BIT" is assumed if the
  // Content-Transfer-Encoding header field is not present."
  if IsHeaderMediaType(LContentType, 'application/mac-binhex40') then begin  {Do not Localize}
    LContentTransferEncoding := 'binhex40'; {do not localize}
  end

  // START FIX!!
  else if IsHeaderMediaType(LContentType, 'application/octet-stream') then begin  {Do not Localize}
    LContentTransferEncoding := '8bit'; {do not localize}
  end
  // END FIX!!

  else begin
    LContentTransferEncoding := '7bit'; {do not localize}
  end;
end



    TIdMessageDecoderMIME(decoder).Headers.Values['Content-Transfer-Encoding'] := '8bit';
    TIdMessageDecoderMIME(decoder).BodyEncoded := False;
    newdecoder := Decoder.ReadBody(ms,msgEnd);