Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

creating threads in delphi

Posted on 2016-11-02
1
Medium Priority
?
334 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 38

Accepted Solution

by:
Geert Gruwez earned 2000 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

Tech or Treat! - Giveaway

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

Question has a verified solution.

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

This is about my first experience with programming Arduino.
Q&A with Course Creator, Mark Lassoff, on the importance of HTML5 in the career of a modern-day developer.
Progress
Starting up a Project
Suggested Courses

604 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