uthreadeddatamodule.pas

多线程调用的范例

unit uThreadedDataModule;

interface

uses
  SysUtils, Classes, uThreadedInterfaces, Forms;

type
  TdmThreadedDataModule = class;
  TdmThreadedDataModuleClass = class of TdmThreadedDataModule;

  // Manages a list of threaded datamodules
  TModuleList = class(TObject)
  private
    FModuleList: TList;
    function GetCount: integer;
    function GetModule(index: integer): IThreadedDataModule;

  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Module: IThreadedDataModule);
    procedure Remove(Module: IThreadedDataModule);
    property Count: integer read GetCount;
    property Module[index: integer]: IThreadedDataModule read GetModule;
    
  end;

  TModuleThread = class(TThread)
  private
    FDataModule: TdmThreadedDataModule;
  public
    constructor Create(ADataModule: TdmThreadedDatamodule);
    procedure Execute; override;
  end;

  TdmThreadedDataModule = class(TDataModule, IThreadedDataModule)
  private
    { Private declarations }
    FCallback: IThreadedCallback;
    FParams: TStringList;
    FThread: TModuleThread;
    FList: TModuleList;
    function GetTerminated: boolean;

  private
    // Utility functions passed to the thread for display..
    FMax, FMin, FProgress: integer;
    FStatusMessage: string;
    procedure DoGetMax;
    procedure DoGetMin;
    procedure DoGetProgress;
    procedure DoSetMax;
    procedure DoSetMin;
    procedure DoSetProgress;
    procedure DoGetStatusMessage;
    procedure DoSetStatusMessage;

  protected
    // IInterface
    FReferenceCount: integer;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    // IThreadedDataModule
    function GetCallback: IThreadedCallback;
    procedure SetCallback(AValue: IThreadedCallback);
    property Callback: IThreadedCallback read GetCallback write SetCallback;
    function GetParamByName(AParam: string): string;
    procedure SetParamByName(AParam, AValue: string);
    property ParamByName[AParam: string]: string read GetParamByName write SetParamByName;
    procedure Execute;
    procedure Pause;
    procedure Resume;
    procedure Terminate;

  protected
    // Utility Functions used by the developer in the ModuleExecute method.
    function GetMax: integer;
    function GetMin: integer;
    function GetProgress: integer;
    procedure SetMax(const Value: integer);
    procedure SetMin(const Value: integer);
    procedure SetProgress(const Value: integer);
    property Min: integer read GetMin write SetMin;
    property Max: integer read GetMax write SetMax;
    property Progress: integer read GetProgress write SetProgress;
    function GetStatusMessage: string;
    procedure SetStatusMessage(const Value: string);
    property StatusMessage: string read GetStatusMessage write SetStatusMessage;
    procedure ModuleFinished;
    property Terminated: boolean read GetTerminated;

  protected
    class function ModuleName: string; virtual;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ModuleExecute; virtual;

  end;

var
  dmThreadedDataModule: TdmThreadedDataModule;
  DataModules: TStringList;

procedure RegisterDataModule(ADataModule: TdmThreadedDataModuleClass);
function DataModuleCount: integer;
function DataModule(index: integer): IThreadedDataModule;
function DataModuleName(index: integer): string;


implementation

{$R *.dfm}

procedure RegisterDataModule(ADataModule: TdmThreadedDataModuleClass);
begin
  if ADataModule <> nil then
    DataModules.AddObject(ADataModule.ModuleName, TObject(ADataModule));
end;

function DataModuleCount: integer;
begin
  Result:=DataModules.Count;
end;

function DataModule(index: integer): IThreadedDataModule;
begin
  Result:=nil;
  if index >= DataModules.Count then Exit;
  Result:=TdmThreadedDataModuleClass(DataModules.Objects[index]).Create(nil);
end;

function DataModuleName(index: integer): string;
begin
  Result:='';
  if index >= DataModules.Count then Exit;
  Result:=DataModules[index];
end;

{ TdmThreadedDataModule }


constructor TdmThreadedDataModule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParams:=TStringLIst.Create;

end;

destructor TdmThreadedDataModule.Destroy;
begin
  FCallBack:=nil;
  FParams.Destroy;
  if FList <> nil then FList.Remove(Self);
  inherited Destroy;
end;

procedure TdmThreadedDataModule.DoGetMax;
begin
  if FCallBack = nil then Exit;
  FMax:=FCallBack.Max;
end;

procedure TdmThreadedDataModule.DoGetMin;
begin
  if FCallBack = nil then Exit;
  FMin:=FCallBack.Min;
end;

procedure TdmThreadedDataModule.DoGetProgress;
begin
  if FCallBack = nil then Exit;
  FProgress:=FCallBack.Progress;
end;

procedure TdmThreadedDataModule.DoGetStatusMessage;
begin
  if FCallback = nil then Exit;
  FStatusMessage:=FCallback.StatusMessage;
end;

procedure TdmThreadedDataModule.DoSetMax;
begin
  if FCallBack = nil then Exit;
  FCallBack.Max:=FMax;
end;

procedure TdmThreadedDataModule.DoSetMin;
begin
  if FCallBack = nil then Exit;
  FCallBack.Min:=FMin;
end;

