httptask.pas

来自「用delphi 编写的 验证码识别程序」· PAS 代码 · 共 185 行

PAS
185
字号
unit HTTPtask;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, StdCtrls,
  IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
  AdvOcr;

type
  THTTPtask = class(TThread)
  private
  protected
    _HTTP : TIdHTTP;
    _SSL : TIdSSLIOHandlerSocket;
    _PAUSE_FLAG : boolean;
    procedure Execute; override;
    procedure InitHTTP;
    procedure DoneHTTP; virtual;
    procedure RecrHTTP;
    procedure Relay(sec : Byte);
    procedure DebugHtml;
    function Login : boolean; virtual;
    procedure Process; virtual;
  public
    _USE_PROXY : boolean;
    _PROXY_ADDR : string;
    _PROXY_PORT : Integer;
    _NEED_AUTH : boolean;
    _PROXY_USER : string;
    _PROXY_PASS : string;
    //
    _LOGIN_NAME : string;
    _LOGIN_PASS : string;
    _HTML : string;
    procedure Pause;
    procedure Goon;
    procedure Stop;
    constructor Create;
    destructor Destroy; override;
  end;

  THTTPtaskTrace = class(THTTPtask)
  private
    _LOG : string;
  protected
    procedure ShowLog(desc : string);
    procedure TraceLog;
  public
    _LOG_LST : TListBox;
  end;

implementation

uses
  HTTPutil;

{THTTPtask}

constructor THTTPtask.Create;
begin
  inherited Create(TRUE);
  FreeOnTerminate := TRUE;
  _HTTP := TIdHTTP.Create(nil);
  _SSL := TIdSSLIOHandlerSocket.Create(nil);
  _USE_PROXY := False;
end;

destructor THTTPtask.Destroy;
begin
  _SSL.Free;
  _HTTP.Free;
  inherited Destroy;
end;

procedure THTTPtask.Execute;
begin
  InitHTTP;
  if Login then Process;
  DoneHTTP;
end;

procedure THTTPtask.Pause;
begin
  _PAUSE_FLAG := TRUE;
end;

procedure THTTPtask.Goon;
begin
  _PAUSE_FLAG := FALSE;
  Self.Resume;
end;

procedure THTTPtask.Stop;
begin
  DoneHTTP;
  _SSL.Free;
  _HTTP.Free;
  TerminateThread(Self.Handle,0);
end;

procedure THTTPtask.Relay(sec : Byte);
var
  i : Integer;
begin
  for i:=1 to 10*sec do
  begin
    if _PAUSE_FLAG then break;
    Sleep(100);
  end;
end;

procedure THTTPtask.InitHTTP;
begin
  _HTTP.ProtocolVersion := pv1_1;
  _HTTP.ReadTimeout := 5000;
  _HTTP.HandleRedirects := True;
  _HTTP.AllowCookies := True;
   _HTTP.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)';
  _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.DoneHTTP;
begin

end;

procedure THTTPtask.RecrHTTP;
begin
  _HTTP.Free;
  _HTTP := TIdHTTP.Create(nil);
  InitHTTP;
end;

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

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

procedure THTTPtask.Process;
begin

end;

{THTTPtaskTrace}
procedure THTTPtaskTrace.ShowLog(desc : string);
begin
  _LOG := desc;
  Synchronize(TraceLog);
end;

procedure THTTPtaskTrace.TraceLog;
var
  LogToAdd : string;
begin
  if _LOG_LST <> nil then
  begin
    LogToAdd := DateTimeToStr(now)+' : '+_LOG;
    AddLstBPro(_LOG_LST,LogToAdd,True,LSTB_MAX_LINE);
  end;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?