Solved

Boss Thread and worker threads communication

Posted on 2009-07-07
22
1,484 Views
Last Modified: 2013-11-23
Question: Hi. In my main application (main VCL) I want to develop a single boss
thread which:

A: is able to communicate with worker threads
B: is able to update some VCL componets properties into main VCL basing
on the worker thread results.
C: create the worker thread and limit the number of it using a semaphore

Worker threads are I/O operation. They do some test, create a sort of
array of boolean based on the test performed and store into a shared
buffer (es. TthreadList).

The approach I would like to use is the one of producer/consumer.

So the sequence should be:

- The boss spaws some worker threads
- The workers threads do some test and create a result as [TRUE,FALSE,FALSE...]
  with a size that is dynamic.

- the worker thread store it into a shared buffer, protected with Critical Section.

- The boss thread wakes up or wait to access to the buffer. When it does it
will update the propreties in the main VCL


I want to develop this structure without using Syncronize and above all

limiting the buffer size and taking care of flow control between boss an
workers.
0
Comment
Question by:jaja2005
  • 12
  • 8
  • 2
22 Comments
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24800111
m2c

a thread shouldn't update anything in the VCL if not using synchronize or lock
instead you should let the form update itself (not in a thread)
rather give the form the information it needs in a object instance and send it a message the data changed
0
 
LVL 11

Expert Comment

by:dougaug
ID: 24808528
Hi, jaja2005,

I've made a little project for you (but I haven't finished the tests yet). See if it is something like this that you want.

To compile it, create the files which name are surrounding by '*******'.

Regards,

Douglas.
************************

 TestThread.dpr

***********************

program ThreadTest;
 

uses

  Forms,

  Mainform in 'Mainform.pas' {FMainform},

  BossWorkerThreads in 'BossWorkerThreads.pas';
 

{$R *.res}
 

begin

  Application.Initialize;

  Application.CreateForm(TFMainform, FMainform);

  Application.Run;

end.
 
 

********************************

 Mainform.dfm

********************************
 

object FMainform: TFMainform

  Left = 192

  Top = 103

  Width = 696

  Height = 480

  Caption = 'Thread Test'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnClose = FormClose

  PixelsPerInch = 96

  TextHeight = 13

  object Button1: TButton

    Left = 32

    Top = 24

    Width = 113

    Height = 25

    Caption = 'Create Boss Thread'

    TabOrder = 0

    OnClick = Button1Click

  end

  object Memo1: TMemo

    Left = 24

    Top = 64

    Width = 257

    Height = 321

    TabOrder = 1

  end

  object Button2: TButton

    Left = 328

    Top = 24

    Width = 169

    Height = 25

    Caption = 'Resume Boss Thread'

    TabOrder = 2

    OnClick = Button2Click

  end

  object Button3: TButton

    Left = 168

    Top = 24

    Width = 153

    Height = 25

    Caption = 'Suspend Boss Thread'

    TabOrder = 3

    OnClick = Button3Click

  end

end
 

********************************

 Mainform.pas

********************************

unit Mainform;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;
 

type

  TFMainform = class(TForm)

    Button1: TButton;

    Memo1: TMemo;

    Button2: TButton;

    Button3: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Button3Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;
 

var

  FMainform: TFMainform;
 

implementation
 

{$R *.dfm}
 

uses BossWorkerThreads;
 

var

  b: TBossThread;

procedure TFMainform.Button1Click(Sender: TObject);

begin

  b := TBossThread.Create(3, Self);

end;
 

procedure TFMainform.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if b <> nil then

    b.Terminate;

end;
 

procedure TFMainform.Button3Click(Sender: TObject);

begin

  if b <> nil then

    b.Suspend;

end;
 

procedure TFMainform.Button2Click(Sender: TObject);

begin

  if b <> nil then

    b.Resume;

end;
 

end.
 

****************************

BossWorkerThreads.pas

****************************

unit BossWorkerThreads;
 

interface
 

uses

  SysUtils, Classes, SyncObjs, Windows, Mainform, Dialogs;
 

