HTML-Code aus Stream

[glkgereon]

Hier mal ein Code den ich mir seit monaten nicht mehr angesehen habe
Ich kann mich noch daran erinnern dass es irgendwie Probleme mit Cookies usw gab, weiss es aber auch net mehr genau

Delphi-Quellcode:

function CreateParamList(P: TStrings): String;
const Sep = '&';
begin
  if P.Count = 0 then
    Result := ''
  else
  begin
    P.Delimiter := Sep;
    Result := '?'+P.DelimitedText;
  end;
end;

procedure TForm_Main.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var S, URL: String;
    Response: TIdHTTPResponseInfo;
begin
// Loader: TDownloader;
// Server: TIdHTTPServer
  URL:='http://'+ARequestInfo.Host+ARequestInfo.Document+CreateParamList(ARequestInfo.Params);
  Log('URL Request "'+URL+'"', llRequest);
  Lst_Requests.Items.Insert(0,'Requesting: '+URL);
  Lst_Requests.Refresh;
  Response:=TIdHTTPResponseInfo.Create(nil,nil);
  try
    S:=Loader.Get(URL,AResponseInfo,ARequestInfo);
    AResponseInfo.ContentText:=S;
  except
    on E: Exception do
      begin
      Log('Error: "'+E.Message+'" "'+URL+'"', llErrors);
      AResponseInfo.ContentText:=
        'An internal Error occured while downloading the requested File
'+#13+#10+
        'Debug information:
'+#13+#10+
        'URL: "'+URL+'"
'+#13+#10+
        'Error: "'+E.Message+'"
';
      end;
  end;
  Org.Analyse(URL,AResponseInfo.ContentText); //Hier habe ich die Seite nochmal manipuliert wenn ich gerade Lust dazu hatte...kA
  Response.Free;
end;

Delphi-Quellcode:

unit UDownloader;

interface

uses IdHTTP, ExtCtrls, SysUtils, Windows, IdHTTPHeaderInfo, IdCustomHTTPServer;

type
  THTTPArray = array of TIdHTTP;
  TDownloader = class(TObject)
  private
    FProxySettings: TIdProxyConnectionInfo;
    FHTTPs: THTTPArray;
    LastCall: Int64;
    FTimer: TTimer;
    function Add: Integer;
    procedure Clear;
    procedure ClearIdle;
    function GetIdle: Integer;
    procedure OnTimer(Sender: TObject);
  public
    constructor Create;
    destructor Destroy;
    function Get(URL: String; var Response: TIdHTTPResponseInfo; var Request: TIdHTTPRequestInfo): String;
    property ProxySettings: TIdProxyConnectionInfo read FProxySettings write FProxySettings;
  end;

implementation

constructor TDownloader.Create;
begin
  inherited;
  Clear; //Init Client-Array
  FProxySettings:=TIdProxyConnectionInfo.Create; //ProxySettings
  FTimer:=TTimer.Create(nil); //Init Timer
  FTimer.Interval:=5*60*1000; //5 minutes
  FTimer.OnTimer:=OnTimer;
  FTimer.Enabled:=True;
end;

destructor TDownloader.Destroy;
begin
  Clear; //Clear List
  FTimer.Free; //Free Timer
  FProxySettings.Free; //Free ProxySettings
  inherited;
end;

function TDownloader.Add: Integer;
begin //Add a new Client
  Result:=Length(FHTTPs); //ID of the new Client
  SetLength(FHTTPs,Result+1); //Resize Array
  FHTTPs[Result]:=TIdHTTP.Create; //Init Client
  FHTTPs[Result].Tag:=0;
  FHTTPs[Result].ReadTimeout:=0;
  FHTTPs[Result].ConnectTimeout:=0;
  FHTTPs[Result].HandleRedirects:=True;
  FHTTPs[Result].ProxyParams.Assign(FProxySettings);
  FHTTPs[Result].AllowCookies:=True;
end;

procedure TDownloader.Clear;
var i:Integer;
begin //Clear the Client-Array
  for i:=0 to Length(FHTTPs)-1 do
    FHTTPs[i].Free;
  SetLength(FHTTPs,0);
end;

procedure TDownloader.ClearIdle;
var i:Integer;
begin //Clear all idle Clients from behind
  for i:=Length(FHTTPs)-1 downto 0 do
    if FHTTPs[i].Tag=0 then
      begin
      FHTTPs[i].Free; //Free Client
      SetLength(FHTTPs,i);
      end
    else
      Break;
end;

function TDownloader.GetIdle: Integer;
var i: Integer;
begin //Get first Idle Client
  Result:=-1;
  for i:=0 to Length(FHTTPs)-1 do
    if FHTTPs[i].Tag=0 then
      begin
      Result:=i;
      Break;
      end;
end;

procedure TDownloader.OnTimer(Sender: TObject);
begin //If not Called for 30 seconds: Clear idle
  if (GetTickCount-LastCall)>30*1000 then ClearIdle;
end;

function TDownloader.Get(URL: String; var Response: TIdHTTPResponseInfo; var Request: TIdHTTPRequestInfo): String;
var I: Integer;
begin //Download URL
  LastCall:=GetTickCount;
  I:=GetIdle; //Get idle Client
  if i=-1 then I:=Add; //If none available create new
  FHTTPs[i].Tag:=1; //Client is in use
  try
    Result:=FHTTPs[i].Get(URL); //Download
    Response.Assign(FHTTPs[i].Response);
    Request.Assign(FHTTPs[i].Request);
  finally
    FHTTPs[i].Tag:=0; //no more in use
    LastCall:=GetTickCount;
  end;
end;

end.

Viel Spaß damit