httptask.pas

ThreadPro 是本人开发的一套用于多线程编程的 Delphi 基础类库

unit HTTPtask;

interface

uses
  Classes, SysUtils, IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze, IdURI,
  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
    _READ_TIME_OUT : Integer;         // to be rename
    _CONN_TIME_OUT : Integer;    //added 2006.7.11
    //
    _USE_PROXY : boolean;
    _PROXY_ADDR : string;
    _PROXY_PORT : Integer;
    _NEED_AUTH : boolean;
    _PROXY_USER : string;
    _PROXY_PASS : string;
    //
    _SSL_ENABLE : Boolean;
    procedure Stop; override;
    constructor Create;
  end;

implementation


{THTTPtask}

constructor THTTPtask.Create;
begin
  inherited Create;
  _USE_PROXY := False;
  _READ_TIME_OUT := 5000;
  _CONN_TIME_OUT := 5000;
  _SSL_ENABLE := False;
end;

procedure THTTPtask.Stop;
begin
//  FreeHTTP;
//  inherited Stop;
  _HTTP.Disconnect;
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 := _READ_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
  _HTTP.URL.URI := Url;
  if _HTTP.URL.Protocol = 'https' then
    if _SSL_ENABLE then
    _HTTP.IOHandler := _SSL
  else
    _HTTP.IOHandler := nil;
  _HTTP.Connect(_CONN_TIME_OUT);  
  inStream := TMemoryStream.Create;
  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;
    try
      gZipDecompress(inStream, outStream);
    except
      inStream.Position := 0;
      OutStream.CopyFrom(inStream,inStream.Size);
    end;
  finally
    inStream.Free;
    _HTTP.Disconnect; //add 2006 7.16
    _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;
  try
    if Login then
    Process;
  finally
    FreeHTTP;
  end;
end;

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



end.