type

  TWorkerThread = class;
 

  TWorkerThreadResult = record

    WorkerThread: TWorkerThread;

    WorkerThreadID: Cardinal;

    Result: Boolean;

  end;
 

  PWorkerThreadResult = ^TWorkerThreadResult;
 

  TBossThread = class(TThread)

  private

    FFMainform: TFMainform;

    FSemaphore: Integer;

    FEvent: TEvent;

    FWorkerResults: TThreadList;

    FWorkerThreadList: TList;

    { Private declarations }

  protected

    procedure Execute; override;

    function SpawnThread: Boolean;

  public

    constructor Create(Semaphore: Integer; FMainform: TFMainform);

    destructor Destroy; override;

    procedure AddWorkerThreadResult(WorkerThreadResult: TWorkerThreadResult);

    property Event: TEvent read FEvent;

  end;
 

  TWorkerThread = class(TThread)

  private

    FBossThread: TBossThread;

    { Private declarations }

    function DoTest(TestFlag: Boolean): Boolean;

  protected

    procedure Execute; override;

  public

    constructor Create(BossThread: TBossThread);

  end;
 

implementation
 

{ TBossThread }
 

procedure TBossThread.AddWorkerThreadResult(WorkerThreadResult: TWorkerThreadResult);

begin

  with FWorkerResults do

  begin

    with LockList do

    try

       Add(@WorkerThreadResult);

       FEvent.SetEvent;

    finally

       UnlockList;

    end;

  end;

end;
 

constructor TBossThread.Create(Semaphore: Integer; FMainform: TFMainform);

begin

  inherited Create(True);

  FWorkerResults := TThreadList.Create;

  FWorkerThreadList := TList.Create;

  FEvent := TEvent.Create(nil, False, False, '');

  FSemaphore := Semaphore;

  FFMainform := FMainform;

  FreeOnTerminate := True;

  Resume;

end;
 

destructor TBossThread.Destroy;

var

  i: Integer;

begin

  for i := 0 to FWorkerThreadList.Count - 1 do

    TWorkerThread(FWorkerThreadList[i]).Terminate;
 

  FWorkerResults.Free;

  FEvent.Free;

  inherited;

end;
 

procedure TBossThread.Execute;

var

  List: TList;

  WorkerThreadResult: PWorkerThreadResult;

  FAvailableThreads: Boolean;

begin

  while not Terminated do

  begin

    repeat

      FAvailableThreads := SpawnThread

    until not FAvailableThreads;
 

    List := FWorkerResults.LockList;
 

    try

      if List.Count > 0 then

      begin

        WorkerThreadResult := List.Items[0];

        FFMainform.Memo1.Lines.Add('ThreadID = ' + IntToStr(WorkerThreadResult^.WorkerThreadID) + ', ' +

                                   'Result = ' + IntToStr(Integer(WorkerThreadResult^.Result)));

        FWorkerResults.Remove(WorkerThreadResult);

      end

    finally

      FWorkerResults.UnlockList;
 

      if List.Count = 0 then

      begin

        FEvent.ResetEvent;

        FEvent.WaitFor(INFINITE);

      end;

    end;

  end;

end;
 

function TBossThread.SpawnThread: Boolean;

begin

  Result := False;
 

  if FSemaphore > 0 then

  begin

    FWorkerThreadList.Add(TWorkerThread.Create(Self));

    Dec(FSemaphore);

    Result := True;

  end;

end;
 

{ TWorkerThread }
 

constructor TWorkerThread.Create(BossThread: TBossThread);

begin

  inherited Create(True);

  FBossThread := BossThread;

  FreeOnTerminate := True;

  Resume;

end;
 

function TWorkerThread.DoTest(TestFlag: Boolean): Boolean;

begin

  Result := not TestFlag;

end;
 

procedure TWorkerThread.Execute;

var

  WorkerThreadResult: TWorkerThreadResult;

  TestFlag: Boolean;

begin

  TestFlag := False;
 

  with WorkerThreadResult do

  begin

    WorkerThread := Self;

    WorkerThreadID := ThreadID;

  end;
 

  while not Terminated do

  begin

    TestFlag := DoTest(TestFlag);

    WorkerThreadResult.Result := TestFlag;

    FBossThread.AddWorkerThreadResult(WorkerThreadResult);

  end;

end;
 

end.

Open in new window

0
 

Author Comment

by:jaja2005
ID: 24810964
Good day dougaug!
Great, many thanks.  I am going to study and test it and let you know my doubts.
See ya
0
 

Author Comment

