Delphi Twebbrowser post upload file fail

Question

I try to upload files with twebbrowser in Delphi 10.1 Berlin . Everything is ok but when i try to load unicode files, delphi is giving me an error "Overflow while converting variant of type (Word) into type (Byte)". How i can fix for unicode files?

   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;

The problem appears on copy the ordinal value of the character into the PostData array, but don't know how to handle it.

Answer 1

You are using a Unicode version of Delphi, where string is an alias for UnicodeString, which is UTF-16 encoded.

You are trying to post binary 8bit data using Unicode strings, and that is simply not going to work. You would have to base64-encode the binary data instead, and set the Content-Transfer-Encoding header to base64 instead of binary. However, not all HTTP servers support base64 in a multipart/form-data post.

Since multipart/form-data can handle binary data without having to use base64, you should just post as actual binary data as-is and not treat it as strings at all. Get rid of the TStringStream altogether, and then put all of your MIME data (text and binary alike) into the TMemoryStream and then convert that to a byte array for TWebBrowser to send.

For example:

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;

That being said, TWebBrowser is a visual component, you really shouldn't be using it in this manner to begin with. A better option would be to use a non-visual HTTP component/library instead, such as Indy's TIdHTTP component:

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;