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;
Related
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' + //
'®_user_name=' + edtRegName.Text + //
'®_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
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);
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;
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.
I'm making requests to the webaddress to get XML files throught the HTTPS connection. But this connection works like 50%. In most cases it fails. Usual error is "socket error #10060". Or "Error connecting with SSL. EOF was observed that violates the protocol". What I'm doing wrong?
function SendRequest(parameters: string): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TStringStream;
xDoc: IXMLDocument;
begin
sPostData := TStringList.Create;
try
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add(parameters);
sHttpSocket := TIdHTTP.Create;
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Request.Method := 'POST';
resStream := TStringStream.Create;
sHttpSocket.Post(Self.sUrl, sPostData, resStream);
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
resStream.Free;
sHttpSocket.Free;
sshSocketHandler.Free;
sPostData.Free;
except on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end
end;
end;
Maybe I can do this in another way, that works like 100%, when internet connection is available?
Regards,
evilone
An "EOF" error suggests you are connnecting to a server that is not actually using SSL to begin with, or the SSL data may be corrupted.
Besides that, why are you including explicit '&' characters between your post data parameters? Don't do that, Indy will just encode them and send its own '&' characters. Also, consider using TMemoryStream instead of TStringStream to ensure IXMLDocumect.LoadFromStream() is loading the server's original raw XML data as-is, and not an altered version that the RTL/VCL produces due to Unicode handling (TStringStream is TEncoding-enabled).
Edit: Given the URL you provided, an example of calling verifyUser() would look like this:
const
ERPLYAccountCode = '...';
function verifyUser(const user, pass: string; const sessionLength: Integer = 3600): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TMemoryStream;
xDoc: IXMLDocument;
begin
Result := nil;
try
resStream := TMemoryStream.Create;
try
sPostData := TStringList.Create;
try
sPostData.Add('clientCode=' + ERPLYAccountCode);
sPostData.Add('request=verifyUser');
sPostData.Add('version=1.0');
sPostData.Add('responseType=XML');
sPostData.Add('responseMode=normal');
sPostData.Add('username=' + user);
sPostData.Add('password=' + pass);
sPostData.Add('sessionLength=' + IntToStr(sessionLength));
sHttpSocket := TIdHTTP.Create;
try
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(sHttpSocket);
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Post('https://www.erply.net/api/', sPostData, resStream);
finally
sHttpSocket.Free;
end;
finally
sPostData.Free;
end;
resStream.Position := 0;
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
finally
resStream.Free;
end;
except
on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end;
end;
end;