unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, IdHTTP,
Vcl.StdCtrls,
Vcl.ExtCtrls,
IdZLibCompressorBase, IdCompressorZLib, IdCookieManager, IdBaseComponent,
IdComponent, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
IdSSLOpenSSL, IdSSLOpenSSLHeaders, IdCTypes;
type
TForm1 = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager1: TIdCookieManager;
IdCompressorZLib1: TIdCompressorZLib;
procedure Button1Click(Sender: TObject);
procedure IdSSLIOHandlerSocketOpenSSL1StatusInfoEx(ASender: TObject;
const AsslSocket: PSSL; const AWhere, Aret: Integer; const AType,
AMsg: string);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure SetNewIdHTTP;
end;
var
Form1: TForm1;
gIdHTTP : TIdHTTP;
implementation
{$R *.dfm}
procedure TForm1.IdSSLIOHandlerSocketOpenSSL1StatusInfoEx(ASender: TObject;
const AsslSocket: PSSL; const AWhere, Aret: Integer; const AType,
AMsg: string);
begin
SSL_set_tlsext_host_name(AsslSocket, gIdHTTP.Request.Host);
end;
procedure TForm1.SetNewIdHTTP;
begin
if Assigned(gIdHTTP) then
begin
Memo1.Clear;
gIdHTTP.Free;
end;
gIdHTTP := TIdHTTP.Create(nil);
gIdHTTP.AllowCookies := True;
gIdHTTP.HandleRedirects := True;
gIdHTTP.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
gIdHTTP.CookieManager := IdCookieManager1;
gIdHTTP.Compressor := IdCompressorZLib1;
end;
function StreamToText(sStream: TStream; sOldSign, sNewSign: Integer): AnsiString;
var
xBuf: TBytes;
i : Integer;
begin
try
SetLength(xBuf, sStream.Size); // puffer größe bestimmen
sStream.ReadBuffer(Pointer(xBuf)^, Length(xBuf)); // puffer füllen
for I := 0 to Length(xBuf) -1 do
if xBuf[i] = sOldSign then xBuf[i] := sNewSign; // mache aus 0 ein Leerzeichen
finally
SetLength(Result, Length(xBuf)); // ausgabegröße
for I := 0 to Length(xBuf) -1 do
Result[i+1] := AnsiChar(xBuf[i]); // alles aus puffer ins Result
end;
end;
function IdHTTP_Get(sHTTP: TIdHTTP; sURL: String): String;
var
xResult : TStringList;
xMemoRes : TMemoryStream;
begin
xResult := TStringList.Create;
xMemoRes := TMemoryStream.Create;
try
try
sHTTP.Get(sURL, xMemoRes);
xMemoRes.Position := 0;
xResult.Text := StreamToText(xMemoRes, 0, 20);
except
on E: EIdHTTPProtocolException do
begin
xResult.Add('E.Message: ' + E.Message);
xResult.Add('E.ErrorMessage:');
xResult.Add(E.ErrorMessage);
end;
end;
finally
Result := xResult.Text;
xResult.Free;
xMemoRes.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetNewIdHTTP;
Memo1.Text := IdHTTP_Get(gIdHTTP, Edit1.Text);
end;
end.