Question

我尝试在Delphi 10.1 Berlin中使用twebbrowser上传文件。一切都还可以，但是当我尝试加载unicode文件时，delphi会给我一个错误＆＃34;溢出，同时将类型（Word）的变体转换为类型（字节）＆＃34;。我如何修复unicode文件？

   procedure UploadFilesHttpPost(const wb:TWebBrowser; const URLstring: string; names, values, nFiles, vFiles: array of string) ;
   var
   strData, n, v, boundary: string;
   URL: OleVariant;
   Flags: OleVariant;
   PostData: OleVariant;
   Headers: OleVariant;
   idx: Integer;

   ms: TMemoryStream;
   ss: TStringStream;
     List: TStringList;
begin
   if (Length(names) <> Length(values)) then
     raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ;
   if (Length(nFiles) <> Length(vFiles)) then
     raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ;

   URL := 'about:blank';
   Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache or NavAllowAutosearch;
   wb.Navigate2(URL, Flags) ;
   while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages;

   // anything random that WILL NOT occur in the data.
   boundary := '---------------------------123456789';

   strData := '';
   for idx := Low(names) to High(names) do
   begin
     n := names[idx];
     v := values[idx];

     strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"' + #13#10#13#10 + v + #13#10;
   end;

   for idx := Low(nFiles) to High(nFiles) do
   begin
     n := nFiles[idx];
     v := vFiles[idx];

     strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"; filename="' + v + '"' + #13#10;

     if v = '' then
     begin
        strData := strData + 'Content-Transfer-Encoding: binary'#13#10#13#10;
     end
     else
     begin
       if (CompareText(ExtractFileExt(v), '.JPG') = 0) or (CompareText(ExtractFileExt(v), '.JPEG') = 0) then
       begin
         strData := strData + 'Content-Type: image/pjpeg'#13#10#13#10;
       end
       else if (CompareText(ExtractFileExt(v), '.PNG') = 0) then
       begin
         strData := strData + 'Content-Type: image/x-png'#13#10#13#10;
       end
       else if (CompareText(ExtractFileExt(v), '.PDF') = 0) then
       begin
         strData := strData + 'Content-Type: application/pdf'#13#10#13#10;
       end
       else if (CompareText(ExtractFileExt(v), '.HTML') = 0) then
       begin
       end;

       strData := strData + 'Content-Type: text/html'#13#10#13#10;


       ms := TMemoryStream.Create;
       try
         ms.LoadFromFile(v) ;
         ss := TStringStream.Create('') ;
         try
           ss.CopyFrom(ms, ms.Size) ;

           strData := strData + ss.DataString + #13#10;
         finally
           ss.Free;
         end;
       finally
         ms.Free;
       end;      
     end;

     strData := strData + '--' + boundary + '--'#13#10; // FOOTER
   end;

   strData := strData + #0;

   {2. you must convert a string into variant array of bytes and every character from string is a value in array}
   PostData := VarArrayCreate([0, Length(strData) - 1], varByte) ;

   { copy the ordinal value of the character into the PostData array}
   for idx := 1 to Length(strData) do PostData[idx-1] := Ord(strData[idx]) ;

   {3. prepare headers which will be sent to remote web-server}
   Headers := 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10;

   {4. you must navigate to the URL with your script and send as parameters your array with POST-data and headers}
   URL := URLstring;
   wb.Navigate2(URL, Flags, EmptyParam, PostData, Headers) ;
   while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
UploadFilesHttpPost(
  WebBrowser1,
  'http://www.example.com/upload.php',
  [],
  [],
  ['fileupload'],
  ['c:\test.jpg'] );

end;

将字符的序数值复制到PostData数组中会出现问题，但不知道如何处理它。

Answer 1

您正在使用Unicode版本的Delphi，其中string是UnicodeString的别名，它是UTF-16编码的。

您正尝试使用Unicode字符串发布二进制8位数据，这根本不起作用。您必须对二进制数据进行base64编码，并将Content-Transfer-Encoding标头设置为base64而不是binary。但是，并非所有HTTP服务器都在base64帖子中支持multipart/form-data。

由于multipart/form-data可以处理二进制数据而不必使用base64，因此您应该按原样发布实际二进制数据，而不是将其视为字符串。完全删除TStringStream，然后将所有MIME数据（文本和二进制文件）都放入TMemoryStream，然后将其转换为要发送的TWebBrowser的字节数组。 / p>

例如：

procedure WriteStringToStream(Stream: TStream; const S: string);
var
  U: UTF8String;
begin
  U := UTF8String(S);
  Stream.WriteBuffer(PAnsiChar(U)^, Length(U));
end;

