idHTTP Just freezes up - delphi

I have a button and a tmemo, I want when i click the button it would but the result of a url into the memo. But it freezes up any reason you can see why?
procedure TForm1.sendCommandClick(Sender: TObject);
var
site : string;
begin
Memo1.Lines.Add(getContent('http://something.com'));
end;
function TForm1.getContent(url: String): String;
var
http : TIdHTTP;
begin
http := TIdHTTP.Create(nil);
try
http.HandleRedirects := true;
Result := http.Get(url);
finally
http.Free;
end;
end;
end.

Related

retrieve a json result from a https site

How can I retrieve a JSON result from a HTTPS site?
I prefer a method to no need any DLL.
It show this error:
Error connecting with SSL.error:1409442E:SSL routines:ssl3_read_bytes:tlsv1 alert protocol version.
I'm using Delphi Tokyo 10.2.
function GetUrlContent(s: string): string;
var
IdHTTP1: TIdHTTP;
begin
IdHTTP1 := TIdHTTP.Create;
try
Result := IdHTTP1.Get(s);
finally
IdHTTP1.Free;
end;
end;
procedure GetData;
var
mydata, ordername: string;
begin
ordername := 'https://www.bitstamp.net/api/ticker/';
mydata := GetUrlContent(ordername);
DBMemo7.Text := mydata;
end;
I've also tried this, but it still gets the annoying SSL error:
function GetURLAsStrin1(const aurl: string): string;
var
res, req: String;
sList: TStringList;
IdHttp: TIdHttp;
begin
IdHttp := TIdHttp.Create (nil);
try
IdHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHttp);
req := aurl;
res := IdHttp.Get (req);
result := res;
finally
idHttp.Free;
end;
By default, TIdSSLIOHandlerSocketOpenSSL enables only TLS 1.0. Most likely, the site in question does not support TLS 1.0 anymore. Try enabling TLS 1.1 and 1.2, eg:
function GetUrlContent(url: string): string;
var
IdHTTP1: TIdHTTP;
begin
IdHTTP1 := TIdHTTP.Create;
try
IO := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP1);
IO.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2] // <-- add this!
IdHttp.IOHandler := IO;
Result := IdHTTP1.Get(url);
finally
IdHTTP1.Free;
end;
end;
For newer delphi versions, I would recommend using the in-built HttpClient class. It does not require any external DLLs, and works for both http or https out of the box.
uses
System.Net.HttpClient;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Text := GetUrlContent('https://www.bitstamp.net/api/ticker/');
end;
function TForm1.GetUrlContent(Url: string): string;
var
HttpClient: THttpClient;
Response: IHttpResponse;
begin
HttpClient := THTTPClient.Create;
try
Response := HttpClient.Get(URL);
Result := Response.ContentAsString();
finally
HttpClient.Free;
end;
end;

Login OK to site with TwebBrowser , but not with TidHTTP

