Solved

creating threads in delphi

Posted on 2016-11-02
1
106 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

ScreenConnect 6.0 Free Trial

Discover new time-saving features in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

Question has a verified solution.

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

In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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 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…

803 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