Solved

Threading in Delphi

Posted on 2009-05-18
37
1,560 Views
Last Modified: 2012-05-07
Hi
I am using TThread Class in Delphi and I have created my own class called TMyThread adding properties and methods. An instance of another object let's name it "MyObject" spawn a single thread of  TMyThread creating every 5 minutes. Once the thread is done I copy some data in MyObject properties and  then I free it within the TMyThread class itself. I am new to multithreading so I have some doubts I hope you can clarify it:

A). Let's consider I have 400 different "MyObject" which spawn 400 threads every x minutes where x is variable. How I can monitor if the system is suffering of intensive utilization so I can reguate the modalities of spawing threads. Should I set the max number of threads running based on the cpu current utilization ? Should I  extimate periodcally this value within my program? Tmythread is class for polling remote devices via snmp so the time consuming depends on the type of snmp request which can be a huge routing table or a simple value.

B) I store the snmp result in TMyThread propeprty then I copy this value in MyObject before free the thread. Is this a right way generally to exchange data among objects? MyObject updade a memo in VCL main thread for each result. Here my question.
In case I have 400 or more threads running simultaneously ( I am considering the wrost case, a peak) what will be the best way to store the data if I don't want to freeze the user interface?  Storing data in TThreadList? In xml external file updated within
the threads? Should I use a Synvhronizer class that I declare fo the purpose of storing information and only when done I update a visual control in the main thread?

C) All thread are destroyed when done. Should I poll these threads or pause them instead of re-creating them every time?

(*) I already red all topic of threading in internet, I simple searching for any advices how you
would solve it.

Thank in advance.



0
Comment
Question by:jaja2005
  • 20
  • 8
  • 7
  • +1
37 Comments
 
LVL 26

Expert Comment

by:EddieShipman
ID: 24413591
SNMP Result? What exactly are you doing creating 400 SNMP threads? You building a DOD Attack program?
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 24413594
I meant DOS attack program.
0
 

Author Comment

by:jaja2005
ID: 24413663
A network monitoring tool. I wrote 400, but it could be 30 every 3 minutes. By the way I am thinking to add a random sleep() among  them.

Thx
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24414995
in my opinion i think you just wrote a tool to bring down a computer
400 threads ?
ugh
what are you monitoring ?

0
 

Author Comment

by:jaja2005
ID: 24416796
A multiplatform enviroment server, router, windows workstation....
how would u develop such tools? Have you ever seen such solution ? I was wondering how to pool many devices...

400 thread is an example!!
How to develop a NMS for monitoring a network with 300 nodes: 50 server, 10 routers...and so on..
0
 

Author Comment

by:jaja2005
ID: 24416808
I will check it.
Thx

0
 

Author Comment

by:jaja2005
ID: 24416817
Sorry for this post.
It was not releated to this question...
0
 

Author Comment

by:jaja2005
ID: 24418661
Nobody can help me? :-(
0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 200 total points
ID: 24419303
Well actually, you would create a joblist and run through this job list.
This joblist would be a treeview structure.  (For jobs consisthing of several tasks)
But not with 400 threads.
Just use a few threads (like 10) to run through the job list

Each thread starts 1 job, flags it as processing, then going through the jobs tasks and flags the item finished.  Then goes to the next.
One all jobs have been processed, the loop restarts.

You need to consider the data the threads are bringing back needs to be processed too.
This will be the bottleneck: processing all the incoming information.
If you buffer that too, you need also consider if you don't get more data in than you can process.
Let's say you have 20 threads bringing in 1 message per sec.
And you have 1 thread processing the incoming info and handling at 10 messages per sec. ...

0
 

Assisted Solution

by:DelphiOwl
DelphiOwl earned 300 total points
ID: 24419373
A: 400 threads is a lot. Keep your thread count at a reasonable level. Each time you spawn a thread, Windows will use resources to schedule your thread - so, at worst, when you spawn to many threads, you will get very little actual work done. The reasonable number of threads for your application depends of how hard each thread utilize the cpu.

B: It is a god idea to protect the exchange of data between threads by a TCriticalSection, to protect your consuming threads from consuming invalid/broken/partly updated data.
In case your threads produces to much data to visialize in your GUI, you should consider a producer/consumer approach (which could be a class based on TThreadList as you mention). In my opinion, dont use external (xml) storage unless you are aiming for a non-realtime solution.

C: It depends on the rate (400/x). If x is 0.01 then reuse your threads. If x is 10 then no problem in spawning new threads (I dont have any experience in what the penalty for spawning to many threads/sec. actually is, many someone else can comment on that?).

That was my two pennies
    /Jesper

0
 

Author Comment

by:jaja2005
ID: 24424283
I've appreciated a lot last two comments which i am reviewing right now.
I will give you a feedback ASAP.


0
 

Author Comment

by:jaja2005
ID: 24427116

 Basing on your replies I had to keep the number of threads at reasonable level. How to find out an optimal value? ;-)


