I get the following when communicating with a custom client.
With custom client i mean a housemade PCB with a FPGA which runs the Triple-Speed Ethernet Intel FPGA IP. It does not make a difference if a switch is between the PC and the PCB.
Workflow seen from the Server(Windows PC) where i detect this behaviour with wireshark:
Connect to client (Syn - Syn/Ack - Ack) Winsock2.connect
Sending data > MTU with Winsock2.WSASend (4092 Bytes on a 4088 Bytes MTU)
Packet gets "fragmented" into 2 packets - do not fragment bit is set
A Retransmission happens (because the client answered too slow?)
I am using delphi 10.4 and use the Winsock2 functions. Bevore each send i check with select if fdwrite is set if FD_Isset. Nagle is deactivated.
The "retransmission" does not happen everytime and i could not detect any sort of pattern when they occur. Except most of the time it is when the client needs more than 30ms to send his ACK.
When the "retransmission" happens it is not packet 1 or two whicht is re-send, but packet 1 with an offset of 60 which is the payload of packet 2. The sequence number of packet 1 is incremented by 60 too. Even the data is correct, it's correctly incremented by 60.
When I send 6000 Bytes i get the same behaviour with an incremented seq of 1968 which is correct too.
What is happening here?
Can i detect this with winsock2? Can i set the RTO with winsock? Why is the sequence number incremented and not packet 1, as it is, retransmitted?
Source Code of the send function:
function TZWinTCPSock.SendData (out ErrMsg : TAPILogStruct; SendOffset :
Cardinal = 0) : Boolean;
var
WSABuff : WSABUF;
res : Integer;
IPFlags : Cardinal;
t : Cardinal;
WSAErr : Cardinal;
begin
Result := FALSE;
WSAErr := WSAGetLastError;
try
if not CheckSockValid(ErrMsg) then // checks if fd_write is set
begin
exit(false);
end;
try
WSABuff.len := FMem.SendLength; // 4092 at this time Cardinal
WSABuff.buf := #FMem.SendData[SendOffset]; // 8192 Bytes reserved TArray<Byte>
IPFlags := 0;
res := WSASend(FSocket,#WSABuff,1,FMem.sentBytes,IPFlags,nil,nil);
if Res <> SOCKET_ERROR then
begin
if FMem.SendLength <> FMem.SentBytes then
begin
exit(false);
end
else
begin
Result := TRUE;
if WSAGetLastError <> WSAErr then // unexpected WSA error
begin
exit(FALSE);
end;
end;
end
else
begin
FLastWSAErr := WSAGetLastError;
if FLastWSAErr = WSAECONNRESET then
begin
Disconnect(ErrMsg);
exit(false);
end;
end;
except
on E : Exception do
begin
// Some error handling
end;
end;
finally
end;
end;
Edit1
The packets have the don't fragment Bit set.
I tried to detect this "retransmission" with the windows admin center, but I don't see anything popping up.
Got an answer on Microsoft Q&A.
Looks like it was a tail loss probe problem where the destination host is at fault, because the reply took too long and srtt timed out.
Related
Using delphi 10.3 and JEDI VCL.
I have a communication with a device, which responds to UDP data.
Now I want to be able to check if I got an answer from the right device, or if if I even got any answer.
Currently I am using the following:
function TDIB.ReadData(ACommandCode: WORD; ASendLength : Cardinal; AReceiveLength : Cardinal; AAddress : Cardinal) : Integer;
var
cmdHeader : PDIBCommandHeader;
UDPSend, UDPRecv : TIdBytes;
client : TIdUDPClient;
begin
gRequestPending := TRUE;
// Reserviere Speicher
SetLength(UDPSend, SIzeOF(TDIBCommandHeader) + Cardinal(ASendLength));
SetLength(UDPRecv, SIzeOF(TDIBCommandHeader) + Cardinal(AReceiveLength));
cmdHeader := #UDPSend[0];
cmdHeader.Init(WORD(ACommandCode), AAddress, MAX(ASendLength, AReceiveLength));
client := TIdUDPClient.Create();
try
client.Host := ValToIPv4(gDIBAddress);
client.Port := TDIBPorts.mainPort;
client.Active := TRUE;
client.sendBuffer (UDPSend);
client.ReceiveBuffer(UDPRecv,TDIB.C_CMDTimeout);
except
on E: Exception do
begin
ShowMessage('Exception');
client.Free;
end;
end;
SetLength(lastUDPData, Length(UDPRecv));
move (UDPRecv[0],lastUDPData[0],Length(UDPRecv));
client.Free;
gRequestPending := FALSE;
end;
Which is fine when the client is responding, but I am not catching any misbehaviour, like when the host machine tries to reach the client and the client is not responding.
From the documentation of Indy10 I am missing something like TIdUDPClient.TimedOut or like that.
I want to be able to tell, if the client is not responding after Xms after I sent the UDP packet and I want to be able to check, if the sender address is the wanted client IP.
I want to be able to tell, if the client is not responding after Xms after I sent the UDP packet
ReceiveBuffer() returns the number of bytes actually received. If no packet is received within the specified timeout, ReceiveBuffer() will return 0.
I want to be able to check, if the sender address is the wanted client IP.
Use one of the ReceiveBuffer() overloads that has a VPeerIP output parameter. That will give you the sender IP if a packet is received, or it will give you an empty string if no packet is received.
Do be aware that UDP has a concept of a 0-byte datagram. ReceiveBuffer() will return 0 for that as well. In the case that 0 is returned, you can use this output string to differentiate between no packet received (VPeerIP = '') vs a 0-byte packet received (VPeerIP <> ''), if needed.
My question was asked here before, but I'm trying to implement a neater solution for my project. So, as title states, I'm creating a complex installer of the server application that has to check local IP address and choose a open port, so that the application could be properly configured. Inno Setup 5.6.1 is used.
Getting local IP addresses was not a problem, this solution helped me a lot. Then it came to the port's checking and here I've found the following three options:
Using external DLL from installer. Actually, previous solution consisted of a C++ DLL, that exported two exact convenience functions, they worked great, installer used them, but sometimes, rarely on some Windows versions this DLL didn't want to get loaded causing error. That's why all the more messing with Pascal Script here.
Launching netstat via cmd and getting the output. This is still an option, though I feel this solution is crutchy like hell and would like to avoid it. Details could be found in other SO answer.
Getting information from WinAPI call. Looks best if possible.
As was mentioned above, getting IP address can be implemented via straightforward (ok, not really, it's a Pascal Script) WinAPI calls. So, I tried to do the same trick with ports, trying to call GetTcpTable():
[Code]
const
ERROR_INSUFFICIENT_BUFFER = 122;
function GetTcpTable(pTcpTable: Array of Byte; var pdwSize: Cardinal;
bOrder: WordBool): DWORD;
external 'GetTcpTable#IpHlpApi.dll stdcall';
{ ------------------------ }
function CheckPortIsOpen(port: Integer): Boolean;
var
TableSize : Cardinal;
Buffer : Array of Byte; { Alas, no pointers here }
RecordCount : Integer;
i, j : Integer;
portNumber : Cardinal;
IpAddr : String;
begin
Result := True;
TableSize := 0;
if GetTcpTable(Buffer, TableSize, False) = ERROR_INSUFFICIENT_BUFFER then
begin
SetLength(Buffer, TableSize);
if GetTcpTable(Buffer, TableSize, True) = 0 then
begin
{ some magic calculation from GetIpAddrTable calling example }
RecordCount := (Buffer[1] * 256) + Buffer[0];
For i := 0 to RecordCount -1 do
begin
portNumber := Buffer[i*20 + 8]; { Should work! }
{ Debugging code here }
if (i < 5) then begin
IpAddr := '';
For J := 0 to 3 do
begin
if J > 0 then
IpAddr := IpAddr + '_';
IpAddr := IpAddr + IntToStr(Buffer[I*20+ 4 + J]);
end;
SuppressibleMsgBox(IpAddr, mbError, MB_OK, MB_OK);
end;
{ ------ }
if port = portNumber then
Result := False;
end;
end;
end;
end;
This GetTcpTable also returns information about addresses and ports (table of TCP connections to be exact), so trying to get any connection address is good for debugging purposes. More about this attempt:
RecordCount is calculated the same way as in the code I used as an example, because obtained struct there is very similar to the nasty struct I need.
That i*20 + 8 is written that way, because 20 = sizeof(single record struct) and 8 = 2 * sizeof(DWORD). Local TCP connection address is being "parsed" one-by-one-byte at an offset of 1 DWORD, as you can see.
So, everything is great fun... it just is not working =((
And yes, I've tried to print all the bytes one-by-one, to search for the desired data manually and understand the correct offset. To my disappointment, nothing looking like IPs and ports was found, the numbers were quite mysterious.
I know that sometimes the simplest solution is best, not the smartest, but if anyone could give me a key cooking this WinAPI function in a proper way, I would be deeply grateful.
Your magic calculations are off.
portNumber := Buffer[i*20 + 8]; { Should work! }
Since Buffer is a byte array the above extracts one byte only. But the local port number is a DWORD in the TCP table. Though the documentation you linked states:
The local port number in network byte order for the TCP connection on the local computer.
The maximum size of an IP port number is 16 bits, so only the lower 16 bits should be used. The upper 16 bits may contain uninitialized data.
So we need two bytes. And we need to switch them, note "network byte order" above.
You are also forgetting to account for the 4 byte record count at the beginning of the table. So the local port number should become:
portNumber := Buffer[i*20 + 12] * 256 +
Buffer[i*20 + 13];
I am trying to write a detailed error message to the system log using the ReportEventW function. Unfortunately, I am encountering problems which are apparently related to the limits within the function but I can't find any real documentation of them: there is a documented limit on dwDataSize and another limit on the maximum length of each string. I am not violating any of these limits, but I am still receiving a FALSE and GetLastError reports RPC_S_INVALID_BOUND.
Through testing, I found that for my test case the limit is caused by the number of strings (wNumStrings), with 203 being the most I can put through correctly (additionally, for 204-206 strings the ReportEventW will return a TRUE but will not write to the log!). If I add 1024 dummy characters to the first line, I once again get an error and have to decrease the number of lines, as far as I can tell, by the same number of characters I added earlier, which would indicate that some total character limit on the whole message is coming to play. Unfortunately, I can't match it against any documented limit even if I ignore what the limits should apply to - my value of about 33300 characters is close to the value 31839 characters (max. length of each string), but sufficiently higher than that to make me discard the theory that the limit on a length of individual string also applies to the total length of the whole message. Apparently, if I add extra raw data, the limit goes down again, which suggests a limitation on the size of the whole event log record.
My questions are:
1) Does anyone know the actual limits for writing to the event log?
2) Do these limits change with the different operating systems? All my tests were performed on Win10 x64, but I have a nasty suspicion that with different OSes, I will encounter a different limitation.
3) Is this documented somewhere?
Thanks.
Actual code (added on request)
procedure WriteToEventLog(const Messages: array of string; const RawData: AnsiString);
const
MaxStringCount = High(Word); // je to WORD! Realne se limit zda byt mnohem mensi
MaxRawDataLen = 61440;
EmptyMessage = #0#0#0#0;
type
TPCharArray = array[0..65535] of PChar;
var
Handle: THandle;
Msgs: ^TPCharArray;
MsgCount: integer;
DataPtr: PAnsiChar;
DataLen: integer;
i: Integer;
begin
MsgCount := Length(Messages);
if MsgCount > MaxStringCount then
MsgCount := MaxStringCount;
Msgs := AllocMem(MsgCount * Sizeof(PChar));
try
for i := 0 to Pred(MsgCount) do
begin
if Messages[i] = ''
then Msgs[i] := EmptyMessage
else Msgs[i] := PChar(Messages[i]);
end;
if RawData = '' then
begin
DataPtr := nil;
DataLen := 0;
end
else
begin
DataPtr := #RawData[1];
DataLen := Length(RawData);
if DataLen > MaxRawDataLen then
DataLen := MaxRawDataLen;
end;
Handle := RegisterEventSource(nil, PChar(ParamStr(0)));
if Handle <> 0 then
begin
try
ReportEvent(Handle, EVENTLOG_ERROR_TYPE, 0, 0, nil, MsgCount, DataLen, Msgs, DataPtr);
finally
DeregisterEventSource(Handle);
end;
end;
finally
FreeMem(Msgs);
end;
end;
It is called with Messages array containing rows from an EurekaLog report (one row per message, about 300 rows).
I can't answer your questions comprehensively, but I just ran into a similar issue. I only used the wNumStrings and lpStrings parameters and, contrary to documentation, still received the RPC_S_INVALID_BOUND error code (1734). On a nagging suspicion, I reduced the number of strings to 256 and it worked. Sure enough, it failed with 257. This was true regardless of the size of the individual strings. There are probably upper limits for individual strings and total message size too, but I didn't bother figuring those out.
TL/DR: wNumStrings <= 256
I am trying to load the contents of a file from one of the Windows virtual folders (for example, a camera or iPhone picture folder). Below is some sample code that I am using to play around with this:
procedure TfrmForm.ButtonClick(Sender: TObject);
Var
Dialog: TAttachDialog;
Enum: IEnumShellItems;
Name: LPWSTR;
Item: IShellItem;
Strm: IStream;
OStrm: TOLEStream;
FStrm: TFileStream;
Result: HRESULT;
Buf: Array[0..99] Of Char;
Read: LongInt;
begin
Result := CoInitializeEx(Nil, COINIT_APARTMENTTHREADED Or
COINIT_DISABLE_OLE1DDE);
If Succeeded(Result) Then
Begin
Dialog := TAttachDialog.Create(Self);
Try
Dialog.Options := [fdoAllowMultiSelect, fdoPathMustExist,
fdoFileMustExist];
Dialog.Title := 'Select Attachments';
If Dialog.Execute(Self.Handle) Then
Begin
If FAILED(Dialog.ShellItems.EnumItems(Enum)) Then
Raise Exception.Create('Could not get the list of files selected.');
While Enum.Next(1, Item, Nil) = S_OK Do
Begin
If (Item.GetDisplayName(SIGDN_NORMALDISPLAY, Name) = S_OK) Then
Begin
mResults.Lines.Add(Name);
CoTaskMemFree(Name);
End;
If Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
Begin
OStrm := TOLEStream.Create(Strm);
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
FStrm.CopyFrom(OStrm, OStrm.Size);
FreeAndNil(OStrm);
FreeAndNil(FStrm);
Strm := Nil;
End;
Item := Nil;
End;
End;
Finally
FreeAndNil(Dialog);
End;
CoUninitialize;
End;
end;
TAttachDialog is just a descendant of TCustomFileOpenDialog that exposes the ShellItems property. In my actual application, I need a TStream object returned. So, in this example, I am using a TFileStream top copy the source file as proof of concept that I have successfully accessed the file using a Delphi stream. Everything works Ok until I try the FStrm.CopyFrom at which point I get a "Not Implemented" error. What am I doing wrong with this or is there a better way entirely to do what I want?
The only time TStream itself raises a "not implemented" error is if neither the 32bit or 64bit version of Seek() are overridden in a descendant class (or one of them erroneously called the inherited method). If that were true, an EStreamError exception is raised saying "ClassName.Seek not implemented".
TOLEStream does override the 32bit version of Seek() to call IStream.Seek(). However, it does not override the TStream.GetSize() property getter. So when you are reading the OStrm.Size value before calling CopyFrom(), it calls the default TStream.GetSize() method, which uses Seek() to determine the stream size - Seek() to get the current position, then Seek() again to the end of the stream, saving the result, then Seek() again to go back to the previous position.
So, my guess would be that the IStream you have obtained likely does not support random seeking so its Seek() method is returning E_NOTIMPL, which TOLEStream.Seek() would detect and raise an EOleSysError exception saying "Not implemented".
Try calling IStream.Stat() to get the stream size (or derive a class from TOLEStream and override the GetSize() method to call Stat()), and then pass the returned size to CopyFrom() if > 0 (if you pass Count=0 to CopyFrom(), it will read the source stream's Position and Size properties, thus causing the same Seek() error), eg:
var
...
Stat: STATSTG;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
OleCheck(Strm.Stat(Stat, STATFLAG_NONAME));
if Stat.cbSize.QuadPart > 0 then
FStrm.CopyFrom(OStrm, Stat.cbSize.QuadPart);
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
The alternative would be to simply avoid TStream.CopyFrom() and manually copy the bytes yourself, by allocating a local buffer and then calling OStrm.Read() in a loop, writing each read buffer to FStrm, until OStrm.Read() reports that there is no more bytes to read:
var
...
Buf: array[0..1023] of Byte;
NumRead: Integer;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
repeat
NumRead := OStrm.Read(Buf[0], SizeOf(Buf));
if NumRead <= 0 then Break;
FStrm.WriteBuffer(Buf[0], NumRead);
until False;
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
I have a room with 60 computers/devices (40 computers and 20 oscilloscopes Windows CE based) and I would like to know which and every one is alive using ping. First I wrote a standard ping (see here Delphi Indy Ping Error 10040), which is working fine now but takes ages when most computers are offline.
So what I am trying to do is to write a MultiThread Ping but I am quite struggling with it. I have seen only very few examples over the internet and no one was matching my needs, that's why I try to write it myself.
I use XE2 and Indy 10 and the form is only constitued of a memo and a button.
unit Main;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Forms,
IdIcmpClient, IdGlobal, Vcl.StdCtrls, Vcl.Controls;
type
TMainForm = class(TForm)
Memo1: TMemo;
ButtonStartPing: TButton;
procedure ButtonStartPingClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TMyPingThread = class(TThread)
private
fIndex : integer;
fIdIcmpClient: TIdIcmpClient;
procedure doOnPingReply;
protected
procedure Execute; override;
public
constructor Create(index: integer);
end;
var
MainForm: TMainForm;
ThreadCOunt : integer;
implementation
{$R *.dfm}
constructor TMyPingThread.Create(index: integer);
begin
inherited Create(false);
fIndex := index;
fIdIcmpClient := TIdIcmpClient.Create(nil);
fIdIcmpClient.ReceiveTimeout := 200;
fIdIcmpClient.PacketSize := 24;
fIdIcmpClient.Protocol := 1;
fIdIcmpClient.IPVersion := Id_IPv4;
//first computer is at adresse 211
fIdIcmpClient.Host := '128.178.26.'+inttostr(211+index-1);
self.FreeOnTerminate := true;
end;
procedure TMyPingThread.doOnPingReply;
begin
MainForm.Memo1.lines.add(inttostr(findex)+' '+fIdIcmpClient.ReplyStatus.Msg);
dec(ThreadCount);
if ThreadCount = 0 then
MainForm.Memo1.lines.add('--- End ---');
end;
procedure TMyPingThread.Execute;
begin
inherited;
try
fIdIcmpClient.Ping('',findex);
except
end;
while not Terminated do
begin
if fIdIcmpClient.ReplyStatus.SequenceId = findex then Terminate;
end;
Synchronize(doOnPingReply);
fIdIcmpClient.Free;
end;
procedure TMainForm.ButtonStartPingClick(Sender: TObject);
var
i: integer;
myPing : TMyPingThread;
begin
Memo1.Lines.Clear;
ThreadCount := 0;
for i := 1 to 40 do
begin
inc(ThreadCount);
myPing := TMyPingThread.Create(i);
//sleep(10);
end;
end;
end.
My problem is that it "seems" to work when I uncomment the "sleep(10)", and "seems" not to be working without it. This for sure means I am missing a point in the threading I have written.
In other words. When Sleep(10) is in the code. Every time I clicked the button to get to check the connections the result was correct.
Without the sleep(10), it is working "most" of the time but some times the result is wrong giving me a ping echo on offline computers and no ping echo on online computer, as is the ping reply was not assigned to the correct thread.
Any comment or help is welcome.
----- EDIT / IMPORTANT -----
As a general follow up of this question, #Darian Miller started a Google Code project here https://code.google.com/p/delphi-stackoverflow/ which is a working basis. I mark his answer as the "accepted answer" but users should refer to this open source project (all the credit belongs to him) as it will surely be extended and updated in the future.
The root problem is that pings are connectionless traffic. If you have multiple TIdIcmpClient objects pinging the network at the same time, one TIdIcmpClient instance can receive a reply that actually belongs to another TIdIcmpClient instance. You are trying to account for that in your thread loop, by checking SequenceId values, but you are not taking into account that TIdIcmpClient already does that same check internally. It reads network replies in a loop until it receives the reply it is expecting, or until the ReceiveTimeout occurs. If it receives a reply it is not expecting, it simply discards that reply. So, if one TIdIcmpClient instance discards a reply that another TIdIcmpClient instance was expecting, that reply will not get processed by your code, and that other TIdIcmpClient will likely receive another TIdIcmpClient's reply instead, and so on. By adding the Sleep(), you are decreasing (but not eliminating) the chances that pings will overlap each other.
For what you are attempting to do, you won't be able to use TIdIcmpClient as-is to have multiple pings running in parallel, sorry. It is simply not designed for that. There is no way for it to differentiate reply data the way you need it. You will have to serialize your threads so only one thread can call TIdIcmpClient.Ping() at a time.
If serializing the pings is not an option for you, you can try copying portions of TIdIcmpClient's source code into your own code. Have 41 threads running - 40 device threads and 1 response thread. Create a single socket that all of the threads share. Have each device thread prepare and send its individual ping request to the network using that socket. Then have the response thread continuously reading replies from that same socket and routing them back to the appropriate device thread for processing. This is a bit more work, but it will give you the multiple-ping parallelism you are looking for.
If you don't want to go to all that trouble, an alternative is to just use a third-party app that already supports pinging multiple machines at the same time, like FREEPing.
Remy explained the problems... I've wanted to do this in Indy for a while so I posted a possible solution that I just put together to a new Google Code project instead of having a long comment here. It's a first-stab sort of thing, let me know if you have some changes to integrate:
https://code.google.com/p/delphi-vault/
This code has two ways to Ping...multi-threaded clients as in your example, or with a simple callback procedure. Written for Indy10 and later versions of Delphi.
Your code would end up using a TThreadedPing descendant defining a SynchronizedResponse method:
TMyPingThread = class(TThreadedPing)
protected
procedure SynchronizedResponse(const ReplyStatus:TReplyStatus); override;
end;
And to fire off some client threads, the code becomes something like:
procedure TfrmThreadedPingSample.butStartPingClick(Sender: TObject);
begin
TMyPingThread.Create('www.google.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.shouldnotresolvetoanythingatall.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.microsoft.com');
TMyPingThread.Create('127.0.0.1');
end;
The threaded response is called in a synchronized method:
procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;
I did not try your code, so that is all hypothetical, but i think you messed the threads and got classic race condition. I restate my advice to use AsyncCalls or OmniThreadLibrary - they are much simpler and would save you few attempts at "shooting your own foot".
Threads are made to minimize main-thread load. Thread constructor should do minimal work of remembering parameters. Personally i'd moved idICMP creation into .Execute method. If for any reason it would want to create its internal synchronization objects, like window and message queue or signal or whatever, i'd like it to happen already in a new spawned thread.
There is no sense for "inherited;" in .Execute. Better remove it.
Silencing all exceptions is bad style. You probably have errors - but have no way to know about them. You should propagate them to main thread and display them. OTL and AC help you in that, while for tThread you have to do it manually. How to Handle Exceptions thrown in AsyncCalls function without calling .Sync?
Exception logic is flawed. There is no point to have a loop if exception thrown - if no succesful Ping was set - then why waiting for response ? You loop should go within same try-except frame as issuing ping.
Your doOnPingReply executes AFTER fIdIcmpClient.Free yet accesses fIdIcmpClient's internals. Tried changing .Free for FreeAndNil ?
That is a classic mistake of using dead pointer after freeing it.
The correct approach would be to:
5.1. either free the object in doOnPingReply
5.2. or copy all relevant data from doOnPingReply to TThread's private member vars before calling both Synchronize and idICMP.Free (and only use those vars in doOnPingReply )
5.3. only do fIdIcmpClient.Free inside TMyThread.BeforeDestruction or TMyThread.Destroy. Afterall, if you chosen to create the object in constructor - then you should free it in the matching language construct - destructor.
Since you do not keep references to the thread objects - that While not Terminated loop seems redundant. Just make usual forever-loop and call break.
The aforementioned loop is CPU-hungry, it is like spin-loop. Please call Sleep(0); or Yield(); inside loop to give other threads better chance to do their work. Don't work agaisnt OS scheduler here - you are not in a speed-critical path, no reason to make spinlock here.
Overall, i consider:
4 and 5 as critical bugs for you
1 and 3 as a potential gotcha maybe influencing or maybe not. You'd better 'play safe' rather than doing risky things and investigating if they would work or not.
2 and 7 - bad style, 2 regarding language and 7 regarding platform
6 either you have plans to extend your app, or you broke YAGNI principle, dunno.
Sticking with complex TThread instead of OTL or AsyncCalls - strategic errors. Don't you put rooks on your runway, use simple tools.
Funny, this is example of the bug that FreeAndNil could expose and make obvious, while FreeAndNil-haters are claiming it "conceals" bugs.
// This is my communication unit witch works well, no need to know its work but your
// ask is in the TPingThread class.
UNIT UComm;
INTERFACE
USES
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms, Dialogs,
StdCtrls,IdIcmpClient, ComCtrls, DB, abcwav, SyncObjs, IdStack, IdException,
IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdContext,
UDM, UCommon;
TYPE
TNetworkState = (nsNone, nsLAN, nsNoLAN, nsNet, nsNoNet);
TDialerStatus = (dsNone, dsConnected, dsDisconnected, dsNotSync);
{ TBaseThread }
TBaseThread = Class(TThread)
Private
FEvent : THandle;
FEventOwned : Boolean;
Procedure ThreadTerminate(Sender: TObject); Virtual;
Public
Constructor Create(AEventName: String);
Property EventOwned: Boolean Read FEventOwned;
End;
.
.
.
{ TPingThread }
TPingThread = Class(TBaseThread)
Private
FReply : Boolean;
FTimeOut : Integer;
FcmpClient : TIdIcmpClient;
Procedure ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Protected
Procedure Execute; Override;
Procedure ThreadTerminate(Sender: TObject); Override;
Public
Constructor Create(AHostIP, AEventName: String; ATimeOut: Integer);
Property Reply: Boolean Read FReply;
End;
.
.
.
{ =============================================================================== }
IMPLEMENTATION
{$R *.dfm}
USES
TypInfo, WinSock, IdGlobal, UCounter, UGlobalInstance, URemoteDesktop;
{IdGlobal: For RawToBytes function 10/07/2013 04:18 }
{ TBaseThread }
//---------------------------------------------------------
Constructor TBaseThread.Create(AEventName: String);
Begin
SetLastError(NO_ERROR);
FEvent := CreateEvent(Nil, False, False, PChar(AEventName));
If GetLastError = ERROR_ALREADY_EXISTS
Then Begin
CloseHandle(FEvent);
FEventOwned := False;
End
Else If FEvent <> 0 Then
Begin
FEventOwned := True;
Inherited Create(True);
FreeOnTerminate := True;
OnTerminate := ThreadTerminate;
End;
End;
//---------------------------------------------------------
Procedure TBaseThread.ThreadTerminate(Sender: TObject);
Begin
CloseHandle(FEvent);
End;
{ TLANThread }
.
.
.
{ TPingThread }
//---------------------------------------------------------
Constructor TPingThread.Create(AHostIP: String; AEventName: String; ATimeOut: Integer);
Begin
Inherited Create(AEventName);
If Not EventOwned Then Exit;
FTimeOut := ATimeOut;
FcmpClient := TIdIcmpClient.Create(Nil);
With FcmpClient Do
Begin
Host := AHostIP;
ReceiveTimeOut := ATimeOut;
OnReply := ReplyEvent;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.Execute;
Begin
Try
FcmpClient.Ping;
FReply := FReply And (WaitForSingleObject(FEvent, FTimeOut) = WAIT_OBJECT_0);
Except
FReply := False;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Begin
With AReplyStatus Do
FReply := (ReplyStatusType = rsEcho) And (BytesReceived <> 0);
SetEvent(FEvent);
End;
//---------------------------------------------------------
Procedure TPingThread.ThreadTerminate(Sender: TObject);
Begin
FreeAndNil(FcmpClient);
Inherited;
End;
{ TNetThread }
.
.
.