Sending a File via a secure connection with Indy to a website - delphi

I have to send an XML-File to a Website with a secure Connection. Delphi 2010, Indy 10.5.9. The Code used is as follows:
Params: TIdMultiPartFormDataStream;
ResponseStr: string;
begin
result := 0;
sRootCertFile := 'xxx\Digital.pem';
sCertFile := 'xxx\Digital.pem';
sKeyFile := 'xxx\Digital.pem';
with FAdminSetup.RDWSSLHandler do
begin
SSLOptions.VerifyMode := [];
SSLOptions.VerifyDepth := 0;
SSLOptions.RootCertFile := sRootCertFile;
SSLOptions.CertFile := sCertFile;
SSLOptions.KeyFile := sKeyFile;
end;
sURL := 'https://xxx/xxxservice';
begin
IdHttpVVO := TIdHttp.Create(nil);
try
// IdHttpVVO.Request.ContentType := 'multipart/form-data';
// IdHttpVVO.ProtocolVersion := pv1_1;
// IdHttpVVO.HTTPOptions := [hoKeepOrigProtocol,hoForceEncodeParams];
// IdHttpVVO.Request.Connection := 'Keep-Alive';
// IdHttpVVO.Request.CacheControl := 'no-cache';
// IdHttpVVO.Request.ContentLength := Length(sAnsiXML); // <-- new
IdHttpVVO.IOHandler := FAdminSetup.RDWSSLHandler;
Params := TIdMultiPartFormDataStream.Create;
try
with Params do
begin
AddFile('file', filename, GetMIMETypeFromFile(filename));
end;
resultStr := IdHttpVVO.Post(sURL, Params);
finally
Params.Free;
end;
ShowMessage(resultstr);
The result is always the same:
'HTTP/1.0 500 Error'
when doing the post part.
All the remarks have been tried and did not give any change. The Password for the connection is supplied as follows:
procedure TFAdminSetup.RDWSSLHandlerGetPasswordEx(ASender: TObject;
var VPassword: AnsiString; const AIsWrite: Boolean);
begin
VPassword := 'xxx';
end;
The Website is working, the certificates seem to be ok, as there is a small tool included written in C that works.
Where is my mistake? Thanks

Related

Delphi SSL MITM Proxy based on INDY - problem with content loading