Scenario: Let's assume that the network is composed of 300 nodes (server, routers, workstation, snmp general devices).

For instance my first goal is:

1. Ping the nodes for checking the network availability
2. Check if snmp is UP
3. If (1) and (2) are ok then I send an snmp getrequest (es. temperature value, tcp error ...)

In my tool Node is rappresented by a TNodeClass. An object of TNodeClass type has several properties, the most
important are IP Address and TTimer component. Every x minute (it's programmable by the user) OnTimer Event is fired for the given node and a procedure executes:

procedure TNodeBase.CheckNode(Sender: TObject);
begin
    NewThread := TPrimeThrd.Create(True);
    NewThread.FreeOnTerminate := True;
    NewThread.OnTerminate := HandleTerminate_test;
    try
    NewThread.ip := IpAddress;
    NewThread.Resume;
  except
     on E: Exception do
      NewThread.Free;
end;


In Excute of TPrimeThrd Class:


procedure TPrimeThrd.Execute;
var
Ping : TPing;
snmp : TSNMP;
begin
 Ping := TPing.Create(nil);
 snmp := TSNMP.Create(nil);
 with Ping do
     begin
     //
      OnResponse := PingResponse;
      OnError  := Error;
      end;
   

      with snmp do
      begin
        RemoteHost  := FIpAddress;
        SNMPVersion := snmpverV2c;
        OnResponse := Response;
        Obj[0] := '1.3.6.1.2.1.2.2.1.8.1';
      end;

try
   begin
      Ping.PingHost(FIpAddress);
       snmp.SendGetRequest();
  end;

 finally
   Ping.Free;
   snmp.Free;
end;

end;

Here is an example so I've set a single item for the colletion Obj[]. Imagine that for a Node I would poll
more object values it depends what my customer wants to monitor (I would store these oid in a TStringList property for
the node). OnResponse events is fired for each snmp reply.( I assume for instance that only one value
is returned from the remote device so I do not care of overwriting problems..)

procedure TPrimeThrd.Response(Sender: TObject; RequestId,
SNMPVersion: Integer; const Community, User: string; SecurityLevel: Integer;
const SourceAddress: string; SourcePort, ErrorIndex, ErrorStatus: Integer;
const ErrorDescription: string);
begin
// Here I get my value and store it in a TPrimeThrd field.
end;

THe same for ping component:

procedure TPrimeThrd.PingResponse(Sender: TObject; RequestId: Integer;
      const ResponseSource, ResponseStatus: string; ResponseTime: Integer);
      begin
      Status := ResponseStatus;
      end;


What I would have done:

Set a max number of a running theads (es. 30), keep track of the current
number threads and run another only if NumCurrentTheads < 30.
This the firts think I thought.

Geert suggests to create a joblist of 10 jobs. Each job has several tasks..so these
tasks in my case I suppose are ping and getsnmp simple requests?. I will
be running 10 threads simultanesly , and for each job I need to have
10 different ping and snmp objects? So what if Node are 200? Could you
please post some code sample?


>> You need to consider the data the threads are bringing back needs to be processed too.

Here I am confused. You mean in case to avoid conflict when the loop
restars? If I had 20 nodes and I run 20 separate threads I would not have
such problem right? This happen only if the number of threads(jobs) is less
than the number of nodes?

DelphOwl

A:The reasonable number of threads for your application depends of how hard each thread utilize the cpu.
How I can check it?

B: In case your threads produces to much data to visialize in your GUI, you should consider a
producer/consumer approach (which could be a class based on TThreadList...
Can you post some code exmaple with TThreadList? :-(

And what if I define a TStringList property for each node where
store snmp value and ping result along with data and time? As per the code I posted above
I might copy the snmp value from the thread to Node's StringList....

C: I dont have any experience in what the penalty for spawning to many threads/sec. actually is, many someone else can comment on that..

I think this is an interesting subject thant could be helpful also in other situation.

Thx




0
 

Author Comment

by:jaja2005
ID: 24441748
I have increased the point to 500.
0
 

Author Comment

by:jaja2005
ID: 24450944
No reply for me? :-(
0
 

Assisted Solution

by:DelphiOwl
DelphiOwl earned 300 total points
ID: 24457333
First of, I think you are on the right track. Let each thread process one network node (ping -> snmp up -> snmp getrequests). Second, its perfectly ok to limit your number of threads by keeping track of the running threads in a list.
As I see it, you are concerned about getting your results from your threads back to your TNodeBase object. I think it can be done simply by giving the thread a callback method for the thread to call (synchronously) when it has produced its result.

Lets do some coding, we need a callback structure:

type
  TThreadResultEvent = procedure ( sender : TObject; pingOk, snmpUp : boolean; snmpResults : TStringList ) of object;

Your TPrimeThrd class' constructor takes a callback method as a parameter like this:

  TPrimeThrd = class (TThread)
  private
    FCallback :  TThreadResultEvent;
    ....
  public
    Constructor Create ( Callback : TThreadResultEvent );
    ....
  end;

In the implementation:
  Constructor TPrimeThrd.Create ( Callback : TThreadResultEvent );
  begin
    inherited Create ( true );
    FCallback := Callback;
    ....
  end;

In your TPrimeThrd.Execute method, when everything is done, you call the callback function to tell the TNodeBase about the result. If you do this by synchronizing the call, you do not have to worry further about
protecting your variables with critical sections.

procedure TPrimeThrd.Execute;
var
Ping : TPing;
snmp : TSNMP;
begin
 Ping := TPing.Create(nil);
 snmp := TSNMP.Create(nil);
 with Ping do
     begin
     //
      OnResponse := PingResponse;
      OnError  := Error;
      end;
   
      ... here you make the thread sleep until you have gotten a PingResponse respons or timeout (use TEvent for this)

      with snmp do
      begin
        RemoteHost  := FIpAddress;
        SNMPVersion := snmpverV2c;
        OnResponse := Response;
        Obj[0] := '1.3.6.1.2.1.2.2.1.8.1';
      end;

      ... here you wait for your snmp responses

      ... now call the callback:
      synchronize(DoCallback);

try
   begin
      Ping.PingHost(FIpAddress);
       snmp.SendGetRequest();
  end;

 finally
   Ping.Free;
   snmp.Free;
end;

end;

In the DoCallback you call the callbackmethod:

  procedure TPrimeThrd.DoCallback;
  begin
    FCallBack ( self, FPingState, FSnmpState, FSnmpResults );
  end;

A:The reasonable number of threads for your application depends of how hard each thread utilize the cpu.
How I can check it?
You can watch the cpu usage in taskmanager... however thowing a few network packets around should not affect your cpu load very much.

B: In case your threads produces to much data to visialize in your GUI, you should consider a
producer/consumer approach (which could be a class based on TThreadList...
Can you post some code exmaple with TThreadList? :-(
If you follow the approach given above, you wont need this.
0
 

Expert Comment

by:DelphiOwl
ID: 24457364
Or maybe you could just use the OnTerminate event and read the thread result directly from there...
What TPing and TSNMP components are you using?
0
 

Author Comment

by:jaja2005
ID: 24457605
Hi DelphiOwl and Thanks a lot for your reply.
I printed your answer and i will give a look it today.
The components are IP Works, VCL version for Delphi 2006.
Thx
0
 

Author Comment

by:jaja2005
ID: 24461304
Hi

Ping.PingHost(FIpAddress), and
snmp.SendGetRequest();

should be these methods at place of your comments in Execute or not?

...and at very end of Excute I call :
synchronize(DoCallback);  ?

In the thread, events are fired when packets are received in :

procedure TPrimeThrd.Response(Sender: TObject; RequestId,
SNMPVersion: Integer; const Community, User: string; SecurityLevel: Integer;
const SourceAddress: string; SourcePort, ErrorIndex, ErrorStatus: Integer;
const ErrorDescription: string);
begin
// Here I get my value and store it in a TPrimeThrd field.
end;

THe same for ping component:

procedure TPrimeThrd.PingResponse(Sender: TObject; RequestId: Integer;
      const ResponseSource, ResponseStatus: string; ResponseTime: Integer);
      begin
      Status := ResponseStatus;
      end;

Componets works like that : I sent an snmp request snmp.SendGetRequest(); and TPrimeThrd.Response
is fired when packet is received. So I don't undestand the needed of TEvent :-(((((

Callback procedure is a method of TNodeBase which I call only when
jobs is done so information are  avaiable for the TnodeBase?

Scenario

TBaseNode1 -> (after 2 minutes) Thread 1 - get data for TbaseNode1 -> Destroy Thred1
TBaseNode1 -> (after 3 minute) Thread 2 - get data fot TbaseNode2 -> Destroy thread2
(and so on...)

TBaseNode is inhereted from TComponent.

How i can undestand when Suspend the thread instead of destroing it?

Thx


0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:jaja2005
ID: 24461992
With regards to SNMP here are you see events, properties and methods:

http://www.nsoftware.com/products/component/snmpmgr.aspx

Data specified in ObjOid are then stored in:

ObjValue       
Array of object values.
0
 

Accepted Solution

by:
DelphiOwl earned 300 total points
ID: 24462438
Yes the Ping.PingHost(FIpAddress), snmp.SendGetRequest() and synchronize(DoCallback) should all be placed inside the execute method. You will need TEvent to make your thread fall asleep until your responses from TPing and TSNMP arrive. In the TPrimeThrd.Response and and TPrimeThrd.PingResponse you will signal the TEvent to wake up your thread. If you do not make your thread sleep in the execute method, the execute method will use 100% cpu power if you keep it running in a loop of some kind. If you do not wait for your response inside the execute method, your thread will terminate when execution exits the execute method (and then the whole idea of using a thread falls apart). Maybe you should consider not using threads at all, and just use your TPrimeThrd objects as "task holders".

0
 

Author Comment

by:jaja2005
ID: 24463023
Thx. I have missed one important thing. I don't know but I was assuming that after sending pinghost and sendrequest the thread would have wait for response , and exit from Excute method only when event were fired. Got it. By the way you are very helpful to me and I thank you for your suggestion.

As per your last advice you mean using TPrimeThrd objects in the main thread? Will this frooze my GUI while pinging nodes?

Do you think that create just a few threads (10/20) and use them for doing more jobs would be better than the previous approach where for each TbaseNode i create a thread ?.

I am interested in multithreading so I kindly ask you if you could complete the code above with spleep in excute along with code on how wakeup the thread from Response and PnigResponse?

The callback procedure you pass as parameter in Thread costructor it's defined
in TBaseNode?

Can you suggest me a good book (I have already download lot of documentation from the web) for dephi multithreading programming?

Thanks a lot for you patience

0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 200 total points
ID: 24465158
I wrote a ping tool once. It had to intensively monitor several servers to find network failures.
It logs the ping results in files
in another thread i upload the results periodically to the database
unit threadPing;
 

interface
 

uses

  Classes;
 

const

  PINGSLEEP = 100;
 

type

  TPingType = (ptPing, ptHTTP, ptFTP);
 

  TCallbackProc = procedure (aMessage: string; aMessageInfo: Integer = 0) of object;
 

  TCallbackThread = class(TThread)

  private

    FCallBack: TCallbackProc;

    FCallbackMsg: string;

    FCallbackMsgInfo: integer;

    procedure SynchedCallback;

  protected

    procedure DoCallback(aMsg: string; aMsgInfo: integer = 0); virtual;

    property Callback: TCallbackProc read FCallback;

  public

    constructor Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False); reintroduce; virtual;

  end;
 
 

procedure CreateNetworkPing(CallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal);

procedure KillNetworkPing(Id: Integer); overload;

procedure KillNetWorkPing; overload;
 

implementation
 

uses IdRawHeaders, IdIcmpClient, IdComponent, SysUtils;
 

type

  TPingThread = class(TCallbackThread)

  private

    fSuccessIPResolve: boolean;

    fId: Integer;

    fIP: string;

    fComputerName: string;

    fPort: Integer;

    fIpClient: TIdIcmpClient;

    fTimeOut: Cardinal;

    fTimeStarted: TDateTime;

    fBoundary: Cardinal;

    fPingMsg: string;

    iLastTimeElapsed: Cardinal;

    iLastStatus: Integer;

    iTimeElapsed: Cardinal;

    iTimeStarted: TDateTime;

    iStatus: Integer;
 

    procedure DoNotify(Status: Integer; AIp: string; TimeStarted: TDateTime; TimeElapsed: Cardinal);

    procedure PingOnReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

    procedure PingOnStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);

    procedure AddPingLog(aName, aMsg: string);

  protected

    procedure Execute; override;

  public

    constructor Create(aCallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal); reintroduce;

    destructor Destroy; override;

  end;
 

  TPingItem = class(TCollectionItem)

  public

    PingThreadId: Integer;

    PingThread: TPingThread;
 

    destructor Destroy; override;

  end;
 

  TPingItems = class(TCollection)

  public

    destructor Destroy; override;

    procedure Add(aCallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal);

    procedure Kill(Id: Integer);

  end;
 

var

  iPingItems: TPingItems = nil;

  DeltaTime: Double = 0.001 / 24 / 60 / 60;
 

function PingItems: TPingItems;

begin

  if iPingItems = nil then

    iPingItems := TPingItems.Create(TPingItem);

  Result := iPingItems;

end;
 

procedure KillNetWorkPing;

begin

  FreeAndNil(iPingItems);

  iPingItems := nil;

end;
 

procedure AddToLog(LOG_ACTIVE: boolean; LOG_PATH: string; LOG_MAXSIZE: integer; LOG_LIFETIME: double;

  LogPrefix, Msg: string; DateTimeLinePrefix: Boolean = True);

var

  sr: TSearchRec;

  LogFile: TextFile;

  ValidFile, SearchPath: string;

  valid: boolean;

  j: integer;

  TimeStr : string;

begin

  if LOG_ACTIVE then

  begin

    csLog.Enter;

    try

      SearchPath := LOG_PATH;

      if SearchPath[length(SearchPath)] <> '\' then

        SearchPath := SearchPath + '\';

      if FindFirst(format('%s%s*.log',[SearchPath,logPrefix]),faAnyFile,sr) = 0 then

      begin

        ValidFile := '';

        repeat

          if sr.Size < LOG_MAXSIZE * 1024 then

            ValidFile := sr.Name

          else

            if FileDateToDateTime(sr.Time) < (Now - LOG_LIFETIME) then

              DeleteFile(Pchar(SearchPath+sr.Name));

        until FindNext(sr) <> 0;

      end;

      SysUtils.FindClose(sr);

      if length(ValidFile) > 0 then

      begin

        j := 0;

        repeat

          try

            AssignFile(LogFile,format('%s%s',[SearchPath,ValidFile]));

            Append(LogFile);

            valid := true;

            Inc(j);

          except

            valid := false;

            sleep(500);

          end;

        until valid or (j > 2);

      end

        else

      begin

        j := 0;

        repeat

          try

            Rewrite(logfile,format('%s%s_%s.log',[SearchPath,LogPrefix,FormatDateTime('ddmmhhnn',now)]));

            valid := true;

          except

            Inc(j);

            valid := false;

            sleep(500);

          end;

        until valid or (j > 2);

      end;

      j := 0;

      repeat

        try

          if DateTimeLinePrefix then

          begin

            DateTimeToString(TimeStr, 'DD/MM/YYYY HH:NN:SS', Now);

            Msg := TimeStr + ' - ' + Msg;

          end;

          Writeln(LogFile,Msg);

          valid := true;

        except

          Inc(j);

          valid := false;

          sleep(500);

        end;

      until valid or (j > 2);

      CloseFile(LogFile);

    finally

      csLog.Leave;

    end;

  end;

end;
 
 

{ TCallbackThread }
 

constructor TCallbackThread.Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False);

begin

  inherited Create(CreateSuspended);

  FreeOnTerminate := True;

  FCallback := aCallback;

end;
 

procedure TCallbackThread.DoCallback(aMsg: string; aMsgInfo: Integer = 0);

begin

  FCallbackMsg := aMsg;

  FCallbackMsgInfo := aMsgInfo;

  Synchronize(SynchedCallback);

end;
 

procedure TCallbackThread.SynchedCallback;

begin

  if Assigned(FCallback) then

    FCallBack(FCallbackMsg, FCallbackMsgInfo);

end;
 

{ TPingThread }
 

constructor TPingThread.Create(aCallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal);

begin

  inherited Create(aCallbackProc);

  FreeOnTerminate := True;

  fSuccessIPResolve := False;

  fId := Id;

  fComputerName := ComputerName;

  fIp := IP;

  fPort := Port;

  fTimeOut := TimeOut;

  fBoundary := Boundary;

  fPingMSg := 'PING_' + IntToStr(fId);

  fIpClient := TIdIcmpClient.Create(nil);

  fIpClient.ReceiveTimeout := fTimeOut;

  fIpClient.Host := fIp;

  fIpClient.Port := Port;

  // fIpClient.Port := Ping, HTTP or FTP

  fIpClient.OnReply := PingOnReply;

  fIpClient.OnStatus := PingOnStatus;

  iLastTimeElapsed := 0;

  iLastStatus := -1;

end;
 

procedure TPingThread.Execute;

var RunningSent: Boolean;

begin

  RunningSent := False;

  DoNotify(0, fIp, Now, 0);

  try

    Sleep(1000); // Wait 1 second to start (let previous thread finish)

    try

      repeat

        fTimeStarted := Now;

        if not Terminated and Assigned(fIpClient) then

        try

          fIpClient.Ping(fPingMsg, fId);

          if not RunningSent then

          begin

            DoCallback('RUNNING', fId);

            RunningSent := True;

          end;

        except

          on E: Exception do

            DoNotify(Integer(hsDisconnected), fIp, fTimeStarted, Round(Now - fTimeStarted * 60*60*24*1000));

        end;

        Sleep(PINGSLEEP);

      until Terminated;

    except

    end;

  finally

    DoCallback('NOT RUNNING', fId);

  end;

end;
 

procedure TPingThread.DoNotify(Status: Integer; AIp: string; TimeStarted: TDateTime; TimeElapsed: Cardinal);

var Msg: string;

begin

  if not Terminated then

  begin

    iTimeStarted := TimeStarted;

    iTimeElapsed := TimeElapsed div fBoundary * fBoundary;

    iStatus := Status;

    if (iTimeElapsed <> iLastTimeElapsed) or

      (iLastStatus <> iStatus) then

    begin

      Msg := Format('NAME=%s;IP=%s;START=%s;ELAPSED=%d;TIMEOUT=%d;BOUNDARY=%d;PORT=%d;STATUS=%d;DTSTART=%s',

        [fComputerName, AIp, StringReplace(FloatToStr(iTimeStarted), DecimalSeparator, '.', [rfReplaceAll]),

         iTimeElapsed, fTimeOut, fBoundary, fPort, iStatus, FormatDateTime('DD-MM-YYYY_HH:NN:SS.ZZZ', TimeStarted)]);

      AddPingLog('ping_' + fComputerName, Msg);

      DoCallback('TTL_' + IntToStr(iTimeElapsed), fId);

    end;

    iLastTimeElapsed := iTimeElapsed;

    iLastStatus := iStatus;

  end;

end;
 

destructor TPingThread.Destroy;

begin

  if Assigned(fIpClient) then

  try

    FreeAndNil(fIpClient);

  except

  end;

  inherited Destroy;

end;
 

procedure TPingThread.PingOnReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

  function IsIp(aText: string): boolean;

  var

    Temp: string;

    I: Integer;

  begin

    Result := (AText <> '') and IsNumeric(StringReplace(aText, '.', '', [rfReplaceAll]));

    if Result and (Pos('.', aText) > 0) then

    begin

      if aText = '0.0.0.0' then

        Result := False

      else

      begin

        Result := False;

        Temp := '';

        for I := 1 to Length(aText) do

          if not (aText[I] in ['0'..'9']) then

            Temp := Temp + aText[I];

        if Temp = '...' then

        begin

          if IsNumeric(IndexString(aText, 1, '.')) and

            IsNumeric(IndexString(aText, 2, '.')) and

            IsNumeric(IndexString(aText, 3, '.')) and

            IsNumeric(IndexString(aText, 4, '.')) then

            Result := True;

        end;

      end;

    end;

  end;

begin

  if not fSuccessIPResolve then

    if not IsIp(fComputerName) and SameText(fComputerName, fIp) then

    begin

      if IsIp(AReplyStatus.FromIpAddress) then

      begin

        fIP := AReplyStatus.FromIpAddress;

        fSuccessIpResolve := True;

        DoCallback(fIp, fId);

      end;

    end;

  DoNotify(Integer(AReplyStatus.ReplyStatusType), AReplyStatus.FromIpAddress, fTimeStarted, AReplyStatus.MsRoundTripTime);

end;
 

procedure TPingThread.PingOnStatus(ASender: TObject;

  const AStatus: TIdStatus; const AStatusText: string);

begin

  DoNotify(Integer(AStatus), fIp, fTimeStarted, 0);

end;
 

procedure TPingThread.AddPingLog(aName, aMsg: string);

begin

  AddToLog(True, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'PINGLOG'), 1024, 30, aName, aMsg, False);

end;
 

{ TPingItems }
 

procedure TPingItems.Add(aCallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal);

var PingItem: TPingItem;

begin

  Kill(Id);

  PingItem := TPingItem(inherited Add);

  PingItem.PingThreadId := Id;

  PingItem.PingThread := TPingThread.Create(aCallbackProc, Id, ComputerName, IP, Port, TimeOut, Boundary);

end;
 

procedure TPingItems.Kill(Id: Integer);

var I: Integer;

begin

  for I := Count-1 downto 0 do

    if TPingItem(Items[I]).PingThreadId = Id then

      TPingItem(Items[I]).Free;

end;
 

destructor TPingItems.Destroy;

begin

  while Count > 0 do

    Kill(TPingItem(Items[0]).PingThreadId);

  inherited Destroy;

end;
 

{ TPingItem }
 

destructor TPingItem.Destroy;

begin

  try

    if Assigned(PingThread) then

      PingThread.Terminate;

  except

  end;

  inherited Destroy;

end;
 

procedure CreateNetworkPing(CallbackProc: TCallbackProc; Id: Integer; ComputerName, IP: string; Port: Integer; TimeOut, Boundary: Cardinal);

begin

  PingItems.Add(CallbackProc, Id, ComputerName, IP, Port, TimeOut, Boundary);

end;
 

procedure KillNetworkPing(Id: Integer);

begin

  PingItems.Kill(Id);

end;
 

initialization

  csLog := TCriticalSection.Create;

finalization

  FreeAndNil(iPingItems);

  FreeAndNil(csLog);

end.

Open in new window

0
 

Expert Comment

by:DelphiOwl
ID: 24468325
I have made this little example for you, using TIdIcmpClient to do the actual ping'ing. One thing I realized is that TIdIcmpClient blocks when the Ping method is called, and does not return until a response or a timeout occurs. If the IP Works TPing component also blocks, you will not have the need for making your thread sleep with TEvent (you have allready figured this out yourself).
In my example I ping a whole c-subnet by making all 255 threads at one time. It seems to be no problem for the cpu to handle, however, the Delphi debugger spends a lot of time on managing new threads - so, run the application from outside Delphi to evaluate the true performance.
unit Unit1;
 

interface
 

uses

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

  Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient,

  StdCtrls;
 

type

  TForm1 = class(TForm)

    IdIcmpClient1: TIdIcmpClient;

    Button1: TButton;

    ListBox1: TListBox;

    procedure Button1Click(Sender: TObject);

  private

    FSeqID : word;

    procedure ThreadTerminate ( Sender : TObject );

  public

  end;
 

  TTask = class ( TThread )

  private

    FIdIcmpClient: TIdIcmpClient;

    FPingRecv : integer;

    FIP : string;

    FError: string;

    FSeqID : word;

    procedure IdIcmpClientReply(ASender: TComponent;

                                const AReplyStatus: TReplyStatus);

  protected

    procedure Execute; override;

  public

    constructor Create ( IP : string; seqID : word );

    destructor Destroy; override;

    property PingRecv : integer read FPingRecv;

    property IP : string read FIP;

    property Error : string read FError;

  end;
 

var

  Form1: TForm1;
 

implementation
 

{$R *.dfm}
 

procedure TForm1.Button1Click(Sender: TObject);

var

  t : TTask;

  n : integer;

begin

  FSeqID := 1;

  for n := 1 to 255 do

  begin

    t := TTask.Create ( '192.168.10.'+inttostr(n), FSeqID );

    t.OnTerminate := ThreadTerminate;

    t.Resume;

    inc(FSeqID);

  end;

end;
 

procedure TForm1.ThreadTerminate(Sender: TObject);

begin

  if TTask(Sender).Error = '' then

  begin

    if TTask(Sender).PingRecv <> 0 then

      ListBox1.Items.Add( 'Reply from ' + TTask(Sender).IP + ' '+inttostr(TTask(Sender).PingRecv)+' bytes' )

    else

      ListBox1.Items.Add( 'No reply from '+TTask(Sender).IP );

  end else

  begin

    ListBox1.Items.Add( 'Error on '+TTask(Sender).IP+':´'+TTask(Sender).Error );

  end;

end;
 

{ TTask }
 

constructor TTask.Create(IP: string; seqID : word );

begin

  inherited Create ( true );

  FreeOnTerminate := true;

  FIP := IP;

  FError := '';

  FSeqID := seqID;

end;
 

destructor TTask.Destroy;

begin

  FIdIcmpClient.Free;

  inherited;

end;
 

procedure TTask.Execute;

begin

  try

    FIdIcmpClient := TIdIcmpClient.Create ( nil );

    FIdIcmpClient.Host := FIP;

    FIdIcmpClient.ReceiveTimeout := 5000;

    FIdIcmpClient.OnReply := IdIcmpClientReply;

    FIdIcmpClient.Ping ( '', FSeqID );

  except

    on e: exception do

    begin

      FError := e.Message;

    end;

  end;

end;
 

procedure TTask.IdIcmpClientReply(ASender: TComponent;

  const AReplyStatus: TReplyStatus);

begin

  if AReplyStatus.SequenceId = FSeqID then

  begin

    FPingRecv := AReplyStatus.BytesReceived;

  end else

  begin

    FPingRecv := 0;

  end;

end;
 

end.

Open in new window

PingThread.txt
0
 

Author Comment

by:jaja2005
ID: 24468913
Hi Guys.
Thanks a lot, give me a few days to study your code and I will back ASAP to u.
I am getting fond of multithreading in delphi, very cool. -))