by:jaja2005
ID: 24811024
Just one thing i have noticed. You use TestFlag: Boolean a single variable while i want to work with an array or list of bolean. Let me explain you my goal. At beginning the BossThread copies a sort of  
array or list of control to be performed (maybe via worker constructor) kind of:
 
A (String) - B (char or string) - C (String or Integer)  
An example:
Check if  ValueofTemperature is > of 30
 
ValueofTemperature is 'A'
'>' is B
30 is 'C'
 
So each worker thread will get its tasks to be completed from the BossThread. One workerthread may receive 10 controls to verify other less or maybe more. So the workerthread would create a sort
of array or TList of Bolean of results internally. Once the thread is done itwill inform the boss thread(maybe with postmessage) and copies the TList in a shared buffer (maybe before the thread destroy itself (OnTerminate=True)).  Now the Bossthread may picks up an item from the buffer ( where a single item is a array of TList of boolean seen before) and upadate a TListBox or whatever in my VCL main thread.

Hope it helps.
Thx

 
0
 
LVL 11

Expert Comment

by:dougaug
ID: 24817487
Ok I have understood. I will try to do something like you said and post the code here.

Regards
0
 

Author Comment

by:jaja2005
ID: 24817773
Great, in meanwhile i will study the previous example
Thanks a lot for your help!
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24821034
dougaug, jaja2005
let me point out some things:
first of all,
you have circular unit reference :(  
this should by avoided between the mainform and the bossthread

second, you are updating the VCL from within a other thread !
this will hang up your app !!!

it's a nice start, but unforatunately will provide some problems
i'll rebuild it for you so you can use the bossthread from any form !
and show you how to do a callback to a higher object

check this article on to use a callback:
http://www.experts-exchange.com/articles/Programming/Languages/Pascal/Delphi/Displaying-progress-in-the-main-form-from-a-thread-in-Delphi.html
it works for any form
this works with a synchronised callback, but we can change this too
i will use a object to return info

let me work on this a little ...
0
 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 24822199
i got something like this:

unit frmMain;
 

interface
 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls;
 

type

  TformMain = class(TForm)

    memInfo: TMemo;

    lbxThreads: TListBox;

    pnlOptions: TPanel;

    btnPauseResume: TButton;

    btnStart: TButton;

    btnStop: TButton;

    btnAddWorker: TButton;

    procedure btnAddWorkerClick(Sender: TObject);

    procedure btnStartClick(Sender: TObject);

  private

    fNumber: Integer;

    procedure ReturningInfo(Sender: TObject; Msg: TStrings);

  public

    constructor Create(AOwner: TComponent); override;

  end;
 

var

  formMain: TformMain;
 

implementation
 

uses threadBoss;
 

{$R *.dfm}
 

type

  TCountingThread = class(TWorkerThread)

  protected

    procedure DoAction; override;

  end;
 

procedure TformMain.btnAddWorkerClick(Sender: TObject);

var x: TTask;

begin

  x := TTask.Create;

  x.WorkerThreadClass := TCountingThread;

  x.Name := 'Worker' + IntToStr(fNumber);

  lbxThreads.Items.Values[x.Name] := ';

  AddTask(x);

  Inc(fNumber);

end;
 

{ TCountingThread }
 

procedure TCountingThread.DoAction;

var I, n: Integer;
 

begin

  I := 0;

  n := Random(10) + 3;

  repeat

    Sleep(1000);

    SignalStatus(IntToStr(I));

    Inc(I);

  until I >= n;

end;
 

procedure TformMain.ReturningInfo(Sender: TObject; Msg: TStrings);

var I: Integer;

begin

  memInfo.Lines := Msg;

  with lbxThreads.Items do

    for I := 0 to Count - 1 do

      Values[Names[I]] := Msg.Values[Names[I]+'_STATUS'];

end;
 

procedure TformMain.btnStartClick(Sender: TObject);

begin

  StartBoss(ReturningInfo);

  btnAddWorker.Enabled := True;

end;
 

constructor TformMain.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  fNumber := 1;

end;
 

end.

Open in new window

0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 500 total points
ID: 24822221
and the threadboss unit:

(note that the frmMain is not in the uses Clauses of the threadboss)
it's not completed, but it should give you an idea of which way to go

unit threadBoss;
 

interface
 

uses Classes, SysUtils, SyncObjs;
 

{$WRITEABLECONST ON}
 

const

  AutoStartBossThread: Boolean = True;
 

type

  TWorkerThread = class;

  TTask = class;
 

  TTaskStatus = (tsNotStarted, tsInit, tsRunning, tsFinished, tsError);
 

  TSignalToBossEvent = procedure (Sender: TObject; TaskName: string; WorkerMsg: TStrings) of object;
 

  TTaskItem = class(TCollectionItem)

  private

    fTask: TTask;

    fStatus: TTaskStatus;

    fThread: TWorkerThread;

    fSignalToBoss: TSignalToBossEvent;

  protected

    procedure ThreadSignal(Sender: TObject; Msg: TStrings);

  public

    constructor Create(Collection: TCollection); override;

    destructor Destroy; override;

  end;
 

  TTaskItems = class(TCollection)

  private

    function GetItems(Index: Integer): TTaskItem;

  protected

  public

    constructor Create;

    function Add: TTaskItem;

    property Items[Index: Integer]: TTaskItem read GetItems;

  end;
 
 

  TSignalBossEvent = procedure (Sender: TObject; Msg: TStrings) of object;

  TBossThread = class(TThread)

  private

    fMaxWorkers: Integer;

    fWorkers: TThreadList;

    fEvent: TEvent;

    fSignalMsgEvent: TSignalBossEvent;

    fMsg: TStrings;

    procedure CheckNewTasks;

    procedure StartTask(aTaskItem: TTaskItem);

  protected

    procedure DoSignal; virtual;

    procedure Signal; virtual;

    procedure OnThreadMsg(Sender: TObject; TaskName: string; WorkerMsg: TStrings);

    procedure Execute; override;

    procedure ThreadTerminated(Sender: TObject);

  public

    constructor Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalBossEvent = nil; aMaxWorkers: integer = 5);

    destructor Destroy; override;

    class procedure Warning;

  end;
 

  TSignalWorkerEvent = procedure (Sender: TObject; Msg: TStrings) of object;

  TWorkerThread = class(TThread)

  private

    fMsgInfo: TStrings;

    fSignalMsgEvent: TSignalWorkerEvent;

    fUseSynchronize: Boolean;

  protected

    procedure CreateMsgInfo; virtual;

    procedure Execute; override;

    procedure DoSignal; virtual;

    procedure Signal; virtual;

    procedure SignalBegin; virtual;

    procedure SignalEnd; virtual;

    procedure SignalError(aMsg: string); virtual;

    procedure SignalStatus(aMsg: string); virtual;

  public

    constructor Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalWorkerEvent = nil; aUseSynchronize: boolean = True); reintroduce;

    destructor Destroy; override;

    procedure DoAction; virtual;

  end;
 

  TWorkerThreadClass = class of TWorkerThread;
 

  TTask = class(TObject)

  private

    fWorkerThreadClass: TWorkerThreadClass;

    fName: string;

  protected

  public

    property Name: string read fName write fName;

    property WorkerThreadClass: TWorkerThreadClass read fWorkerThreadClass write fWorkerThreadClass;

  end;
 