I'm writing MITM ssl proxy using indy. i use IdHTTPserver component with self signed certificate for proxy server, and on event of CommandOther i do TcpCleint request to site and return data in HTTPServer. But problem is, some scripts, especially JS and some pictures from web pages not being loaded at all, or load after timeout, so i recieve html code in browser, but crippled by not working js (mostly). Here's my code for CommandOther:
procedure TForm3.IdHTTPServer1CommandOther(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
client: TIdTCPClient;
Headers, headers1: TIdHeaderList;
s, ResponseCode, ResponseText: string;
req,req2:string;
Size: Int64;
Strm,strm2: TIdTCPStream;
ssl: TIdSSLIOHandlerSocketOpenSSL;
clientcount:integer;
begin
Memo3.lines.Add('start');
client := TIdtCPClient.Create(nil);
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(client);
client.IOHandler := ssl;
s := ARequestInfo.URI;
client.Host := Fetch(s, ':', True);
client.Port := StrToIntDef(s, 443);
client.ConnectTimeout := 2000;
s := '';
Memo3.lines.Add('connecting');
client.UseNagle:=true;
client.Connect;
//here i handle CONNECT command
AResponseInfo.ResponseNo := 200;
AResponseInfo.ResponseText := 'Connection established';
aresponseinfo.WriteHeader;
// activate SSL between this proxy and the client
TIdSSLIOHandlerSocketOpenSSL(AContext.Connection.Socket).PassThrough
:= false;
Memo3.lines.Add('connected');
while AContext.Connection.Connected and Client.Connected do
begin
try
memo4.Lines.Add('---start header-------');
headers1 := TIdHeaderList.Create(QuoteHTTP);
headers1.FoldLength := MaxInt;
repeat
s := AContext.Connection.IOHandler.ReadLn;
Memo4.lines.Add(s);
headers1.Add(s);
if s = '' then
Break;
until False;
client.WriteHeader(headers1);
memo4.Lines.Add('-----header written-----');
memo5.Lines.Add('----------');
if Headers1.IndexOfName('Content-Length') <> -1 then
begin
strm2:=TIdTCPStream.Create(client);
memo5.Lines.Add('post');
Size := StrToInt64(Headers1.Values['Content-Length']);
if Size > 0 then
AContext.Connection.IOHandler.ReadStream(Strm2, Size, False);
end;
memo4.Lines.Add('---response headers-------');
Headers := TIdHeaderList.Create(QuoteHTTP);
try
Headers.FoldLength := MaxInt;
repeat
s := client.IOHandler.ReadLn;
Memo4.lines.Add(s);
acontext.Connection.IOHandler.WriteLn(s);
Headers.Add(s);
if s = '' then
Break;
until False;
memo4.Lines.Add('---respone headers read-------');
Strm := TIdTCPStream.Create(AContext.Connection);
try
if Pos('chunked', Headers.Values['Transfer-Encoding']) <> 0 then
begin
memo4.Lines.Add('chunked');
repeat
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
Size := StrToInt64('$' + Fetch(s, ';'));
if Size = 0 then
Break;
client.IOHandler.ReadStream(Strm, Size, False);
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
until False;
repeat
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
until s = '';
end
else if Headers.IndexOfName('Content-Length') <> -1 then
begin
Size := StrToInt64(Headers.Values['Content-Length']);
end;
if Size > 0 then
client.IOHandler.ReadStream(Strm, Size, False);
end
else
begin
memo5.Lines.Add('big read(');
AResponseInfo.CloseConnection := true;
try
client.IOHandler.ReadStream(Strm, -1, True);
except
on E: EIdSocketError do
begin
raise;
end;
end;
end;
finally
Strm.Free;
end;
finally
Headers.Free;
strm2.Free;
headers1.Free;
end;
finally
client.Disconnect;
end;
client.Free;
end;
end;

sslv3 alert handshake failure Delphi

Delphi 10 seattle
OpenSSL 1.0.0.10 but same result with more recent libraries.
the following code has been working for about two years, but lately we are getting an error:
14094410:SSL3_read_bytes:sslv3 alert handshake failure
Have used wireshark to confirm TLSv1.2 is being used. can provide capture file if needed.
function GetAddress(ID_ID : Integer; Rijksregister : String) : Boolean;
var
gp : GetPerson;
Cor : CorrelationType;
P : RrSimplePersonService_v02PortType;
Resp : GetPersonResponse;
FHTTPRio: THTTPRio;
FReqResp : TWisaHTTPReqResp;
FSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
Adr : PersonLegalAddressType;
CERTPath : String;
i, j : integer;
begin
CERTPath := IncludeTrailingPathDelimiter(ExtractFilePath(Paramstr(0)));
Result := false;
// declarations
Cor := CorrelationType.Create;
Cor.requestorId := '01234567890';
Cor.requestorName := 'WisaMockupService';
Cor.applicationId := 'WISA';
Cor.correlationId := getGUID;
gp := getPerson.Create;
gp.identifier := Rijksregister;
gp.correlation := Cor;
// actual call
CoInitialize(nil);
fHTTPRio:=THTTPRio.Create(Self);
fHTTPRio.URL:=fURL;
fHTTPRio.Converter.Options := fHTTPRio.Converter.Options + [soSendMultiRefObj, soTryAllSchema, soRootRefNodesToBody, soCacheMimeResponse, soUTF8EncodeXML, soSOAP12];
fHTTPRio.OnBeforeExecute := IH7BeforeExecute;
fHTTPRio.OnAfterExecute := IH7AfterExecute;
FReqResp := TWisaHTTPReqResp.Create(self);
FReqResp.URL := fURL;
FReqResp.InvokeOptions := FReqResp.InvokeOptions + [soNoSOAPActionHeader];
FReqResp.ConnectTimeout := 60000;
FReqResp.ReceiveTimeout := 60000;
FReqResp.SendTimeout := 60000;
FReqResp.WebNodeOptions:= FReqResp.WebNodeOptions+[wnoSOAP12];
fHTTPRio.HTTPwebNode := FReqResp;
fHTTPRio.HTTPwebNode.UserName := fUser;
fHTTPRio.HTTPwebNode.Password := fPaswoord;
fHTTPRio.HTTPwebNode.OnBeforePost := BeforePost;
FSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(self);
FSSLIOHandler.SSLOptions.Method := sslvTLSv1_2;
FSSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2,sslvTLSv1_1,sslvTLSv1];
FSSLIOHandler.SSLOptions.CipherList := 'ALL';
FSSLIOHandler.SSLOptions.RootCertFile := CERTPath + 'CACert.crt';
FSSLIOHandler.SSLOptions.KeyFile := CERTPath + 'privateKey.key';
FSSLIOHandler.SSLOptions.CertFile := CERTPath + 'certificate.crt';
FSSLIOHandler.SSLOptions.Mode := sslmUnassigned;
FSSLIOHandler.SSLOptions.VerifyMode := [];
FSSLIOHandler.SSLOptions.VerifyDepth := 3;
FSSLIOHandler.OnGetPassword := getPassword;
FSSLIOHandler.UseNagle := true;
FSSLIOHandler.ReadTimeout := 60000;
FSSLIOHandler.ConnectTimeout := 60000;
FSSLIOHandler.OnStatusInfoEx := SSLStatusInfoEx;
FSSLIOHandler.OnVerifyPeer := VerifyPeer;
FReqResp.IOHandler := FSSLIOHandler;
// actual call
P := (fHTTPRio as RrSimplePersonService_v02PortType);
Try
Resp := P.GetPerson(gp);
Except
on e : exception do
begin
Showerror(ID_ID, e.message + ' ' + format(rsRijksregister2,
[Rijksregister]), '', '');
exit;
end;
End;
if not Assigned(Resp) then
exit;
# do something with Response
# end
Result := true;
end;
procedure IH7BeforeExecute(const MethodName: string;
SOAPRequest: TStream);
var
S : TStringStream;
MyStringList: TStringList;
CreateTime, ExpiryTime : TDateTime;
begin
MyStringList := TStringList.Create;
try
Inherited;
CreateTime := Now;
ExpiryTime := IncSecond(CreateTime,600);
SOAPRequest.Position := 0;
MyStringList.LoadFromStream(SOAPRequest);
MyStringList.Text := StringReplace(MyStringList.Text, '<soap-env:body>', Format(SoapHeader,[getTSToken, TimeToString(CreateTime), TimeToString(ExpiryTime), getToken, fGebruiker, fPaswoord]) + '<SOAP-ENV:Body>', [RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, '</GetPerson>', '</ws:GetPerson>', [RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP-ENV:', 'SOAP:', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP-ENV=', 'SOAP=', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, '<SOAP:Envelope xmlns:SOAP="http://www.w3.org/2003/05/soap-envelope" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">', '<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope" xmlns:ws="http://person.ws.egov.apogado.com/SimplePersonSchema/v1_2/ws">', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:Body', 'soap:Body', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<GetPerson xmlns="http://person.ws.egov.apogado.com/SimplePersonSchema/v1_2/ws">', '<ws:GetPerson>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<transaction xmlns="" xsi:nil="true"/>', '', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '</SOAP:Envelope>', '</soap:Envelope>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<identifier xmlns="urn:oslo:names:specification:schema:xsd:CommonBasicComponents-1"><Identifier xmlns="http://www.w3.org/ns/corevocabulary/BasicComponents">', '<identifier>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '</Identifier>', '', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:Header', 'soap:Header', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:mustUnderstand="true"', 'soap:mustUnderstand="true"', [RfReplaceAll]);
SOAPRequest.Position := 0;
SOAPRequest.Size:=0;
MyStringList.SaveToStream(SOAPRequest);
finally
MyStringList.Free;
end;
S:=TStringStream.Create('');
try
S.CopyFrom(SOAPRequest,0);
SOAPRequest.Position:=0;
// eventueel loggen van request
//Log('HTTPRIO Verstuurd bericht:'+sLineBreak+S.DataString);
finally
S.Free;
end;
end;
procedure IH7AfterExecute(const MethodName: string;
SOAPResponse: TStream);
Var
S : TStringStream;
begin
S:=TStringStream.Create('');
try
S.CopyFrom(SOAPResponse,0);
SOAPResponse.Position:=0;
finally
S.Free;
end;
end;
Procedure GetPassword(var Password: string);
begin
Password := ansistring('********');
end;
procedure SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL;
const AWhere, Aret: Integer; const AType, AMsg: string);
begin
SSL_set_tlsext_host_name(AsslSocket, fURL);
end;
procedure BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);
begin
// nothing atm
end;
From the pcap it can be seen that an initial successful TLS handshake is done and also application data are transferred from the client to the server and then a new handshake is initiated by the server followed with an alert send by the server. The successful initial handshake means that neither TLS protocol version, nor cipher, nor server certificate are the problem.
While it is impossible to look at the details of the application data, the second handshake and the alert since they are encrypted the sequence of records suggests that:
After the successful initial TLS handshake a HTTP request (i.e. application data) is done for a resource which requires authentication with a client certificate.
The server therefore triggers a renegotiation. In the second TLS handshake the server will request this certificate.
The server does not like the certificate send by the client or the client does not send a certificate. The server therefore aborts the connection with an alert message.
Given that it worked before but fails now I suggest that one of these is the cause of the problem:
The existing certificate might be expired or revoked.
Changes to the server result in the server no longer accepting the certificate, for example because the CA is no longer trusted.
The certificate was replaced on the client side. But the new certificate is not what the server expects to get or is wrongly setup (like missing a chain certificate).

Delphi upload to https and verify smart card certificate

I'm using Delphi XE and 10.1 Berlin.
I need to sent xml to HTTPS (using Indy 10) and verify my smart card certificate.
In 10.1 Berlin, this code works but i get error SSL3_GET_SERVER_CERTIFICATE: Certificate verify failed.
Do I need assign RootCertFile, CertFile or KeyFile, and how to do it from smart card or cert store?
This is part of my code:
procedure TFR_O1.Button4Click(Sender: TObject);
var
Req: TStream;
S, xml_file: String;
SSL1: TIdSSLIOHandlerSocketOpenSSL;
begin
OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);
if OpenDialog1.Execute then
begin
xml_file := OpenDialog1.FileName;
end;
Req := TStringStream.Create(xml_file, TEncoding.UTF8);
try
SSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
SSL1.SSLOptions.Method := sslvSSLv23;
SSL1.SSLOptions.Mode := sslmClient;
SSL1.SSLOptions.VerifyMode := [sslvrfPeer,sslvrfFailIfNoPeerCert,sslvrfClientOnce];
SSL1.SSLOptions.VerifyDepth := 0;
//SSL1.SSLOptions.RootCertFile := '';
//SSL1.SSLOptions.CertFile := '';
//SSL1.SSLOptions.KeyFile := '';
SSL1.OnVerifyPeer := IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
IdHTTP1.IOHandler := SSL1;
IdHTTP1.Request.ContentType := 'application/octet-stream';
IdHTTP1.Request.Charset := 'UTF-8';
S := IdHTTP1.Post('https://11.11.11.11:11/api/upload', Req);
finally
SSL1.Free;
end;
finally
Req.Free;
end;
end;
function TFR_O.IdSSLIOHandlerSocketOpenSSL1VerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
begin
ShowMessage(Certificate.FingerprintAsString);
ShowMessage(Certificate.Subject.OneLine);
ShowMessage(Certificate.Issuer.OneLine);
if ADepth = 0 then
begin
Result := AOk;
end
else
begin
Result := True;
end;
end;
I have been searching on web, but I haven't find any solution or example how to get cert from smart card.