procedure TdmThreadedDataModule.DoSetProgress;
begin
  if FCallBack = nil then Exit;
  FCallBack.Progress:=FProgress;
end;

procedure TdmThreadedDataModule.DoSetStatusMessage;
begin
  if FCallback = nil then Exit;
  FCallBack.StatusMessage:=FStatusMessage;
end;

procedure TdmThreadedDataModule.Execute;
begin
  TModuleThread.Create(Self);
end;

function TdmThreadedDataModule.GetCallback: IThreadedCallback;
begin
  Result:=FCallback;
end;

function TdmThreadedDataModule.GetMax: integer;
begin
  Result:=-1;
  if FThread = nil then Exit;
  DoGetMax;
  Result:=FMax;
end;

function TdmThreadedDataModule.GetMin: integer;
begin
  Result:=-1;
  if FThread = nil then Exit;
  DoGetMin;
  Result:=FMin;
end;

function TdmThreadedDataModule.GetParamByName(AParam: string): string;
begin
  Result:=FParams.Values[AParam];
end;

function TdmThreadedDataModule.GetProgress: integer;
begin
  Result:=-1;
  if FThread = nil then Exit;
  DoGetProgress;
  Result:=FProgress;
end;

function TdmThreadedDataModule.GetStatusMessage: string;
begin
  Result:='';
  if FThread = nil then Exit;
//  DoGetStatusMessage;
//  Result:=FStatusMessage;
end;

function TdmThreadedDataModule.GetTerminated: boolean;
begin
  Result:=False;
  if FThread = nil then Exit;
  REsult:=FTHread.Terminated;
end;

procedure TdmThreadedDataModule.ModuleExecute;
begin
  // Base class does nothing.
end;

procedure TdmThreadedDataModule.ModuleFinished;
begin
  if FCallBack <> nil then
    FCallBack.ModuleFinished;
end;

class function TdmThreadedDataModule.ModuleName: string;
begin
  // Children override to provide their name
  Result:='BASE DATAMODULE CLASS';
end;

procedure TdmThreadedDataModule.Pause;
begin
  // Pauses the thread.
  if FThread = nil then Exit;
  FThread.Suspend;
end;

procedure TdmThreadedDataModule.Resume;
begin
  // Resumes the thread.
  if FThread = nil then Exit;
  FThread.Resume;
end;

procedure TdmThreadedDataModule.SetCallback(AValue: IThreadedCallback);
begin
  FCallback:=AValue;
end;

procedure TdmThreadedDataModule.SetMax(const Value: integer);
begin
  if FThread = nil then Exit;
  FMax:=Value;
  DoSetMax;
end;

procedure TdmThreadedDataModule.SetMin(const Value: integer);
begin
  if FThread = nil then Exit;
  FMin:=Value;
  DoSetMin;
end;

procedure TdmThreadedDataModule.SetParamByName(AParam, AValue: string);
begin
  FParams.Values[AParam]:=AValue;
end;

procedure TdmThreadedDataModule.SetProgress(const Value: integer);
begin
  if FThread = nil then Exit;
  FProgress:=Value;
  DoSetProgress;
end;

procedure TdmThreadedDataModule.SetStatusMessage(const Value: string);
begin
  if FThread = nil then Exit;
  FStatusMessage:=Value;
  DoSetStatusMessage;
end;

procedure TdmThreadedDataModule.Terminate;
begin
  // Terminates the thread.
  if FThread = nil then Exit;
  FThread.Terminate;
end;

function TdmThreadedDataModule._AddRef: Integer;
begin
  Result:=-1;
//  Inc(FReferenceCount);
//  Result:=FReferenceCount;
end;

function TdmThreadedDataModule._Release: Integer;
begin
  Result:=-1;
//  Dec(FReferenceCount);
//  Result:=FReferenceCount;
//  if FReferenceCount = 0 then
//    Destroy;
end;

{ TModuleThread }

constructor TModuleThread.Create(ADataModule: TdmTHreadedDatamodule);
begin
  FreeOnTerminate:=True;
  FDataModule:=ADataModule;
  FDataModule.FThread:=Self;
  inherited Create(False);
end;

procedure TModuleThread.Execute;
begin
  try
    FDataModule.ModuleExecute;
  finally
    FDataModule.Destroy;
  end;
end;

{ TModuleList }

procedure TModuleList.Add(Module: IThreadedDataModule);
begin
  FModuleList.Add(TObject(Module));
  TdmThreadedDataModule(Module).FList:=Self;
end;

constructor TModuleList.Create;
begin
  FModuleList:=TList.Create;
end;

destructor TModuleList.Destroy;
begin
  // Assuming all modules are destroyed at this point.
  FModuleList.Destroy;
  inherited Destroy;
end;

function TModuleList.GetCount: integer;
begin
  Result:=FModuleList.Count;
end;

function TModuleList.GetModule(index: integer): IThreadedDataModule;
begin
  Result:=IThreadedDataModule(FModuleList[index]);
end;

procedure TModuleList.Remove(Module: IThreadedDataModule);
begin
  FModuleList.Remove(TObject(Module));
  TdmThreadedDataModule(Module).FList:=nil;
end;

initialization
  DataModules:=TStringList.Create;

finalization
  DataModules.Destroy;
  
end.