procedure AddTask(aTask: TTask);

procedure StartBoss(ReturnInfoEvent: TSignalBossEvent = nil);
 

implementation
 

var

  mTasks: TTaskItems;

  mTaskCs: TCriticalSection;

  mBoss: TBossThread;
 

procedure StartBoss(ReturnInfoEvent: TSignalBossEvent = nil);

begin

  if not Assigned(mBoss) then

    mBoss := TBossThread.Create(False, ReturnInfoEvent);

end;
 

procedure InitTasks;

begin

  mTasks := TTaskItems.Create;

  mTaskCs := TCriticalSection.Create;

end;
 

procedure DoneTasks;

begin

  FreeAndNil(mTaskCs);

  FreeAndNil(mTasks);

end;
 

procedure AddTask(aTask: TTask);

begin

  if Assigned(aTask) then

  begin

    mTaskCs.Enter;

    try

      with mTasks.Add do

        fTask := aTask;

      TBossThread.Warning;

    finally

      mTaskCs.Leave;

    end;

  end;

end;
 

{ TTaskItem }
 

constructor TTaskItem.Create(Collection: TCollection);

begin

  inherited Create(Collection);

  fTask := Nil;

  fStatus := tsNotStarted;

end;
 

destructor TTaskItem.Destroy;

begin

  FreeAndNil(fTask);

  inherited Destroy;