send and recive TStringStream with indyTcp server and client

I am trying to send a TStringStream from client to server, then send it back from server to client, using Indy TCP components.
Here is my client code:
var
Jpg: TJPEGImage;
StringStream: TStringStream;
strcams, StringImageData: String;
byt, i: integer;
procedure SendCommandWithParams(Command, Params: String);
begin
Lock;
try
if not FTCP.Connected then
begin
exit;
end;
FTCP.Socket.WriteLn('1' + Command, IndyTextEncoding_UTF8);
FTCP.Socket.WriteLn(Params, IndyTextEncoding_UTF8);
finally
Unlock;
end;
end;
begin
Jpg := TJPEGImage.Create;
StringStream := TStringStream.Create('');
try
try
Jpg.Performance := jpBestSpeed;
Jpg.ProgressiveEncoding := True;
Jpg.ProgressiveDisplay := True;
Jpg.Assign(Image2.Picture.Bitmap);
Jpg.CompressionQuality := 25;
Jpg.Compress;
Jpg.SaveToStream(StringStream);
StringImageData := StringStream.DataString;
strcams := '<[S:' + IntToStr(Length(StringImageData)) + 'B]>' +
StringImageData;
if Length(strcams) < byt then
begin
SendCommandWithParams('SIMGSEND', strcams + sep + 'IMGID5423' + sep);
end;
except
on e: exception do
//
end;
finally
StringImageData := '';
FreeAndNil(Jpg);
FreeAndNil(StringStream);
end;
end;
I can receive the TStringStream data, but the data received is corrupted, and some times it gets replaced with the second parameter that I send which is 'IMGID5423' + sep. I am not sure if this is because of some limit of packet sending through TCP so the data does not arrive complete, or is this a parser issue?
My current parser should separate each text that ended with #13#10. Here is how it looks:
var
ReceiveParams, ReceiveStream: Boolean;
S: string;
Command: String;
begin
Command := Fholdcommand;
ReceiveParams := false;
ReceiveStream := false;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end;
if ReceiveParams then // params incomming
begin
S := FTCP.Socket.ReadLn(IndyTextEncoding_UTF8);
FCMD := Command;
FPRMS := S;
FSTREAM := false;
if Assigned(FOnCallbackProc) then
begin
Synchronize(DoCallbackProc);
end;
end;
I am still confused about the real issue. I try to send the TStringStream in a local procedure, and it is received normally without any corruption.
Am I sending the data wrong altogether through Indy?
This is how I am receiving the data:
procedure CreateJpg(Data:string);
var
StringStream : TStringStream;
JpegImage : TJPEGImage;
Bitmap : TBitmap;
tmpPos:integer;
pp:string;
label check;
begin
GData := Data;
if LeftStr(GData,4) = '<[S:' then
begin
tmpPos := Pos(WideString('B]>'),GData);
pp := Copy(GData,5,tmpPos-5);
CDataELen := StrToInt(pp); //MidStr(st,5,tmppos - 5);
CData := RightStr(GData,length(GData)-(tmppos+2));
goto check;
end;
CData := CData + GData;
check:
//if CDataELen = length(CData) then
begin
StringStream := TStringStream.Create('');
JpegImage := TJpegImage.Create;
StringStream.WriteString(CData);
CData := '';
try
try
StringStream.Seek(0, soFromBeginning);
JpegImage.LoadFromStream(StringStream);
Bitmap := TBitmap.Create;
with Bitmap do
begin
Canvas.Lock;
try
Width := JpegImage.Width;
Height := JpegImage.Height;
Canvas.Draw(0, 0, JpegImage);
finally
Canvas.Unlock;
end;
end;
img.Picture.Bitmap.Width := Bitmap.Width;
img.Picture.Bitmap.Height := Bitmap.Height;
img.Picture.Bitmap.Canvas.Draw(0, 0, Bitmap);
except
on E: Exception do
//
end;
finally
FreeAndNil(StringStream);
FreeAndNil(JpegImage);
FreeAndNil(Bitmap);
end;
end;
end;
The problem is that you are saving the JPG binary data to a TStringStream and then letting it reinterpret the binary data as if it were string data. You can't do that. You need to save the JPG data to a binary stream instead, like TMemoryStream, and then encode the binary data using a string-safe encoding, like Base64.
Try something more like this instead:
uses
..., IdCoder, IdCoderMIME;
...
var
Jpg: TJPEGImage;
JpegStream: TMemoryStream;
strcams, StringImageData: String;
begin
try
JpegStream := TMemoryStream.Create;
try
Jpg := TJPEGImage.Create;
try
Jpg.Performance := jpBestSpeed;
Jpg.ProgressiveEncoding := True;
Jpg.ProgressiveDisplay := True;
Jpg.Assign(Image2.Picture.Bitmap);
Jpg.CompressionQuality := 25;
Jpg.Compress;
Jpg.SaveToStream(JpegStream);
finally
Jpg.Free;
end;
JpegStream.Position := 0;
StringImageData := TIdEncoderMIME.EncodeStream(JpegStream);
finally
JpegStream.Free;
end;
strcams := '<[S:' + IntToStr(Length(StringImageData)) + 'B]>' + StringImageData;
SendCommandWithParams('SIMGSEND', strcams + sep + 'IMGID5423' + sep);
except
on e: exception do
//
end;
end;
And then on the receiving end:
procedure CreateJpg(Data: string);
var
JpegStream: TMemoryStream;
JpegImage: TJPEGImage;
Bitmap: TBitmap;
tmpPos, tmpLen: integer;
pp: string;
begin
try
if not TextStartsWith(Data, '<[S:') then
begin
// bad data, do something else...
Exit;
end;
tmpPos := Pos('B]>', Data);
pp := Copy(Data, 5, tmpPos-5);
tmpLen := StrToInt(pp);
Data := Copy(Data, tmpPos+3, tmpLen);
Bitmap := TBitmap.Create;
try
JpegImage := TJpegImage.Create;
try
JpegStream := TMemoryStream.Create;
try
TIdDecoderMIME.DecodeStream(Data, JpegStream);
JpegStream.Position := 0;
JpegImage.LoadFromStream(JpegStream);
finally
JpegStream.Free;
end;
with Bitmap do
begin
Canvas.Lock;
try
Width := JpegImage.Width;
Height := JpegImage.Height;
Canvas.Draw(0, 0, JpegImage);
finally
Canvas.Unlock;
end;
end;
finally
JpegImage.Free;
end;
img.Picture.Assign(Bitmap);
finally
Bitmap.Free;
end;
except
on E: Exception do
//
end;
end;
Your problem appears to be that you are treating binary data as though it is text. Binary data can contain anything, for instance #13#10 line breaks or indeed anything whatsoever.
If you wish to send that data as text, then you need to use a text encoding. For example, encode it as base64.
Or transmit the content as binary rather than text.

