Delphi Twebbrowser post upload file fail - delphi

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;