end;
 

procedure TTaskItem.ThreadSignal(Sender: TObject; Msg: TStrings);

var msgStatus: string;

begin

  msgStatus := Msg.Values['STATUS'];

  if msgStatus = 'BEGIN' then

    fStatus := tsInit

  else if msgStatus = 'STATUS' then

    fStatus := tsRunning

  else if msgStatus = 'END' then

    fStatus := tsFinished

  else if msgStatus = 'ERROR' then

    fStatus := tsError;

  if Assigned(fSignalToBoss) then

    fSignalToBoss(Sender, fTask.Name, Msg);

end;
 

{ TTaskItems }
 

function TTaskItems.Add: TTaskItem;

begin

  Result := TTaskItem(inherited Add);

end;
 

constructor TTaskItems.Create;

begin

  inherited Create(TTaskItem);

end;
 

function TTaskItems.GetItems(Index: Integer): TTaskItem;

begin

  Result := TTaskItem(inherited Items[Index]);

end;
 

{ TBossThread }
 

constructor TBossThread.Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalBossEvent = nil; aMaxWorkers: integer = 5);

begin

  inherited Create(CreateSuspended);

  fMaxWorkers := aMaxWorkers;

  fWorkers := TThreadList.Create;

  fEvent := TEvent.Create(nil, False, False, 'thread_boss');

  fSignalMsgEvent := aSignalMsgEvent;

  fMsg := TStringList.Create;

end;
 

destructor TBossThread.Destroy;

begin

  FreeAndNil(fMsg);

  FreeAndNil(fEvent);

  FreeAndNil(fWorkers);

  inherited Destroy;

end;
 

procedure TBossThread.DoSignal;

begin

  Synchronize(Signal);

end;
 

procedure TBossThread.Signal;

begin

  if Assigned(fSignalMsgEvent) then

    fSignalMsgEvent(Self, fMsg);

end;
 

procedure TBossThread.StartTask(aTaskItem: TTaskItem);

begin

  with fWorkers.LockList do

  try

    if Count < fMaxWorkers then

    begin

      with aTaskItem do

      begin

        fSignalToBoss := OnThreadMsg;

        fStatus := tsInit;

        fThread := fTask.fWorkerThreadClass.Create(True, aTaskItem.ThreadSignal);

        fThread.FreeOnTerminate := True;

        fThread.OnTerminate := ThreadTerminated;

        Add(fThread);

        fThread.Resume;

      end;

    end;

  finally

    fWorkers.UnlockList;

  end;

end;
 

procedure TBossThread.ThreadTerminated(Sender: TObject);

begin

  with fWorkers.LockList do

  try

    Delete(IndexOf(Sender));

  finally

    fWorkers.UnlockList;

  end;

end;
 

procedure TBossThread.CheckNewTasks;

var I: Integer;

begin

  mTaskCs.Enter;

  try

    for I := 0 to mTasks.Count - 1 do

      if mTasks.Items[I].fStatus in [tsNotStarted] then

      begin

        StartTask(mTasks.Items[I]);

        Break;

      end;

  finally

    mTaskCs.Leave;

  end;

end;
 

procedure TBossThread.Execute;

begin

  while not Terminated do

  begin

    case fEvent.WaitFor(200) of

      wrSignaled    : ;

      wrTimeout     : CheckNewTasks;

      wrAbandoned   : ;

      wrError       : ;

      wrIOCompletion: ;

    end;

  end;

end;
 

procedure TBossThread.OnThreadMsg(Sender: TObject; TaskName: string; WorkerMsg: TStrings);

var I: Integer;

begin

  for I := 0 to WorkerMsg.Count - 1 do

    fMsg.Values[TaskName + '_' + WorkerMsg.Names[I]] := WorkerMsg.ValueFromIndex[I];

  DoSignal;

end;
 

class procedure TBossThread.Warning;

begin

  if not Assigned(mBoss) and AutoStartBossThread then

    StartBoss;

  if Assigned(mBoss) then

    mBoss.fEvent.SetEvent;

end;
 

{ TWorkerThread }
 

