threadtask.pas

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

{*******************************************************}
{                                                       }
{       高级线程                                        }
{       单元名 ThreadTask.pas                           }
{                                                       }
{       版权所有 (C) 2006-6-25 飞翔的久久酷             }
{       http://www.flying99koo.com                      } 
{       QQ:78273318 Mail: [e-mail]         }
{                                                       }
{*******************************************************}


unit ThreadTask;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, StdCtrls, ComCtrls;

type
  TThreadTask = class(TThread)        //基础线程任务类
  private
    _PAUSE_FLAG : boolean;
    procedure NotifyPool;          //线程池通知方法
  protected
    _SUCCCESS : Boolean;
    procedure PauseHere;           //由子类使用，设置暂停点
    procedure Relay(sec : Byte);   //延时方法
    procedure Execute; override;
    procedure InitJob; virtual;    //用于创建所需要的类以及类的初始化
    procedure DoneJob; virtual;    //用于销毁创建的类
    procedure DoJob; virtual;abstract;
  public
    _THREAD_LIST : TThreadList;    //线程列表，用于线程池
    _TASK_INDEX : Integer;         //任务索引，用于线程池
    _THREAD_INDEX : Integer;       //线程索引，用于线程池
    procedure Pause;               //暂停
    procedure Goon;                //继续
    procedure Stop; virtual;       //停止
    constructor Create;
  end;

  TTraceLogNotifyEvent = procedure(Log : string; Sender: TObject) of object;

  TLvTraceLogNotifyEvent = procedure(Log : string; Row : Integer; Column : Byte; ImgIdx : SmallInt; Sender: TObject) of object;

  TAdvThreadTask = class(TThreadTask)                //具有TRACE功能的线程任务
  private
    _LOG : string;
    _ROW : Integer;
    _COLUMN : Byte;
    _IMGIDX : SmallInt;
    procedure SynTraceLog;
    procedure SynLvTraceLog;
  protected
    procedure TraceLog(Log : string);     //listbox方式 Trace 方法
    procedure LvTraceLog(Log : string; Row : Integer; Column : Byte; ImgIdx : SmallInt); //listview 方式 Trace 方法
  public
    _OnTraceLog : TTraceLogNotifyEvent;
    _OnLvTraceLog : TLvTraceLogNotifyEvent;
  end;

  TNetWorkThreadTask = class(TAdvThreadTask)        //网络协议线程任务
  protected
    procedure CreateProtocal;virtual;abstract;      //创建网络协议类
    procedure FreeProtocal;virtual;abstract;        //销毁网络协议类
    procedure InitProtocal;virtual;abstract;        //初始化网络协议
    procedure ReCreateProtocal;                     //重创网络协议并初始化
    procedure DoJob; override;
    procedure DoNetWorkJob;virtual;abstract;
  public
    procedure Stop; override;
  end;

  TProgressNotifyEvent = procedure(Min, Max, Progress : Integer; Sender: TObject) of object;

  TLoopNetWorkThreadTask = class(TNetWorkThreadTask)     //循环型网络协议线程任务
  protected
    _LOOP_INDEX : Integer;                               //循环索引
    _JUMP_FLAG : Boolean;                                //跳出循环标志
    procedure DoNetWorkJob; override;                    
    procedure DoLoopNetWorkJob; virtual;abstract;        //实际任务实体 由子类覆盖
  public
    _RELAY : Integer;
    _LOOP_COUNT : Integer;
    _OnProgress : TProgressNotifyEvent;
    constructor Create;
  end;

implementation

uses
  ThreadPool, HTTPutil;

{TThreadTask}
constructor TThreadTask.Create;
begin
  inherited Create(TRUE);
  FreeOnTerminate := TRUE;
  _THREAD_LIST := nil;
  _TASK_INDEX := -1;
  _THREAD_INDEX := -1;
  _SUCCCESS := False;
end;

procedure TThreadTask.Execute;
begin
  try
    InitJob;
    try
      Dojob;
    except
      //Handle Exception --> to be done in future
    end;
    DoneJob;
  finally
    NotifyPool;
  end;
end;

procedure TThreadTask.DoneJob;
begin
end;

procedure TThreadTask.InitJob;
begin
end;


procedure TThreadTask.NotifyPool;
var
  i : Integer;
  P : PThreadObj;
begin
  if _THREAD_LIST <> nil then
  with _THREAD_LIST.LockList do
  try
    for i:=0 to Count-1 do
    begin
      P := PThreadObj(Items[i]);
      if P^.Handle = Self.Handle then
      begin
        P^.Active := False;
        P^.Success := _SUCCCESS;
        Break;
      end;
    end;
  finally
    _THREAD_LIST.UnlockList;
  end;
end;

procedure TThreadTask.PauseHere;
begin
  if _PAUSE_FLAG then Self.Suspend;
end;

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

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

procedure TThreadTask.Stop;
//var
//  ExitCode : Cardinal;
begin
//  Self.Terminate;
//  DoneJob;
//  GetExitCodeThread(Self.Handle,ExitCode);
//  TerminateThread(Self.Handle,ExitCode);
//  _STOP_FLAG := True;
end;

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


{TAdvThreadTask}
procedure TAdvThreadTask.TraceLog(Log : string);
begin
  _LOG := Log;
  Synchronize(SynTraceLog);
end;

procedure TAdvThreadTask.SynTraceLog;
begin
  if Assigned(_OnTraceLog) then
  _OnTraceLog(_LOG,Self);
end;

procedure TAdvThreadTask.LvTraceLog(Log : string; Row : Integer; Column : Byte; ImgIdx : SmallInt);
begin
  _LOG := Log;
  _ROW := Row;
  _COLUMN := Column;
  _IMGIDX := ImgIdx;
  Synchronize(SynLvTraceLog);
end;

procedure TAdvThreadTask.SynLvTraceLog;
begin
  if Assigned(_OnLvTraceLog) then
  _OnLvTraceLog(_LOG,_ROW,_COLUMN,_IMGIDX,Self);
end;

{TNetWorkThreadTask}
procedure TNetWorkThreadTask.ReCreateProtocal;
begin
  FreeProtocal;
  CreateProtocal;
  InitProtocal;
end;

procedure TNetWorkThreadTask.DoJob;
begin
  CreateProtocal;
  InitProtocal;
  DoNetWorkJob;
  FreeProtocal;
end;

procedure TNetWorkThreadTask.Stop;
begin
  FreeProtocal;
  inherited;
end;

{TLoopNetWorkThreadTask}
constructor TLoopNetWorkThreadTask.Create;
begin
  inherited;
  _LOOP_COUNT := 1;
  _LOOP_INDEX := 1;
  _JUMP_FLAG := False;
end;

procedure TLoopNetWorkThreadTask.DoNetWorkJob;
var
  i : Integer;
begin
  for i:=1 to _LOOP_COUNT do
  begin
    _LOOP_INDEX := i;
    DoLoopNetWorkJob;
    if Assigned(_OnProgress) then
    _OnProgress(0,_LOOP_COUNT,_LOOP_INDEX,Self);
    if _JUMP_FLAG then
    Break;
    if i<>_LOOP_COUNT then
    Relay(_RELAY);
    PauseHere;
  end;
end;


end.