<<...If the IP Works TPing component also blocks>>

Yes, Actually in my example with IP Works (using TPrimeThread) I get all response in main vcl thread in a MEMO components , I have tested it with 10 local snmp devices (using snmp simulator ) and with remote website like google.com...
The snmp query seems to work nice even with snmp bulk request on a large
IpRouteTable. But I had some doubts that's why i've started to post here.

If so I need only to find a good solution to exchange data among TbaseNode and threads (and limit the number of running thread to a max value).

I will also open a ticket support with the HQ asking for futher information on
this issue.

See ya.




0
 

Author Comment

by:jaja2005
ID: 24474383
Hi DelphiOwl. Could you please send the project as attached file for delph 2006?
Please Geert could you do the same with yours?

Thanks a lot.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24474438
i don't have D2006, i uninstalled it...
i still have to install D2007 some time in the future, currently only D7 and D2009.
0
 

Expert Comment

by:DelphiOwl
ID: 24474475
Its allready there in PingThread.txt... rename it to PingThread.rar and unpack it ;-)
0
 

Author Comment

by:jaja2005
ID: 24476108
IP Works support:

As long as you set the Timeout property to a positive value the components
will behave synchronously. If the Timeout is set to 0, the operations will
be asynchronous (so you would need to wait).


0
 