constructor TWorkerThread.Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalWorkerEvent = nil; aUseSynchronize: boolean = True);

begin

  inherited Create(CreateSuspended);

  CreateMsgInfo;

  fSignalMsgEvent := aSignalMsgEvent;

  fUseSynchronize := aUseSynchronize;

end;
 

procedure TWorkerThread.CreateMsgInfo;

begin

  fMsgInfo := TStringList.Create;

end;
 

destructor TWorkerThread.Destroy;

begin

  FreeAndNil(fMsgInfo);

  inherited Destroy;

end;
 

procedure TWorkerThread.DoAction;

begin

  // override this method in descendant

end;
 

procedure TWorkerThread.Execute;

begin

  SignalBegin;

  try

    try

      DoAction;

    except

      on E: Exception do

        SignalError(E.Message);

    end;

  finally

    SignalEnd;

  end;

end;
 

procedure TWorkerThread.Signal;

begin

  if Assigned(fSignalMsgEvent) then

    fSignalMsgEvent(Self, fMsgInfo);

end;
 

procedure TWorkerThread.DoSignal;

begin

  if fUseSynchronize then

    Synchronize(Signal)

  else

    Signal;

end;
 

procedure TWorkerThread.SignalBegin;

begin

  fMsgInfo.Values['STATUS'] := 'BEGIN';

  DoSignal;

end;
 

procedure TWorkerThread.SignalEnd;

begin

  fMsgInfo.Values['STATUS'] := 'END';

  DoSignal;

end;
 

procedure TWorkerThread.SignalError(aMsg: string);

begin

  fMsgInfo.Values['STATUS'] := 'ERROR';

  fMsgInfo.Values['ERRORMSG'] := aMsg;

  DoSignal;

end;
 

procedure TWorkerThread.SignalStatus(aMsg: string);

begin

  fMsgInfo.Values['STATUS'] := 'STATUS';

  fMsgInfo.Values['STATUSMSG'] := aMsg;

  DoSignal;

end;
 

initialization

  InitTasks;

finalization

  DoneTasks;

end.

Open in new window

0
 

Author Comment

by:jaja2005
ID: 24822312
Thank guys! Well it seems that I will have lot of thing to read before my holiday...:-)
see ya
0
 

Author Comment

by:jaja2005
ID: 24843825
Hi Geert, I am studyng you code and note all the question or doubts I have.
Should I expect some other code from you?

>> it's not completed....

see u.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:jaja2005
ID: 24843848
ah..i forgot to tell u. I will be on holiday next 15 days.
If I will not renew the service now can I do it later on and access again to my open question and continue?

Thx

0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24862582
i'll be on holiday too for 3 weeks
i'll be working on this project for myself
i don't know when exactly it will be finished

i'll post the changes in the future, possibly in a article too
0
 

Author Comment

by:jaja2005
ID: 24862668
ok see you soon and enjoy your holiday.
0
 

Author Comment

by:jaja2005
ID: 25367082
Hi All. I am back.
I have been testing your code. I have a couple of question.

As Task I want to ping a node and get the result. I've added
a new components for this in TWorkerThread class as below:

constructor TWorkerThread.Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalWorkerEvent = nil; aUseSynchronize: boolean = True);
begin
  inherited Create(CreateSuspended);
  CreateMsgInfo;
  fSignalMsgEvent := aSignalMsgEvent;
  fUseSynchronize := aUseSynchronize;
  FPing := TipwPing.Create(nil);
 with FPing do begin
  PacketSize := 32;
  Timeout := 60; // Abandon ping attempt after 10 second
  //Idle := True;
  Tag := 0;
  OnResponse := PingThreadResponse;  FOnError := PingThreadError;
 end;


procedure TWorkerThread.PingThreadResponse(Sender: TObject; RequestId: Integer;
      const ResponseSource, ResponseStatus: string; ResponseTime: Integer);
      begin
      FThreadPingResult := ResponseStatus;
      if (ResponseStatus = 'OK') then
      SignalStatus(' Node is UP');
      SignalEnd;
      end;

procedure TWorkerThread.DoAction;
begin
FPing.PingHost('127.0.0.1');
end;

procedure TWorkerThread.Execute;
begin
  SignalBegin;
    try
     try
    DoAction;
    except
  on e: Exception do
        SignalError (e.Message);// Always fired????
     end;
     finally
     SignalEnd;