procedure WriteLineToStream(Stream: TStream; const S: string = '');
begin
  WriteStringToStream(Stream, S);
  WriteStringToStream(Stream, #13#10);
end;

procedure UploadFilesHttpPost(const wb:TWebBrowser; const URLstring: string; names, values, nFiles, vFiles: array of string) ;
var
  boundary, ext: string;
  Flags, Headers, PostData: OleVariant;
  idx: Integer;
  ms: TMemoryStream;
  fs: TFileStream;
  Ptr: Pointer;
begin
  if Length(names) <> Length(values) then
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ;
  if Length(nFiles) <> Length(vFiles) then
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ;

  Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache or NavAllowAutosearch

  wb.Navigate2('about:blank', Flags);
  while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages;

  // anything random that WILL NOT occur in the data.
  boundary := '---------------------------123456789';

  ms := TMemoryStream.Create;
  try
    for idx := Low(names) to High(names) do
    begin
      WriteLineToStream(ms, '--' + boundary);
      WriteLineToStream(ms, 'Content-Disposition: form-data; name=' + AnsiQuotedStr(names[idx], #34));
      WriteLineToStream(ms);
      WriteLineToStream(values[idx]);
    end;

    for idx := Low(nFiles) to High(nFiles) do
    begin
      WriteLineToStream(ms, '--' + boundary);
      WriteLineToStream(ms, 'Content-Disposition: form-data; name=' + AnsiQuotedStr(nFiles[idx], #34) + '; filename=' + AnsiQuotedStr(ExtractFileName(vFiles[idx]), #34));
      WriteLineToStream(ms, 'Content-Transfer-Encoding: binary');    

      WriteStringToStream(ms, 'Content-Type: ');
      ext := ExtractFileExt(vFiles[idx]);
      if SameText(ext, '.JPG') or SameText(ext, '.JPEG') then
      begin
        WriteStringToStream(ms, 'imag/pjpeg');
      end
      else if SameText(ext, '.PNG') then
      begin
        WriteStringToStream(ms, 'image/x-png');
      end
      else if SameText(ext, '.PDF') then
      begin
        WriteStringToStream(ms, 'application/pdf');
      end
      else if SameText(ext, '.HTML') then
      begin
        WriteStringToStream(ms, 'text/html');
      end else
      begin
        WriteStringToStream(ms, 'application/octet-stream');
      end;
      WriteLineToStream(ms);

      WriteLineToStream(ms);

      fs := TFileStream.Create(vFiles[idx], fmOpenRead or fmShareDenyWrite);
      try
        ms.CopyFrom(fs, 0);
      finally
        fs.Free;
      end;

      WriteLineToStream(ms);
    end;

    WriteLineToStream('--' + boundary + '--');

    PostData := VarArrayCreate([0, ms.Size-1], varByte);
    Ptr := VarArrayLock(PostData);
    try
      Move(ms.Memory^, Ptr^, ms.Size);
    finally
      VarArrayUnlock(PostData);
    end;
  finally
    ms.Free;
  end;

  Headers := 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10;

  wb.Navigate2(URLstring, Flags, EmptyParam, PostData, Headers);
  while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  UploadFilesHttpPost(
    WebBrowser1,
    'http://www.example.com/upload.php',
    [],
    [],
    ['fileupload'],
    ['c:\test.jpg']
  );
end;

话虽如此，TWebBrowser是一个可视组件，你真的不应该以这种方式使用它。更好的选择是使用非可视HTTP组件/库，例如Indy的TIdHTTP组件：

uses
  IdHTTP, IdMultipartFormDataStream;

procedure UploadFilesHttpPost(const URLstring: string; names, values, nFiles, vFiles: array of string) ;
var
  idx: Integer;
  HTTP: TIdHTTP;
  PostData: TIdMultipartFormDataStream;
begin
  if Length(names) <> Length(values) then
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ;
  if Length(nFiles) <> Length(vFiles) then
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ;

  HTTP := TIdHTTP.Create;
  try
    PostData := TIdMultipartFormDataStream.Create;
    try
      for idx := Low(names) to High(names) do
      begin
        PostData.AddFormField(names[idx], values[idx]);
      end;
      for idx := Low(nFiles) to High(nFiles) do
      begin
        PostData.AddFile(nFiles[idx], vFiles[idx]);
      end;
      HTTP.Post(URLstring, PostData);
    finally
      PostData.Free;
    end;
  finally
    HTTP.Free;
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  UploadFilesHttpPost(
    'http://www.example.com/upload.php',
    [],
    [],
    ['fileupload'],
    ['c:\test.jpg']
  );
end;

Delphi Twebbrowser上传文件失败

1 个答案: