Einzelnen Beitrag anzeigen

bogdan

Registriert seit: 15. Apr 2013
77 Beiträge
 
#17

AW: Mit IdHTTP Seite aufrufen und an MemoryStream übergeben = Zeichen fehlerhaft

  Alt 27. Apr 2018, 12:43
Code:
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.
  Mit Zitat antworten Zitat