Solved

creating threads in delphi

Posted on 2016-11-02
1
84 Views
Last Modified: 2016-11-03
i have a timer that i set to create  5 Threads like following

procedure Tform1.checkaccsesstoserverTimer(Sender: TObject);
begin
checkaccsesstoserver.Enabled := False;
PINGTHRDD := TPINGTHRDD.Create(False, 'value1');
PINGTHRDD := TPINGTHRDD.Create(False, 'Value2');
PINGTHRDD := TPINGTHRDD.Create(False, 'Value3');
PINGTHRDD := TPINGTHRDD.Create(False, 'Value4');
PINGTHRDD := TPINGTHRDD.Create(False, 'Value5');

end;

Open in new window


and here is my thread unit

unit Checkipaddr;

interface
uses
Messages, Windows, SysUtils, dialogs, Classes, Menus, forms, ComOBJ, ShlObj,
SyncObjs, Winsock;



type
TPINGTHRDD = Class(TThread)
  private
    Fiptoping : String;
    procedure DoPING;
   {Private}
  protected

  procedure Execute; override;
  {Protected}
  Public

  constructor Create(CreateSuspended: Boolean; Aiptoping : string);
  {Public}
end;

function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean;

var
PINGTHRDD : TPINGTHRDD;

implementation

{ TPINGTHRDD }


function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean;
var
  client : sockaddr_in;
  sock   : Integer;

  ret    : Integer;
  wsdata : WSAData;
begin
 Result:=False;
 ret := WSAStartup($0002, wsdata); //initiates use of the Winsock DLL
  if ret<>0 then exit;
  try
    client.sin_family      := AF_INET;  //Set the protocol to use , in this case (IPv4)
    client.sin_port        := htons(dwPort); //convert to TCP/IP network byte order (big-endian)
    client.sin_addr.s_addr := inet_addr(PAnsiChar(ipAddressStr));  //convert to IN_ADDR  structure
    sock  :=socket(AF_INET, SOCK_STREAM, 0);    //creates a socket
    Result:=connect(sock,client,SizeOf(client))=0;  //establishes a connection to a specified socket
  finally
  WSACleanup;
  end;
end;

constructor TPINGTHRDD.Create(CreateSuspended: Boolean; Aiptoping : string);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
Fiptoping := Aiptoping;
end;

procedure TPINGTHRDD.DoPING;
begin

end;

procedure TPINGTHRDD.Execute;
var
I : integer;
begin
for I := 0 to 3 do

begin
if PortTCP_IsOpen(Fipport,Fiptoping) then
begin
//done
end;

end;

end;

end.

Open in new window



now my problem is when those Threads created they are not doing the job together only one is start to be executed also it cause a crash to my application

how can i create those  5 Threads 1 by 1 after each thread finished without freezing or crashing the app  ?
0
Comment
Question by:dolphin King
1 Comment
 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 41871660
you can create the threads all in 1 go
i think it's the procedure causing the crash
i don't see any protection

you want to start 5 threads, a thread does 3 pings and then ???
where do you want the result to go ?
after the thread is freed ... your result is gone

i'll adapt your framework somewhat ... and take out the compilation errors
unit Checkipaddr;

interface

uses Classes;

function PingResult(aIpToPing: string; aIpPort: Word): string;
procedure RunPing(aIpToPing: string; aIpPort: Word);

implementation

uses
  Windows, SysUtils, ComOBJ, ShlObj, SyncObjs, Winsock;

{ TPINGTHRDD }

type
  TPingThread = class(TThread)
  private
    fIpToPing: string;
    fIpPort: word;
  protected
    procedure Execute; override;
    procedure SetPingResult(aValue: string);
    function PortTCP_IsOpen: boolean;
  public
    constructor Create(aIpToPing: string; aIpPort: Word);
  end;

var
  mPingResults: TStrings;
  mrew: TMultiReadExclusiveWriteSynchronizer;

procedure RunPing(aIpToPing: string; aIpPort: Word);
begin
  TPingThread.Create(aIpToPing, aIpPort);
end;

constructor TPingThread.Create(aIpToPing: string; aIpPort: Word);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  fIpToPing := aIpToPing;
  fIpPort := aIpPort;
end;

procedure TPingThread.Execute;
var
  I, n, nPing : integer;
begin
  SetPingResult('Start');
  n := 0;
  nPing := 3;
  for I := 1 to nPing do
    if PortTCP_IsOpen then
      Inc(n);
  if n = nPing then
    SetPingResult('OK')
  else if n = 0 then
    SetPingResult('FAILED')
  else
    SetPingResult(Format('OK: %d of %d', [n, nPing]));
end;

function TPingThread.PortTCP_IsOpen: boolean;
var
  client : sockaddr_in;
  sock   : Integer;
  ret    : Integer;
  wsdata : WSAData;
begin
  mrew.BeginWrite;
  try
    Result := False;
    ret := WSAStartup($0002, wsdata); //initiates use of the Winsock DLL
    if ret = 0 then
    try
      client.sin_family      := AF_INET;  //Set the protocol to use , in this case (IPv4)
      client.sin_port        := htons(fIpPort); //convert to TCP/IP network byte order (big-endian)
      client.sin_addr.s_addr := inet_addr(PAnsiChar(fIpToPing));  //convert to IN_ADDR  structure
      sock  :=socket(AF_INET, SOCK_STREAM, 0);    //creates a socket
      Result := connect(sock,client,SizeOf(client)) = 0;  //establishes a connection to a specified socket
    finally
      WSACleanup;
    end;
  finally
    mrew.EndWrite;
  end;
end;

procedure TPingThread.SetPingResult(aValue: string);
begin
  mrew.BeginWrite;
  try
    mPingResults.Values[Format('%s:%d', [fIpToPing, fIpPort])] := aValue;
  finally
    mrew.EndWrite;
  end;
end;

function PingResult(aIpToPing: string; aIpPort: Word): string;
begin
  mRew.BeginRead;
  try
    Result := mPingResults.Values[Format('%s:%d', [aIpToPing, aIpPort])];
  finally
    mRew.EndRead;
  end;
end;


initialization
  mrew := TMultiReadExclusiveWriteSynchronizer.Create;
  mPingResults := TStringList.Create;
finalization
  mPingResults.Free;
  mrew.Free;
end.

Open in new window

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

Title # Comments Views Activity
git hub on ubuntu clone a git hub repo how do i find the "packed' file that it downloaded 5 49
Counting documents in a Domino View 3 66
Not needed 13 95
Advice in Xamarin 21 57
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

863 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

28 Experts available now in Live!

Get 1:1 Help Now