Garbage in headers when POST-ing with Indy 10.5.8 - delphi

I'm trying to send a file using POST in multipart/form data via Indy 10.5.8. I'm using Delphi XE2 and I've been trying to POST a file to a server. This is the firs time I've tried this and since my experience with Indy is quite limited, i took the following snippet of code:
unit MsMultiPartFormData;
interface
uses
SysUtils, Classes;
const
CONTENT_TYPE = 'multipart/form-data; boundary=';
CRLF = #13#10;
CONTENT_DISPOSITION = 'Content-Disposition: form-data; name="%s"';
FILE_NAME_PLACE_HOLDER = '; filename="%s"';
CONTENT_TYPE_PLACE_HOLDER = 'Content-Type: %s' + crlf + crlf;
CONTENT_LENGTH = 'Content-Length: %d' + crlf;
type
TMsMultiPartFormDataStream = class(TMemoryStream)
private
FBoundary: string;
FRequestContentType: string;
function GenerateUniqueBoundary: string;
public
procedure AddFormField(const FieldName, FieldValue: string);
procedure AddFile(const FieldName, FileName, ContentType: string; FileData: TStream); overload;
procedure AddFile(const FieldName, FileName, ContentType: string); overload;
procedure PrepareStreamForDispatch;
constructor Create;
property Boundary: string read FBoundary;
property RequestContentType: string read FRequestContentType;
end;
implementation
{ TMsMultiPartFormDataStream }
constructor TMsMultiPartFormDataStream.Create;
begin
inherited;
FBoundary := GenerateUniqueBoundary;
FRequestContentType := CONTENT_TYPE + FBoundary;
end;
procedure TMsMultiPartFormDataStream.AddFile(const FieldName, FileName,
ContentType: string; FileData: TStream);
var
sFormFieldInfo: string;
Buffer: PChar;
iSize: Int64;
begin
iSize := FileData.Size;
sFormFieldInfo := Format(CRLF + '--' + Boundary + CRLF + CONTENT_DISPOSITION +
FILE_NAME_PLACE_HOLDER + CRLF + CONTENT_LENGTH +
CONTENT_TYPE_PLACE_HOLDER, [FieldName, FileName, iSize, ContentType]);
{so: boundary + crlf + content-disposition+file-name-place-holder}
Write(Pointer(sFormFieldInfo)^, Length(sFormFieldInfo));
FileData.Position := 0;
GetMem(Buffer, iSize);
try
FileData.Read(Buffer^, iSize);
Write(Buffer^, iSize);
finally
FreeMem(Buffer, iSize);
end;
end;
procedure TMsMultiPartFormDataStream.AddFile(const FieldName, FileName,
ContentType: string);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
AddFile(FieldName, FileName, ContentType, FileStream);
finally
FileStream.Free;
end;
end;
procedure TMsMultiPartFormDataStream.AddFormField(const FieldName,
FieldValue: string);
var
sFormFieldInfo: string;
begin
sFormFieldInfo := Format(CRLF + '--' + Boundary + CRLF + CONTENT_DISPOSITION + CRLF + CRLF +
FieldValue, [FieldName]);
Write(Pointer(sFormFieldInfo)^, Length(sFormFieldInfo));
end;
function TMsMultiPartFormDataStream.GenerateUniqueBoundary: string;
begin
Result := '---------------------------' + FormatDateTime('mmddyyhhnnsszzz', Now);
end;
procedure TMsMultiPartFormDataStream.PrepareStreamForDispatch;
var
sFormFieldInfo: string;
begin
sFormFieldInfo := CRLF + '--' + Boundary + '--' + CRLF;
Write(Pointer(sFormFieldInfo)^, Length(sFormFieldInfo));
Position := 0;
end;
end.
I'm calling the code like that:
function PostFile(filename, apikey: string): boolean;
var
ResponseStream: TMemoryStream;
MultiPartFormDataStream: TMsMultiPartFormDataStream;
begin
// Form5.IdHTTP1.HandleRedirects := true;
Form5.idHTTP1.ReadTimeout := 0;
// Form5.idHTTP1.IOHandler.LargeStream := True;
Result := false;
MultiPartFormDataStream := TMsMultiPartFormDataStream.Create;
ResponseStream := TMemoryStream.Create;
try
try
Form5.IdHttp1.Request.ContentType := MultiPartFormDataStream.RequestContentType;
MultiPartFormDataStream.AddFormField('apikey', apikey);
MultiPartFormDataStream.AddFile('file', filename, 'multipart/form-data');
MultiPartFormDataStream.PrepareStreamForDispatch;
MultiPartFormDataStream.Position := 0;
Form5.IdHTTP1.Post('http://www.updserver.tld/api//file/save', MultiPartFormDataStream, ResponseStream);
MultiPartFormDataStream.SaveToFile(ExtractFilePath(Application.ExeName) + 'a.txt');
Result := true;
except
on E:Exception do
begin
Form5.Close;
ShowMessage('Upload failed! '+E.Message);
end;
end;
finally
MultiPartFormDataStream.Free;
ResponseStream.Free;
end;
end;
The file gets sent, but is rejected by the server. Closer inspection of the data sent reveals that the data gets somewhat corrupt (i suspect encoding issues) - what I see is:
POST /api/file/save HTTP/1.0
Connection: keep-alive
Content-Type: multipart/form-data; boundary=---------------------------071312151405662
Content-Length: 11040172
Host: www.updserver.tld
Accept: text/html, */*
Accept-Encoding: identity
User-Agent: Mozilla/3.0 (compatible; Indy Library)
.
.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.0.7.1.3.1.2.1.5.1.4.0.5.6.6.2.
.
.C.o.n.t.e.n.t.-.D.i.s.p.o.s.i.t.i.o.n.:. .f.o.r.m.-.d.a.t.a.;. .n
.
.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.0.7.1.3.1.2.1.5.1.4.0.5.6.6.2.
.
.C.o.n.t.e.n.t.-.D.i.s.p.o.s.i.t.i.o.n.:. .f.o.r.m.-.d.a.t.a.;. .n.a.m.e.=.".f.i.l.e.".;. .f.i.l.e.n.a.m.e.=.".C.:.\.U.s.e........................>.......................................................v.......:...;...<.......[.......v.......................t.......o.......z............
...
...
The regular headers, sent from a working Python client, look like this:
POST https://updserver.tld/api/file/save HTTP/1.0
content-type: multipart/form-data; boundary=---------------------------071312151405662
content-length: 6613364
---------------------------071312151405662
Content-Disposition: form-data; name="apikey"
ac36fae9a406596[rest-of-api-key-goes-here]17966c42b60c8c4cd
---------------------------071312151405662
Content-Disposition: form-data; name="file"; filename="C:\Users\User\Desktop\Project1.exe"
Content-Type: application/octet-stream
Any idea about what I'm doing wrong?
Thanks in advance.

The root of the problem is that your custom TStream code is not compatible with D2009+ versions of Delphi. Delphi's String and PChar types are not Ansi anymore, but the code assumes they still are. They are Unicode UTF-16 now. You are not accounting for that correctly, eg:
procedure TMsMultiPartFormDataStream.AddFile(const FieldName, FileName, ContentType: string; FileData: TStream);
var
sFormFieldInfo: AnsiString;
iSize: Int64;
begin
iSize := FileData.Size;
// NOTE: this will only work for ASCII filenames!!!!
//
// Non-ASCII filenames will get converted to Ansi, which can cause data loss.
// To send non-ASCII filenames correctly, you have to encode it to a charset
// first, such as UTF-8, and then encode the resulting bytes using
// MIME's RFC2047 encoding so the server can decode the filename properly
// on its end...
//
sFormFieldInfo := Format(CRLF + '--' + Boundary + CRLF + CONTENT_DISPOSITION +
FILE_NAME_PLACE_HOLDER + CRLF + CONTENT_LENGTH +
CONTENT_TYPE_PLACE_HOLDER, [FieldName, FileName, iSize, ContentType]);
{so: boundary + crlf + content-disposition+file-name-place-holder}
Write(sFormFieldInfo[1], Length(sFormFieldInfo) * SizeOf(AnsiChar));
if iSize > 0 then
begin
FileData.Position := 0;
CopyFrom(FileData, iSize);
end;
end;
procedure TMsMultiPartFormDataStream.AddFormField(const FieldName, FieldValue: string);
var
sFormFieldInfo: AnsiString;
begin
// NOTE: this will only work for ASCII text!!!!
//
// Non-ASCII text will get converted to Ansi, which can cause data loss.
// To send non-ASCII text correctly, you have to encode it to a charset
// first, such as UTF-8 and then encode the resulting bytes using
// MIME's 'quoted-printable' or 'base64' enoding, and then include
// appropriate 'charset' and Content-Transfer-Encoding' headers so the
// server can decode the data properly on its end...
//
sFormFieldInfo := Format(CRLF + '--' + Boundary + CRLF + CONTENT_DISPOSITION + CRLF + CRLF +
FieldValue, [FieldName]);
Write(sFormFieldInfo[1], Length(sFormFieldInfo) * AnsiString(AnsiChar));
end;
procedure TMsMultiPartFormDataStream.PrepareStreamForDispatch;
var
sFormFieldInfo: AnsiString;
begin
sFormFieldInfo := CRLF + '--' + Boundary + '--' + CRLF;
Write(sFormFieldInfo[1], Length(sFormFieldInfo) * SizeOf(AnsiChar));
Position := 0;
end;
With that said, I strongly suggest you get rid of your custom TMsMultiPartFormDataStream class completely. All it is doing is mimicing an outdated version of Indy's own TIdMultipartFormDataStream class . Just use Indy's native TIdMultipartFormDataStream class as-is instead. It handles D2009+ Unicode for you, eg:
uses
..., IdMultipartFormData;
function PostFile(const filename, apikey: string): boolean;
var
ResponseStream: TMemoryStream;
MultiPartFormDataStream: TIdMultiPartFormDataStream;
begin
Result := False;
//Form5.IdHTTP1.HandleRedirects := true;
Form5.idHTTP1.ReadTimeout := 0;
//Form5.idHTTP1.IOHandler.LargeStream := True;
try
ResponseStream := TMemoryStream.Create;
try
MultiPartFormDataStream := TIdMultiPartFormDataStream.Create;
try
MultiPartFormDataStream.AddFormField('apikey', apikey);
MultiPartFormDataStream.AddFile('file', filename, 'application/octet-stream');
Form5.IdHTTP1.Post('http://www.updserver.tld/api/file/save', MultiPartFormDataStream, ResponseStream);
ResponseStream.SaveToFile(ExtractFilePath(Application.ExeName) + 'a.txt');
Result := True;
finally
MultiPartFormDataStream.Free;
end;
finally
ResponseStream.Free;
end;
except
on E:Exception do
begin
Form5.Close;
ShowMessage('Upload failed! ' + E.Message);
end;
end;
end;
end;

Do all of those . characters represent a 00 byte? Because that looks like the result of a ASCII->UTF16 conversion. And the garbage in the Content-Disposition could be related to a conversion like that copying bytes around and getting the end of the buffer wrong, leaving you with a corrupted string.
If you can come up with code to reproduce this consistently, you should probably post a bug report on the Indy forums.

Related

IdHTTP how to send x-www-form-urlencoded body

I have tested POST function in PostMan to do POST function with body parameters as below:
Here is eBay's document for this function:
HTTP method: POST
URL (Sandbox): https://api.sandbox.ebay.com/identity/v1/oauth2/token
HTTP headers:
Content-Type = application/x-www-form-urlencoded
Authorization = Basic <B64-encoded-oauth-credentials>
Request body:
grant_type=authorization_code
code=<authorization-code-value>
redirect_uri=<RuName-value>
My first attempt was as follow:
function udxEBayExchangeAuthCodeForUserToken(AAuthCode: String; AIsProduction: Boolean): String;
var
xRequestBody: TStringStream;
begin
with objHTTP.Request do begin
CustomHeaders.Clear;
ContentType := 'application/x-www-form-urlencoded';
CustomHeaders.Values['Authorization'] := 'Basic ' + 'V2VpbmluZ0MtV2VpbmluZ0M';
end;
xRequestBody := TStringStream.Create('grant_type=' + 'authorization_code' + ','
+ 'code=' + 'v%5E1.1%23i%5E1%23f%5E0%23r%5E1%23I%5E3%23p%5E3' + ','
+ 'redirect_uri=' + 'myredirecturlnameinsandbox',
TEncoding.UTF8);
try
try
Result := objHTTP.Post('https://api.sandbox.ebay.com/identity/v1/oauth2/token', xRequestBody);
except
on E: Exception do
ShowMessage('Error on request: ' + #13#10 + e.Message);
end;
finally
xRequestBody.Free;
end;
end;
Second attempt tried with below code for Body
xRequestBody := TStringStream.Create('grant_type=' + 'authorization_code' + '&'
+ 'code=' + AAuthCode + '&'
+ 'redirect_uri=' + gsRuName,
TEncoding.UTF8);
Both attempts give HTTP/1.1 400 Bad Request.
I have done some searching in Stack Overflow, and this is the closest question. The only different part is body of POST.
IdHTTP how to send raw body
Can anyone please advise me what is correct way to assign POST body part?
Thanks.
The preferred way to send an application/x-www-form-urlencoded request with TIdHTTP is to use the overloaded TIdHTTP.Post() method that takes a TStrings as input. You are not sending your TStringStream data in the proper application/x-www-form-urlencoded format.
You don't need to use the TIdHTTP.Request.CustomHeaders property to setup Basic authorization. TIdHTTP has built-in support for Basic, simply use the TIdHTTP.Request.UserName and TIdHTTP.Request.Password properties as needed, and set the TIdHTTP.Request.BasicAuthentication property to true.
Try this instead:
function udxEBayExchangeAuthCodeForUserToken(AAuthCode: String; AIsProduction: Boolean): String;
var
xRequestBody: TStringList;
begin
with objHTTP.Request do
begin
Clear;
ContentType := 'application/x-www-form-urlencoded';
BasicAuthentication := True;
UserName := ...;
Password := ...;
end;
xRequestBody := TStringList.Create;
try
xRequestBody.Add('grant_type=' + 'authorization_code');
xRequestBody.Add('code=' + AAuthCode);
xRequestBody.Add('redirect_uri=' + 'myredirecturlnameinsandbox');
try
Result := objHTTP.Post('https://api.sandbox.ebay.com/identity/v1/oauth2/token', xRequestBody);
except
on E: Exception do
ShowMessage('Error on request: ' + #13#10 + e.Message);
end;
finally
xRequestBody.Free;
end;
end;
If you want to send your own TStringStream, try this instead:
function udxEBayExchangeAuthCodeForUserToken(AAuthCode: String; AIsProduction: Boolean): String;
var
xRequestBody: TStringStream;
begin
with objHTTP.Request do
begin
Clear;
ContentType := 'application/x-www-form-urlencoded';
BasicAuthentication := True;
UserName := ...;
Password := ...;
end;
xRequestBody := TStringStream.Create('grant_type=' + 'authorization_code' + '&'
+ 'code=' + TIdURI.ParamsEncode(AAuthCode){'v%5E1.1%23i%5E1%23f%5E0%23r%5E1%23I%5E3%23p%5E3'} + '&'
+ 'redirect_uri=' + 'myredirecturlnameinsandbox',
TEncoding.UTF8);
try
try
xRequestBody.Position := 0;
Result := objHTTP.Post('https://api.sandbox.ebay.com/identity/v1/oauth2/token', xRequestBody);
except
on E: Exception do
ShowMessage('Error on request: ' + #13#10 + e.Message);
end;
finally
xRequestBody.Free;
end;
end;
I was troubled by this problem, but the answer didn't work very much. Later, I used packet capturing to see the actual content sent. For friends with the same problems.
function TFormMain.init_web_account(): Boolean;
var
strTmp: Ansistring;
PostStringData: TstringStream;
idhttp1: Tidhttp;
json, json_array1: TQjson;
itype_version: integer;
ifunction_version: integer;
s: string;
url: ansistring;
idMultiPartFormDataStream:TIdMultiPartFormDataStream;
begin
try
result := False;
idhttp1 := TIdHTTP.Create();
PostStringData := TStringStream.Create;
//init_string http://x.x.x.x:8000/user/key?ke1=v1&k2=v2
strTmp := //
'strdogsoftid=' + edtDogNumber.Text + //
'&chipid=' + '' + //
'&status=' + '0' + //
'&reg_user_name=' + edtRegName.Text + //
'&reg_init_date=' + formatdatetime('yyyy-mm-dd', dtpRegCodeGenDate.Date) + //
'&lease_expiration=' + formatdatetime('yyyy-mm-dd', dtp_lease_expiration.Date) + //
'&renew_last_date=' + '' + //
'&mobile=' + '' + //
'&weixin=' + '' + //
'&memo=' + '' + //
'&function_version=' + IntToStr(rgVersion.ItemIndex) + //
'&type_version=' + IntToStr(itype_version); //
url := 'http://x.x.x.x:8000/user/' + edtDogNumber.Text;
PostStringData.Clear;
PostStringData.WriteString(strTmp);
try
idhttp1.Request.ContentType := 'application/x-www-form-urlencoded';
s := idhttp1.Post(url, PostStringData);
result := True;
except
on E: Exception do
begin
showmessage(s);
result := False;
exit;
end;
end;
finally
PostStringData.Free;
idhttp1.Free;
end;
end;
If you use TNetHTTPClient you can use the "System.Net.Mime" unit to manage the multipart form data by HTTP Post and manage request too.
I use Delphi 10.4.2

Delphi Twebbrowser post upload file fail

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.
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;

Send emoji with indy delphi7

i want to send emoji with indy 9.00.10 on delphi 7. i use tnt VCL Controls .
i found this url http://apps.timwhitlock.info/emoji/tables/unicode for unicode and bytes code.
how to convert this codes to delphi Constants for Send with indy.
i use this delphi code for send message to telegram bot:
procedure TBotThread.SendMessage(ChatID:String; Text : WideString;
parse_mode:string;disable_notification:boolean);
Var
Stream: TStringStream;
Params: TIdMultipartFormDataStream;
//Text : WideString;
msg : WideString;
Src : string;
LHandler: TIdSSLIOHandlerSocket;
begin
try
try
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
msg := '/sendmessage';
Stream := TStringStream.Create('');
Params := TIdMultipartFormDataStream.Create;
Params.AddFormField('chat_id',ChatID);
if parse_mode <> '' then
Params.AddFormField('parse_mode',parse_mode);
if disable_notification then
Params.AddFormField('disable_notification','true')
else
Params.AddFormField('disable_notification','false');
Params.AddFormField('disable_web_page_preview','true');
Params.AddFormField('text',UTF8Encode(Text));
LHandler := TIdSSLIOHandlerSocket.Create(nil);
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler:=LHandler;
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmUnassigned;
FidHttpSend.HandleRedirects := true;
FidHttpSend.Post(BaseUrl + API + msg, Params, Stream);
finally
Params.Free;
Stream.Free;
ENd;
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
end;
bytes sample for emojies:
AERIAL_TRAMWAY = '\xf0\x9f\x9a\xa1';
AIRPLANE = '\xe2\x9c\x88';
ALARM_CLOCK = '\xe2\x8f\xb0';
ALIEN_MONSTER = '\xf0\x9f\x91\xbe';
sorry for bad english!!!
The Telegram Bot API supports several forms of input:
We support GET and POST HTTP methods. We support four ways of passing parameters in Bot API requests:
URL query string
application/x-www-form-urlencoded
application/json (except for uploading files)
multipart/form-data (use to upload files)
You are using the last option.
Indy 9 does not support Delphi 2009+ or Unicode. All uses of string are assumed to be AnsiString, which is the case in Delphi 7. Any AnsiString you add to TIdMultipartFormDataStream or TStrings, even a UTF-8 encoded one, will be transmitted as-is by TIdHTTP. However, there is no option to specify to the server that the string data is actually using UTF-8 as a charset. But, according to the docs:
All queries must be made using UTF-8.
So not specifying an explicit charset might not be problem.
If you still have problems with multipart/form-data, then consider using application/x-www-form-urlencoded (use TIdHTTP.Post(TStrings)) or application/json (use TIdHTTP.Post(TStream)) instead:
procedure TBotThread.SendMessage(ChatID: String; Text: WideString; parse_mode: string; disable_notification: boolean);
var
Params: TStringList;
LHandler: TIdSSLIOHandlerSocket;
begin
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
Params := TStringList.Create;
try
Params.Add('chat_id=' + UTF8Encode(ChatID));
if parse_mode <> '' then
Params.Add('parse_mode=' + UTF8Encode(parse_mode));
if disable_notification then
Params.Add('disable_notification=true')
else
Params.Add('disable_notification=false');
Params.Add('disable_web_page_preview=true');
Params.Add('text=' + UTF8Encode(Text));
LHandler := TIdSSLIOHandlerSocket.Create(nil);
try
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmClient;
FidHttpSend.HandleRedirects := true;
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler := LHandler;
try
try
FidHttpSend.Post(BaseUrl + API + '/sendmessage', Params, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
finally
FidHttpSend.IOHandler := nil;
end;
finally
LHandler.Free;
end;
finally
Params.Free;
end;
end;
procedure TBotThread.SendMessage(ChatID: String; Text: WideString; parse_mode: string; disable_notification: boolean);
var
Params: TStringStream;
LHandler: TIdSSLIOHandlerSocket;
function JsonEncode(const wStr: WideString): string;
var
I: Integer;
Ch: WideChar;
begin
// JSON uses UTF-16 text, so no need to encode to UTF-8...
Result := '';
for I := 1 to Length(wStr) do
begin
Ch := wStr[i];
case Ch of
#8: Result := Result + '\b';
#9: Result := Result + '\t';
#10: Result := Result + '\n';
#12: Result := Result + '\f';
#13: Result := Result + '\r';
'"': Result := Result + '\"';
'\': Result := Result + '\\';
'/': Result := Result + '\/';
else
if (Ord(Ch) >= 32) and (Ord(Ch) <= 126) then
Result := Result + AnsiChar(Ord(wStr[i]))
else
Result := Result + '\u' + IntToHex(Ord(wStr[i]), 4);
end;
end;
end;
begin
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
Params := TStringStream.Create('');
try
Params.WriteString('{');
Params.WriteString('chat_id: "' + JsonEncode(ChatID) + '",');
if parse_mode <> '' then
Params.WriteString('parse_mode: "' + JsonEncode(parse_mode) + '",')
if disable_notification then
Params.WriteString('disable_notification: True,')
else
Params.WriteString('disable_notification: False,');
Params.WriteString('disable_web_page_preview: True,');
Params.WriteString('text: "' + JsonEncode(Text) + '"');
Params.WriteString('}');
Params.Position := 0;
LHandler := TIdSSLIOHandlerSocket.Create(nil);
try
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmClient;
FidHttpSend.HandleRedirects := true;
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler := LHandler;
try
try
FidHttpSend.Request.ContentType := 'application/json';
FidHttpSend.Post(BaseUrl + API + '/sendmessage', Params, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
finally
FidHttpSend.IOHandler := nil;
end;
finally
LHandler.Free;
end;
finally
Params.Free;
end;
end;
That being said, your function's Text parameter is a WideString, which uses UTF-16, so you should be able to send any Unicode text, including emojis. If you are trying to generate text in your code, just make sure you UTF-16 encode any non-ASCII characters correctly. For example, codepoint U+1F601 GRINNING FACE WITH SMILING EYES is wide chars $D83D $DE01 in UTF-16:
var
Text: WideString;
Text := 'hi ' + #$D83D#$DE01; // 'hi 😁'
SendMessage('#channel', Text, 'Markup', False);
Alternatively, you can use HTML in your text messages, so you can encode non-ASCII characters using numerical HTML entities. According to the docs:
All numerical HTML entities are supported.
Codepoint U+1F601 is numeric entity $#128513; in HTML:
var
Text: WideString;
Text := 'hi $#128513;'; // 'hi 😁'
SendMessage('#channel', Text, 'HTML', False);

Indy multipart/form-data example [duplicate]

I have a simple php script on my web server which I need to upload a file using HTTP POST, which I am doing in Delphi.
Here is my code with Indy but aparantely it won't work and I can't figure out what i am not doing properly. How can I view what I send on the server is there such a tool ?
procedure TForm1.btn1Click(Sender: TObject);
var
fname : string;
MS,dump : TMemoryStream;
http : TIdHTTP;
const
CRLF = #13#10;
begin
if PromptForFileName(fname,'','','','',false) then
begin
MS := TMemoryStream.Create();
MS.LoadFromFile(fname);
dump := TMemoryStream.Create();
http := TIdHTTP.Create();
http.Request.ContentType:='multipart/form-data;boundary =-----------------------------7cf87224d2020a';
fname := CRLF + '-----------------------------7cf87224d2020a' + CRLF + 'Content-Disposition: form-data; name=\"uploadedfile\";filename=\"test.png"' + CRLF;
dump.Write(fname[1],Length(fname));
dump.Write(MS.Memory^,MS.Size);
fname := CRLF + '-----------------------------7cf87224d2020a--' + CRLF;
dump.Write(fname[1],Length(fname));
ShowMessage(IntToStr(dump.Size));
MS.Clear;
try
http.Request.Method := 'POST';
http.Post('http://posttestserver.com/post.php',dump,MS);
ShowMessage(PAnsiChar(MS.Memory));
ShowMessage(IntToStr(http.ResponseCode));
except
ShowMessage('Could not bind socket');
end;
end;
end;
Indy has TIdMultipartFormDataStream for this purpose:
procedure TForm1.SendPostData;
var
Stream: TStringStream;
Params: TIdMultipartFormDataStream;
begin
Stream := TStringStream.Create('');
try
Params := TIdMultipartFormDataStream.Create;
try
Params.AddFile('File1', 'C:\test.txt','application/octet-stream');
try
HTTP.Post('http://posttestserver.com/post.php', Params, Stream);
except
on E: Exception do
ShowMessage('Error encountered during POST: ' + E.Message);
end;
ShowMessage(Stream.DataString);
finally
Params.Free;
end;
finally
Stream.Free;
end;
end;
Calling a PHP from Indy can fail because of the User-Agent, then you get 403 error.
Try this way, it fixed it for me:
var Answer: string;
begin
GetHTML:= TIdHTTP.create(Nil);
try
GetHTML.Request.UserAgent:= 'Mozilla/3.0';
Answer:= GetHTML.Get('http://www.testserver.com/test.php?id=1');
finally
GetHTML.Free;
end;
end;
You lost 2 characters '--'. It is better to do so:
http.Request.ContentType:='multipart/form-data;boundary='+myBoundery;
fname := CRLF + '--' + myBoundery + CRLF + 'Content-Disposition: form-data; name=\"uploadedfile\";filename=\"test.png"' + CRLF;

503 error with multipart upload GoogleDrive Api v2

I'm attempting to work with the Google Drive API in Delphi XE2, and thus far, I have just about everything working. One thing I'm struggling with is the multipart upload. When I attempt to upload a file, I get a 503 error. Normally, that should indicate a problem with the server. However, when I send an upload request with the same body and headers to the same URL using fiddler rather than my API, the file is uploaded successfully. This tells me there has to be a problem with my code. This particular function is a mess, but here it is.
function TGoogleDriveApi.MultipartUpload(aStream : TStream; aTitle : string = 'Untitled';
aDescription : string = ''; mimeType : string = 'application/octet-stream';
indexableText : IGoogleDriveIndexableText = nil;
lastViewedByMeDate : string = ''; modifiedDate : string = '';
parents : IGoogleDriveParentList = nil) : IGoogleDriveFile;
var
json, url, body, boundry, contentType : string;
ss : TStringStream;
ms : TMemoryStream;
lHttpHelper : IHttpHelper;
streamBytes : TBytes;
begin
boundry := 'a_boundry';
body := '--'+boundry+sLineBreak;
body := body + 'Content-Type: application/json; charset=UTF-8';
lHttpHelper := THttpHelper.Create;
if(Token.IsExpired) then
Token.Refresh(TokenUrl, OAuth.ClientId, OAuth.ClientSecret);
url := 'https://www.googleapis.com/upload/drive/v2/files?uploadType=multipart&access_token='+lHttpHelper.UrlEncode(Token.access_token);
json := '{';
json := json + '"title": "'+aTitle+'"';
if(aDescription <> '') then
json := json + ', "description": "'+aDescription+'"';
if(lastViewedByMeDate <> '') then
json := json + ', "lastViewedByMeDate": "'+lastViewedByMeDate+'"';
json := json + ', "mimeType": "'+mimeType+'"';
if(modifiedDate <> '') then
json := json + ', "modifiedDate": "'+modifiedDate+'"';
json := json + '}';
body := body + sLineBreak + sLineBreak + json + sLineBreak + sLineBreak + '--'+boundry;
body := body + sLineBreak + 'Content-Type: '+mimeType + sLineBreak + sLineBreak;
body := body + 'some test text from the api' + sLineBreak + sLineBreak + '--'+boundry+'--';
ss := TStringStream.Create;
ss.WriteString(body);
ss.Position := 0;
ms := TMemoryStream.Create;
ms.Write(ss,ss.Size);
SetLength(streamBytes,aStream.Size);
aStream.Read(streamBytes,aStream.Size);
ms.Write(streamBytes[0],aStream.Size);
ss.Clear;
ss.Position := 0;
ss.WriteString(sLineBreak + sLineBreak + '--'+boundry+'--');
ss.Position := 0;
ms.Write(ss,ss.Size);
contentType := 'multipart/related; boundary="'+boundry+'"';
json := lHttpHelper.PostResponse(url,contentType,ms);
FreeAndNil(ss);
FreeAndNil(ms);
Result := nil;
end;
The line that causes problems is the lHttpHelper.PostResponse call. The code for that is shown here:
function THttpHelper.PostResponse(url, contentType : string; aStream : TStream) : string;
var
lHTTP: TIdHTTP;
lStream : TStringStream;
handler : TIdSSLIOHandlerSocketOpenSSL;
begin
lStream := TStringStream.Create;
lHTTP := TIdHTTP.Create(nil);
handler := TidSSLIOHandlerSocketOpenSSL.Create(nil);
handler.SSLOptions.Method := sslvSSLv3;
lHTTP.IOHandler := handler;
try
lHTTP.Request.ContentType := contentType;
lHTTP.Post(url,aStream,lStream);
lStream.Position := 0;
Result := lStream.ReadString(lStream.Size);
//except
finally
lStream.Free;
lHTTP.Free;
handler.Free;
lStream := nil;
lHTTP := nil;
handler := nil;
end;
end;
I'm currently calling the MultipartUpload function from my test, shown here
procedure TestIGoogleDriveApi.TestMultipartUpload;
var
ReturnValue : IGoogleDriveFile;
fs : TFileStream;
begin
fs := TFileStream.Create('testupload.jpg',fmOpenRead);
ReturnValue := FIGoogleDriveApi.MultipartUpload(fs,'Test Multipart Image Upload from API.txt','test file','image/jpeg');
FreeAndNil(fs);
if(ReturnValue = nil) then
fail('ReturnValue cannot be nil');
end;
Any ideas what might be causing the problems? I'm not even sure what to suspect at this point.
You'll need to somehow follow #RobKennedy's advice. You need to see what's happening on the wire to debug this. Try replacing the https drive url with http and then trace with Wireshark.
#Hendra is also correct, that generally your app needs to implement exponential backoff and retry for 500 errors, although I suspect that isn't your specific problem (yet :-))
After changing two things in my code, and doing some substantial cleanup, I was able to get the upload working. The main changes I made were writing everything directly to the TMemoryStream rather than to a TStringStream then to a TMemoryStream and using AnsiStrings rather than strings. Here is my cleaned up code.
function TGoogleDriveApi.MultipartUpload(aStream: TStream; aFile: TGoogleDriveFileUp) : IGoogleDriveFile;
var
json, url, boundary, body : AnsiString;
lHttpHelper : IHttpHelper;
ms : TMemoryStream;
ss : TStringStream;
writer : IRtSerializeWriter;
reader : IRtSerializeReader;
begin
if(Token.IsExpired) then
Token.Refresh(TokenUrl, OAuth.ClientId, OAuth.ClientSecret);
lHttpHelper := THttpHelper.Create;
ss := TStringStream.Create;
writer := TRtJsonSerializeWriter.Create;
writer.SaveToStream(ss,aFile);
ss.Position := 0;
json := ss.ReadString(ss.Size);
FreeAndNil(ss);
url := 'https://www.googleapis.com/upload/drive/v2/files?uploadType=multipart&access_token='+lHttpHelper.UrlEncode(Token.access_token);
boundary := 'a_bondary';
body := '--'+boundary+sLineBreak;
body := body + 'Content-Type: application/json; charset=UTF-8' + sLineBreak + sLineBreak;
body := body + json + sLineBreak + sLineBreak +'--'+boundary;
body := body + sLineBreak + sLineBreak;
ms := TMemoryStream.Create;
ms.Write(body[1],Length(body));
ms.CopyFrom(aStream, aStream.Size);
body := sLineBreak + sLineBreak + '--' + boundary + '--';
ms.Write(body[1],Length(body));
ms.Position := 0;
json := lHttpHelper.PostResponse(url,'multipart/related; boundary="'+boundary+'"',ms);
ss := TStringStream.Create;
ss.WriteString(json);
ss.Position := 0;
reader := TRtJsonSerializeReader.Create;
Result := TGoogleDriveFileDown.Create;
reader.LoadFromStream(ss,Result as TGoogleDriveFileDown);
FreeAndNil(ms);
FreeAndNil(ss);
end;

Resources