Solved

creating threads in delphi

Posted on 2016-11-02
1
200 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This article will show, step by step, how to integrate R code into a R Sweave document
Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
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…

732 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