May I ask for a little help using Indy to login to a website please?
Firstly, just as a 'proof of concept' I used a TWebBrowser to test my credentials in the following manner ...
procedure TfrmMain.cxButton1Click(Sender: TObject);
begin
webBrow.Navigate('http://assurance.redtractor.org.uk/rtassurance/services.eb');
end;
procedure TfrmMain.webBrowDocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
CurrentBrowser: IWebBrowser2;
TopBrowser: IWebBrowser2;
Document: OleVariant;
Doc3 : IHTMLDocument3;
Frm : IHtmlFormElement;
begin
CurrentBrowser := pDisp as IWebBrowser2;
TopBrowser := (ASender as TWebbrowser).DefaultInterface;
if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
begin
if CurrentBrowser = TopBrowser then
begin
Doc3 := CurrentBrowser.Document as IHTMLDocument3;
Webbrow.OnDocumentComplete := nil; // remove handler to avoid reentrance
Doc3.getElementById('el9M9AQXIL51JI3_loginPnl_username').setAttribute('value', 'aValidUserName', 0);
Doc3.getElementById('el9M9AQXIL51JI3_loginPnl_password').setAttribute('value', 'aValidPassword', 0);
//Frm := Doc3.getElementById('ct100') as IHtmlFormElement;
Doc3.GetElementByID('el9M9AQXIL51JI3_loginPnl_button').click();
end;
end;
end;
I got the above from the whosrdaddy answer here Automated Log In (webBrowser)
That logs me into the site and takes me to a search page ... exactly what I need.
However, I'd like to avoid using a TWebBrowser as I thought my searches would be slow due to the fact the page would need to be rendered.
With that in mind I tried to use Indy 10 to login to the same address, passing the parameters like so ...
idRedTractor.Post(login_URL, Request, Response);
But all this returns is a 'Server Error, Unauthenticated UserName' response.
My full code for trying to login is ...
procedure TfrmMain.btnLogonClick(Sender: TObject);
var
Response : TMemoryStream;
searchResp : TMemoryStream;
Request : TStringList;
searchReq : TStringList;
resultStr : TStringList;
begin
with IdRedTractor do
begin
allowCookies := true;
cookieManager := cookieRedTractor;
IOhandler := IdSSLRedTractor;
request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
request.contentType := 'text/html';
request.userAgent := 'Mozilla/3.0 (compatible; Indy Library)';
end;
with IdSSLRedTractor do
begin
// SSLOptions does not make a difference. Still get a Server Error message
SSLOptions.Mode := sslmUnassigned;
//SSLOptions.Mode := sslmBoth;
//SSLOptions.Mode := sslmClient;
//SSLOptions.Mode := sslmServer;
end;
try
try
response := TMemoryStream.Create;
searchResp := TMemoryStream.Create;
try
request := TStringList.Create;
searchReq := TStringList.Create;
resultStr := TStringList.Create;
// Individual params via FireBug
Request.Add('__EVENTARGUMENT=login');
Request.Add('__EVENTTARGET=el9M9AQXIL51JI3$loginPnl');
Request.Add('__VIEWSTATE=/wEPDwULLTEzMjc3NzQ0ODEPZBYEAgEPZBYCZg9kFgJmDxYCHgRUZXh0BRNDaGVja2VycyAmIFNlcnZpY2VzZAIDD2QWBAICDxYCHgdWaXNpYmxlaGQCCQ9kFgICAg9kFgICBA8WAh8BZxYCAgEPFgIfAWhkZD3T1Ydwd12+6SzZOgVHrnka9LKB');
Request.Add('__VIEWSTATEGENERATOR=9D5BCA8C');
Request.Add('ebAbPwd=' + edtUserPass.text);
Request.Add('ebAbPwd=');
Request.Add('ebAbUser=' + edtUserName.text);
Request.Add('ebAbUser=');
Request.Add('el9M9AQXIL51JI3$loginPnl_...=' + edtUserName.Text);
Request.Add('el9M9AQXIL51JI3$loginPnl_...=' + edtUserPass.text);
Request.Add('el9OK3XX11WQS60_email=');{}
IdRedTractor.Request.Referer := 'http://assurance.redtractor.org.uk/rtassurance/schemes.eb';//initial_URL;
IdRedTractor.Post('http://assurance.redtractor.org.uk/rtassurance/services.eb', Request, Response);
if idRedtractor.ResponseCode = 200 then
begin
resultStr.Clear;
Response.Position := 0;
resultStr.LoadFromStream(Response);
mmoResponse.Lines.AddStrings(resultStr);
end;
finally
request.Free;
searchReq.Free;
resultStr.Free;
end;
finally
response.Free;
searchResp.Free;
end;
except
on e: Exception do
showMessage(e.Message);
end;
end;
Just is case there is some value in the versions of the SSL DLL's, they are 'libeay32.dll' v1.0.1.3 and 'ssleay32.dll', also v1.0.1.3.
May I ask for your help please in understanding what I have missed or done wrong that prevents me from logging into this site with a TidHTTP?
Ok, found your problem.
The site is doing a redirect to the same page after the POST login request.
The key to the solution is setting HandleRedirects to True and change the VMethod variable to GET in the OnHandleRedirect event. I cleaned up the code a bit:
unit SO35263785Test;
interface
uses
IdHttp,
SysUtils,
StrUtils,
StdCtrls,
Classes,
Controls,
Forms;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Client : TIdHttp;
procedure HandleRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
procedure LoginToRedTractor(const Username, Password : String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.HandleRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
begin
VMethod := Id_HTTPMethodGet;
Handled := True;
end;
procedure ExtractViewStateAndGenerator(const Html : String; var ViewState : String; var ViewStateGenerator: String);
var
Ps : Integer;
begin
ViewState := '';
ViewStateGenerator := '';
// we assume __VIEWSTATE and __VIEWSTATEGENERATOR inputs are there, NO error checking
Ps := Pos('__VIEWSTATE', Html);
Ps := PosEx('value', Html, Ps);
Ps := PosEx('"', Html, Ps);
ViewState := Copy(Html, Ps+1, PosEx('"', Html, Ps+1)-Ps-1);
Ps := Pos('__VIEWSTATEGENERATOR', Html);
Ps := PosEx('value', Html, Ps);
Ps := PosEx('"', Html, Ps);
ViewStateGenerator := Copy(Html, Ps+1, PosEx('"', Html, Ps+1)-Ps-1);
end;
procedure TForm1.LoginToRedTractor(const Username, Password : String);
var
GETResponse : String;
Request : TStringList;
ViewState : String;
ViewStateGenerator : String;
begin
Client := TIdHttp.Create;
try
Client.ProtocolVersion := pv1_1;
Client.HTTPOptions := [hoForceEncodeParams, hoKeepOrigProtocol];
Client.AllowCookies := True;
Client.HandleRedirects := True;
Client.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/48.0.2564.103 Safari/537.36';
Client.OnRedirect := HandleRedirect;
GETResponse := Client.Get('http://assurance.redtractor.org.uk/rtassurance/schemes.eb');
ExtractViewStateAndGenerator(GETResponse, ViewState, ViewStateGenerator);
Request := TStringList.Create;
try
Request.Add('__VIEWSTATE='+ViewState);
Request.Add('__VIEWSTATEGENERATOR='+ViewStateGenerator);
Request.Add('__EVENTTARGET=el9M9AQXIL51JI3$loginPnl');
Request.Add('el9M9AQXIL51JI3$loginPnl_username='+Username);
Request.Add('el9M9AQXIL51JI3$loginPnl_password='+Password);
Client.Request.Referer := Client.URL.URI;
Memo1.Text := Client.Post('http://assurance.redtractor.org.uk/rtassurance/services.eb', Request);
finally
Request.Free;
end;
finally
Client.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoginToRedTractor('MyUsername', 'MyPassword');
end;
end
This code has been verified and works in Delphi XE.

Posting Data with Indy and Receiving it to TWebBrowser

I am trying to post data to bing with this code
function PostExample: string;
var
lHTTP: TIdHTTP;
lParamList: TStringList;
begin
lParamList := TStringList.Create;
lParamList.Add('q=test');
lHTTP := TIdHTTP.Create(nil);
try
Result := lHTTP.Post('http://www.bing.com/', lParamList);
finally
FreeAndNil(lHTTP);
FreeAndNil(lParamList);
end;
end;
And then, how can I get the result to the TWebBrowser and display it?
Try LoadDocFromString:
procedure LoadBlankDoc(ABrowser: TWebBrowser);
begin
ABrowser.Navigate('about:blank');
while ABrowser.ReadyState <> READYSTATE_COMPLETE do
begin
Application.ProcessMessages;
Sleep(0);
end;
end;
procedure CheckDocReady(ABrowser: TWebBrowser);
begin
if not Assigned(ABrowser.Document) then
LoadBlankDoc(ABrowser);
end;
procedure LoadDocFromString(ABrowser: TWebBrowser; const HTMLString: wideString);
var
v: OleVariant;
HTMLDocument: IHTMLDocument2;
begin
CheckDocReady(ABrowser);
HTMLDocument := ABrowser.Document as IHTMLDocument2;
v := VarArrayCreate([0, 0], varVariant);
v[0] := HTMLString;
HTMLDocument.Write(PSafeArray(TVarData(v).VArray));
HTMLDocument.Close;
end;
Or you can use the memory streams for loading
uses
OleCtrls, SHDocVw, IdHTTP, ActiveX;
function PostRequest(const AURL: string; const AParams: TStringList;
const AWebBrowser: TWebBrowser): Boolean;
var
IdHTTP: TIdHTTP;
Response: TMemoryStream;
begin
Result := True;
try
AWebBrowser.Navigate('about:blank');
while AWebBrowser.ReadyState < READYSTATE_COMPLETE do
Application.ProcessMessages;
Response := TMemoryStream.Create;
try
IdHTTP := TIdHTTP.Create(nil);
try
IdHTTP.Post(AURL, AParams, Response);
if Response.Size > 0 then
begin
Response.Position := 0;
(AWebBrowser.Document as IPersistStreamInit).Load(
TStreamAdapter.Create(Response, soReference));
end;
finally
IdHTTP.Free;
end;
finally
Response.Free;
end;
except
Result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Params: TStringList;
begin
Params := TStringList.Create;
try
Params.Add('q=test');
if not PostRequest('http://www.bing.com/', Params, WebBrowser1) then
ShowMessage('An unexpected error occured!');
finally
Params.Free;
end;
end;

Upload image to imageshack with delphi

I have the API key and read the sparse documentation on their site, but still having trouble getting this to work so if anyone has any examples they could share then that would be great. I do not need to worry about videos or anything fancy, just a simple upload with the return information will suit my needs.
uses IdHttp;
function PostData:string;
var
url: string;
text: string;
http: TIDHttp;
valid: boolean;
param: TStringList;
begin
http := TIDHttp.Create(nil);
http.HandleRedirects := true;
http.ReadTimeout := 5000;
param := TStringList.create;
param.Clear;
param.Add('fileupload=c:\image.png');
param.Add('key=MY_API_KEY');
param.Add('tags=tag1,tag2');
valid := true;
url := 'http://www.imageshack.us/upload_api.php';
try
text := http.Post(url, param);
except
valid := false;
end;
if valid then
PostData := text
else
PostData := '';
end;
Thx.
Kevin
I pretty much did the exact same thing last nite. Thx tho.
procedure TForm1.Button1Click(Sender: TObject);
var
MPData: TIdMultiPartFormDataStream;
sResponse: string;
begin
MPData := TIdMultiPartFormDataStream.Create;
MPData.AddFile('fileupload','c:\image.png','image/png');
MPData.AddFormField('tags','testfile,flyasia');
MPData.AddFormField('public','no');
MPData.AddFormField('key','API_KEY_HERE');
sResponse := IdHTTP1.Post('http://www.imageshack.us/upload_api.php', MPData);
MPData.Free;
Memo1.Text := sResponse;
end;

delphi 2010 - tidhttp post

i want to post data to the following url:
http://mehratin.heroku.com/personals/new
i write the following code but has problem:
procedure TForm1.Button3Click(Sender: TObject);
var
aStream: TMemoryStream;
Params: TStringList;
begin
aStream := TMemoryStream.Create;
Params := TStringList.Create;
try
with IdHTTP1 do
begin
Params.Add('fname=123');
Params.Add('lname=123');
Request.ContentType := 'application/x-www-form-urlencoded';
try
Response.KeepAlive := False;
Post('http://localhost:3000/personals/new', Params);
except
on E: Exception do
showmessage('Error encountered during POST: ' + E.Message);
end;
end;
how can i post data by TIDHtttp.post method in delphi 2010?
First things first, you'd need to read the http response code (it would have been useful to include that in your question).
In the absence of that I've used the Indy http object before as shown below. I included the parameters in my URL though. To troubleshoot, try running this with an http.Get to ensure the port is open, and you can actually connect to the server. Here's my example for completenes:
// parameters
params := format('export=1&format=%s&file=%s', [_exportType, destination]);
// First setup the http object
procedure TCrystalReportFrame.SetupHttpObject();
begin
try
IDHTTP1.HandleRedirects := TRUE;
IDHTTP1.AllowCookies := true;
IDHTTP1.Request.CacheControl := 'no-cache';
IdHTTP1.ReadTimeout := 60000;
_basePath:= GetBaseUrl;
except
on E: Exception do
begin
Global.LogError(E, 'SetupHttpObject');
end;
end;
end;
// Then have an onwork event
procedure TCrystalReportFrame.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
Http: TIdHTTP;
ContentLength: Int64;
Percent: Integer;
begin
Http := TIdHTTP(ASender);
ContentLength := Http.Response.ContentLength;
end;
// The actual process
procedure TCrystalReportFrame.ProcessHttpRequest(const parameters: string);
var
url : string;
begin
try
try
SetupHttpObject;
IdHTTP1.OnWork:= HttpWork;
url := format('%s&%s', [_basePath, parameters]);
url := IdHTTP1.Post(url);
except
on E: Exception do
begin
Global.LogError(E, 'ProcessHttpRequest');
end;
end;
finally
try
IdHTTP1.Disconnect;
except
begin
end;
end;
end;
end;

Resources