Delphi idhttp long URL parameter is splittet automatically

I am using indys idhttp to submit an URL (post)
Procedure submit_post(url_string,EncodedStr:string;amemo:TMemo);
var
aStream: TMemoryStream;
Params: TStringStream;
begin
aStream := TMemoryStream.create;
Params := TStringStream.create('');
try
with Fmain.IdHTTP1 do
begin
Params.WriteString(EncodedStr);
Request.ContentType := 'application/x-www-form-urlencoded';
Request.Charset := 'utf-8';
try
Response.KeepAlive := False;
Post(url_string, params, aStream);
except
on E: Exception do
begin
Screen.Cursor := crDefault;
exit;
end;
end;
end;
aStream.WriteBuffer(#0' ', 1);
aStream.Position := 0;
amemo.Lines.LoadFromStream(aStream);
Screen.Cursor := crDefault;
finally
aStream.Free;
Params.Free;
end;
end;
It works like a charm for me. I am trying to submit a URL (post) with a parameter containing 300 chars, but will be splittet automatically by adding an "&" every 90 chars. So the server only receives 90 chars instead of 300.
How can I submit an URL with a 300 character parameter without this automatic separation ?
function SubmitPost(Params:String): string;
const
URL= 'http://xxxx.com/register.php?';
var
lHTTP: TIdHTTP;
Source,
ResponseContent: TStringStream;
I:Integer;
begin
lHTTP := TIdHTTP.Create(nil);
lHTTP.Request.ContentType := 'text/xml';
lHTTP.Request.Accept := '*/*';
lHTTP.Request.Connection := 'Keep-Alive';
lHTTP.Request.Method := 'POST';
lHTTP.Request.UserAgent := 'OS Test User Agent';
Source := TStringStream.Create(nil);
ResponseContent:= TStringStream.Create;
try
try
lHTTP.Post(URL+Params, Source, ResponseContent);
Result := ResponseContent.DataString;
except
//your exception here
end;
finally
lHTTP.Free;
Source.Free;
ResponseContent.Free;
end;
end;
Usage
mmo1.Text := SubmitPost('Username=xxxx&Password=xxxx');
I found the mistake. My Post function works perfectly, but the URL is built by params coming from a memo line. With "WantReturns = FALSE", I can build a URL with the maximum line length of the memo. I guess 1024 characters per line which is okay for me.

Resources