Author Comment

by:jaja2005
ID: 24477443

Below the description of the Timeout from help file:

Syntax
property Timeout: Integer;
Default Value
60

Remarks
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 Timeout is set to a positive value, the component will wait for the operation to complete before returning control.

The component will use DoEvents to enter an efficient wait loop during any potential waiting period, making sure that all system events are processed immediately as they arrive. This ensures that the host application does not "freeze" and remains responsive.

If Timeout expires, and the operation is not yet complete, the component raises an exception.

Please note that by default, all timeouts are inactivity timeouts, i.e. the timeout period is extended by Timeout seconds when any amount of data is successfully sent or received.


So setting the Timeout>0 will block the component, by the way I don't undestand if this implies that the thread fall asleep until responses from Ping and SNMP arrive.



0
 

Author Comment

by:jaja2005
ID: 24480634
if Timeout > 0 the component will block.
The component won't be sleeping though, it will be internally doing events,
so you shouldn't see any increased CPU usage there, and events on the thread
will continue to work.

Guys, does it solve the problem?

DelphiOwl:
<<If you do not make your thread sleep in the execute method, the execute method will use 100% cpu power if you keep it running in a loop of some kind.>>

Thx
0
 

Expert Comment

by:DelphiOwl
ID: 24482275
Well, it seems it all depends on how the "IP Works" components works. I dont have any experience with them, so I am not to very much help there.
0
 

Author Comment

by:jaja2005
ID: 24482412
Thx.
Nobody had experiences with it?

Thx
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24490477
i don't, just with indy and ye olde netmaster components (D5)
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24523754
have you read the recommendations on grading  a question in the help ?
when you don't give a comment, then it is recommended you give an A grade
if there is a B grade then something is obviously missing
but since no comment, we don't know what ...
0
 

Author Comment

by:jaja2005
ID: 24524088
Hi. Sorry, I to turn in A?
Thx
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24524140
i dunno, if you still have some issues that need clearing out, post them
if you find everything correct than the idea would be an A grade.
this seems to be a tendancy which everybody new to this site seems to be having.
i admit, the help is a lot to read and halfway through i gave up as well
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 25373941
this is a very advanced site on threading:
http://otl.17slon.com/
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

747 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

8 Experts available now in Live!

Get 1:1 Help Now