httptask.pas

Delphi中处理线程池的一个组件,非常好用.

unit HTTPtask;

interface

uses
  Classes, SysUtils, IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
  ThreadTask, lvkZLibUtils;

type
  THTTPtask = class(TAdvThreadTask)
  private
    procedure CreateHTTP;
    procedure FreeHTTP;
  protected
    _HTML : string;
    _HTTP : TIdHTTP;
    _SSL : TIdSSLIOHandlerSocket;
    procedure InitHTTP;
    procedure RecrHTTP;
    procedure DebugHtml;
    procedure MethodStream(Method : TIdHTTPMethod; Url : string; outStream : TMemoryStream = nil; Params : TStringList = nil);
    procedure GetHtml(Url : string);
    procedure GetStream(Url : string; Stream : TMemoryStream);
    procedure PostHtml(Url : string; Params : TStringList);
    procedure DoJob; override;
    function Login : boolean; virtual;
    procedure Process; virtual; abstract;
  public
    _TIME_OUT : Integer;
    //
    _USE_PROXY : boolean;
    _PROXY_ADDR : string;
    _PROXY_PORT : Integer;
    _NEED_AUTH : boolean;
    _PROXY_USER : string;
    _PROXY_PASS : string;
    //
    _LOGIN_NAME : string;
    _LOGIN_PASS : string;
    procedure Stop; override;
    constructor Create;
    destructor Destroy;override;
  end;

implementation


{THTTPtask}

constructor THTTPtask.Create;
begin
  inherited Create;
  _USE_PROXY := False;
  _TIME_OUT := 5000;
end;

destructor THTTPtask.Destroy;
begin
//  FreeHTTP;
  inherited Destroy;
end;

procedure THTTPtask.Stop;
begin
  FreeHTTP;
  inherited Stop;
end;

procedure THTTPtask.CreateHTTP;
begin
  _HTTP := TIdHTTP.Create(nil);
  _SSL := TIdSSLIOHandlerSocket.Create(nil);
end;

procedure THTTPtask.FreeHTTP;
begin
  FreeAndNil(_SSL);
  FreeAndNil(_HTTP);
end;

procedure THTTPtask.InitHTTP;
begin
  with _HTTP do
  begin
    HTTPOptions := [hoKeepOrigProtocol,hoForceEncodeParams];
    ProtocolVersion := pv1_1;
    ReadTimeout := _TIME_OUT;
    HandleRedirects := True;
    AllowCookies := True;
    with Request do
    begin
      CacheControl := 'no-cache';
      ContentType := 'application/x-www-form-urlencoded';
      Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*';
      AcceptLanguage := 'zh-cn';
      Connection := 'Keep-Alive';
      AcceptEncoding := 'gzip, deflate';
      UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Maxthon; .NET CLR 2.0.50727)';
    end;
  end;
  _SSL.SSLOptions.Method := sslvSSLv3;
  if _USE_PROXY then
  begin
    _HTTP.ProxyParams.ProxyServer := _PROXY_ADDR;
    _HTTP.ProxyParams.ProxyPort := _PROXY_PORT;
    if _NEED_AUTH then
    begin
      _HTTP.ProxyParams.ProxyUsername := _PROXY_USER;
      _HTTP.ProxyParams.ProxyPassword := _PROXY_PASS;
    end;
  end;
end;

procedure THTTPtask.RecrHTTP;
begin
  FreeHTTP;
  CreateHTTP;
  InitHTTP;
end;

procedure THTTPtask.DebugHtml;
var
  HtmlSl : TStringList;
begin
  HtmlSl := TStringList.Create;
  with HtmlSl do
  begin
    Add(_HTML);
    SaveToFile(ExtractFilePath(ParamStr(0))+'debug.htm');
    Free;
  end;
end;

procedure THTTPtask.MethodStream(Method : TIdHTTPMethod; Url : string; outStream : TMemoryStream = nil; Params : TStringList = nil);
var
  inStream : TMemoryStream;
begin
  inStream := TMemoryStream.Create;
  try
//    try
      case Method of
      hmGet   : _HTTP.Get(Url, inStream);
      hmPost  : _HTTP.Post(Url, Params, inStream);
      hmTrace : _HTTP.Trace(Url,inStream);
      hmPut   : _HTTP.Put(Url,inStream);
      end;
//    except
//      on e: exception do
//      begin
//        TraceLog('wokaowokao!!!!');
//      end;
//    end;
    try
      gZipDecompress(inStream, outStream);
    except
      inStream.Position := 0;
      OutStream.CopyFrom(inStream,inStream.Size);
    end;
  finally
    inStream.Free;
    _HTTP.Request.Referer := '';
  end;
end;

procedure THTTPtask.GetStream(Url : string; Stream : TMemoryStream);
begin
  MethodStream(hmGet,Url,Stream);
end;

procedure THTTPtask.GetHtml(Url : string);
var
  outStream: TMemoryStream;
begin
  outStream := TMemoryStream.Create;
  try
    MethodStream(hmGet,Url,outStream);
    _HTML := PChar(outStream.Memory);
  finally
    outStream.Free;
  end;
end;

procedure THTTPtask.PostHtml(Url : string; Params : TStringList);
var
  outStream: TMemoryStream;
begin
  outStream := TMemoryStream.Create;
  try
    MethodStream(hmPost,Url,outStream,Params);
    _HTML := PChar(outStream.Memory);
  finally
    outStream.Free;
  end;
end;

procedure THTTPtask.DoJob;
begin
  CreateHTTP;
  InitHTTP;
  if Login then Process;
  FreeHTTP;
end;

function THTTPtask.Login : boolean;
begin
  Result := True;
end;



end.