end;
end;


FPing components works like that:

if Timeout is >0 the component blocks. If the Timeout property is set to 0, all operations return immediately, potentially  failing with an error if they can't be completed immediately.

- If I specify an IP not reachable then i get correctly Timeout message with SignalError (e.Message) after 10s.
- If I specify a valid IP i.e. 127.0.0.1 I got:

- The message "Node is UP" but only after "Timeout seconds"  
- I get also the message Timeout 301 along with "Node is UP", exception is always fired.

Any suggestion?
What's wrong?
:-(


Thx

























0
 

Author Comment

by:jaja2005
ID: 25371855
Want to be sure to undestand you code.
Please check the steps below;

1. First you inizialize the TCollection (TTaskItems) and the Critical Section objects. At very first time the Tcollection is empty.
2. You start the BossThread and in the constructor you set some fSignalMsgEvent to point to ReturningInfo in MainForm.  the fevent is created.

3. BossThread starts chekings for newtask (CheckNewTasks) to be excute in TCollection (TTaskItems). for it you use wrTimeout which value can be easly changed.

4. By Clicking on AddWorker you create an instace of TTask class and sets fStatus in tsNotStarted Status.

5. By using AddTask(x) you add a new TTaskItem to TTaskItems with this code:

with mTasks.Add do
        fTask := aTask;
       TBossThread.Warning;

mTasks.Add automactly creates an object of TTaskItem. You copy x in fTask, which is private field of TTaskItem. if I understood  correctly your approach the real job to be done is specified by ftask field right? Have seen other example where TTaskItem was create like:

TPingItem = class (TCollectionItem)
public
PingThreadId : Integer;
PingThread : TPingThread;
...

In the example above PingThead has events to be fired like PingOnReply, PinOnStatus and so on...

Your decided to use class reference in order to change the type of WorkerThread so job to be done
in DoAction right?
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 25373950
i stopped my further work on the thread boss and worker
i'm gonna use this for myself:
http://otl.17slon.com/
0
 

Author Comment

by:jaja2005
ID: 25376569
Hi. Hmm, I've studied deeply your code and i would like to have things working. The project works nice unless i use in DoAction a sample task (as you have done by using a repeat-until loop). As you can see I added a  FPing component as private filed in WorkerThread. The result I got is described above.

ID: 25367082

The example you posted it has been very useful to me to start to undestand the mechanims of exchanging signal among theads, I have to admit. I am very interested in that and learn a good approach for running task and having work done within a workerthread back to mainVCL or BossThread using delphi events. The structure would be very useful to be implemented
in different scenario where task might be everything.

Why you moved to OmniThreadLibrary? Have you been able to get the same result with Omni? Can you post the code for the example of lunching task from a BossThread?

Do you have examples project on this topic?

I was wating for an article of your on that..:-((

thx





0
 

Author Comment

by:jaja2005
ID: 25376818
Hi Geert.
It must be something wrong with FPing components. Indy Ping works nice.
Let you know.

0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 500 total points
ID: 25380616
i bumped into more problems creating this unit
some things i couldn't solve

amongst others, i allways had to recreate the contructor to implement different parameters

i was looking for a uniform way to do this and went googling
and found OmniThread

My current project involves monitoring some 100+ oracle databases
Currently i'm looping 1 database at a time, checking options and executing commands
so the next database needs to wait on all the tasks to finish of the previous one

with omnithread it looks like i can create a worker for each task
then the pool will run the tasks with a max fixed number of threads
and start a new workers as a thread finishes
so for max = 10, i would be running 10 tasks simultaneously

the next thing is, they are creating a connection pool
also very cool

the unit i created is very basic, and i'm gonna learn this new one
with the knowledge i get from this, i should be able to get more into it



0
 

Author Comment

by:jaja2005
ID: 25397713
I use Delphi 2006., probably it won't work. I have compiled the package and have now in palette only TOmniEventMonitor...it's all that I need...? :-(
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 25399842
lol, same here, threads are not visual components with events to attach
it's possible it will never be more on the palette
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…
I designed this idea while studying technology in the classroom.  This is a semester long project.  Students are asked to take photographs on a specific topic which they find meaningful, it can be a place or situation such as travel or homelessness.…

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now