How can I lookup DNS records with Indy in Delphi? For example, SRV records, SPF records, TEXT records, etc.
I know we can use nslookup directly from Windows, but I want to do this with Indy, or any other Delphi component.
I tried searching Google, and I found something like this:
function ReverseDNSLookup(IPAddress: String; DNSServer: String =
SDefaultDNS; Timeout: Integer = 30; Retries: Integer = 3) : string;
var
AIdDNSResolver: TIdDNSResolver;
RetryCount: Integer;
begin
Result := '';
IPAddress := ReverseIP(IPAddress);
AIdDNSResolver := TIdDNSResolver.Create(nil);
try
AIdDNSResolver.QueryResult.Clear;
AIdDNSResolver.WaitingTime := Timeout;
AIdDNSResolver.QueryType := [qtPTR];
AIdDNSResolver.Host := DNSServer;
RetryCount := Retries;
repeat
try
dec(RetryCount);
AIdDNSResolver.Resolve(IPAddress);
Break;
except
on e: Exception do
begin
if RetryCount <= 0 then
begin
// if SameText(e.Message, RSCodeQueryName) then
// Result := FALSE
// else
raise Exception.Create(e.Message);
Break;
end;
end;
end;
until false;
if AIdDNSResolver.QueryResult.Count > 0 then
Result := AIdDNSResolver.QueryResult.DomainName;
finally
FreeAndNil(AIdDNSResolver);
end;
end;
But all it is for is looking up IP addresses. I want SRV and TEXT records, and maybe SPF records.
TIdDNSResolver is what you are looking for. The example you show is only using a small subset of what TIdDNSResolver supports. You simply need to set the TIdDNSResolver.QueryType property to specify the type(s) of record(s) you want to query, and then loop through the TIdDNSResolver.QueryResult collection to access the individual records. TIdDNSResolver supports SRV and TXT records, for example:
var
DNS: TIdDNSResolver;
I: Integer;
Record: TResultRecord;
Txt: TTextRecord;
Srv: TSRVRecord;
begin
DNS := TIdDNSResolver.Create(nil);
try
DNS.WaitingTime := Timeout;
DNS.QueryType := [qtTXT, qtService];
DNS.Host := 'some.dns.server';
DNS.Resolve('some.hostname');
for I := 0 to DNS.QueryResult.Count -1 do
begin
Record := DNS.QueryResult[I];
case Record.RecType of
begin
qtTXT: begin
Txt := TTextRecord(Record);
// use Txt.Text as needed...
end;
qtService: begin
Srv := TSRVRecord(Record);
// use Srv.OriginalName, Srv.Service, Srv.Protocol, etc as needed...
end;
else
// something else...
end;
end;
finally
DNS.Free;
end;
end;
TIdDNSResolver does not support the SPF record type (code 99) that was defined in RFC 4408 in 2006:
This document defines a new DNS RR of type SPF, code 99. The format of this type is identical to the TXT RR [RFC1035]. For either type, the character content of the record is encoded as [US-ASCII].
It is recognized that the current practice (using a TXT record) is not optimal, but it is necessary because there are a number of DNS server and resolver implementations in common use that cannot handle the new RR type. The two-record-type scheme provides a forward path to the better solution of using an RR type reserved for this purpose.
That record type was later obsoleted by RFC 7208 in 2014:
SPF records MUST be published as a DNS TXT (type 16) Resource Record (RR) [RFC1035] only. The character content of the record is encoded as [US-ASCII]. Use of alternative DNS RR types was supported in SPF's experimental phase but has been discontinued.
In 2003, when SPF was first being developed, the requirements for assignment of a new DNS RR type were considerably more stringent than they are now. Additionally, support for easy deployment of new DNS RR types was not widely deployed in DNS servers and provisioning systems. As a result, developers of SPF found it easier and more practical to use the TXT RR type for SPF records.
In its review of [RFC4408], the SPFbis working group concluded that its dual RR type transition model was fundamentally flawed since it contained no common RR type that implementers were required to serve and required to check. Many alternatives were considered to resolve this issue, but ultimately the working group concluded that significant migration to the SPF RR type in the foreseeable future was very unlikely and that the best solution for resolving this interoperability issue was to drop support for the SPF RR type from SPF version 1. See Appendix A of [RFC6686] for further information.
The circumstances surrounding SPF's initial deployment a decade ago are unique. If a future update to SPF were developed that did not reuse existing SPF records, it could use the SPF RR type. SPF's use of the TXT RR type for structured data should in no way be taken as precedent for future protocol designers. Further discussion of design considerations when using new DNS RR types can be found in [RFC5507].
Related
Can someone help me understand how to make a REST POST request in HPCC? I've read through the documentation but I couldn't find any examples. Any help would be appreciated.
Here is an example of an HTTP POST that sends JSON content. It was a working example, but unfortunately the example service it calls no longer seems to be available.
The fact that is being provided to send, and the format specified is JSON it is what causes it to do a POST with JSON content.
Notice the format of the call matches closely with how SOAPCALL works but in this case will send and receive content as JSON. There is a JIRA open to get HTTPCALL POST added to the documentation, but in the meantime you can use the SOAPCALL documentation as a guideline for what additional options might be available. Most of the options you can add to a SOAPCALL can also be used with an HTTPCALL POST.
Also note that the "service name" is passed in as ''. Filling in the service name automatically adds another layer of JSON around the record that creates a JSON object named after that parameter. That's not usually what you want.
sendContent := RECORD
string name {XPATH('name')} := 'bob';
string salary {XPATH('salary')} := '22';
string age {XPATH('age')} := '105';
END;
receiveContent := RECORD
string name {XPATH('name')};
string salary {XPATH('salary')};
string age {XPATH('age')};
integer4 id {XPATH('id')};
END;
receiveRec := RECORD
string status {XPATH('status')};
receiveContent content {XPATH('data')};
END;
OUTPUT(HTTPCALL('https://dummy.restapiexample.com/api/v1/create', '', sendContent, DATASET(receiveRec), JSON, LOG));
HTTPCALL is a function that calls a REST service. Here is an example from the Language Reference Manual:
worldBankSource := RECORD
STRING name {XPATH('name')}
END;
OutRec1 := RECORD
DATASET(worldBankSource) Fred{XPATH('/source')};
END;
raw := HTTPCALL('http://api.worldbank.org/sources', 'GET', 'text/xml', OutRec1, );
OUTPUT(raw);
////Using HTTPHEADER to pass Authorization info
raw2 := HTTPCALL('http://api.worldbank.org/sources', 'GET', 'text/xml',
OutRec1, HTTPHEADER('Authorization','Basic
dXNlcm5hbWU6cGFzc3dvcmQ='),HTTPHEADER('MyLiteral','FOO'));
OUTPUT(raw2);
Hope this helps!
Bob
What I really want to do is have Inno Setup uninstall a component, if it's unchecked in a subsequent run. But, if I'm not mistaken, that is not possible in Inno Setup (actually, correct me, if I'm wrong on this).
So, instead I want to make check function to see if a component is installed, so I can hide it during subsequent runs. I'm not sure where else to get that info other than the Inno Setup: Selected Components under HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\[AppName]_is1.
Now the problem is my Inno Setup: Selected Components is as,as2,as3,bs,bs2,bs3.
How can I detect as, without detecting as2 or as3?
Indeed, Inno Setup does not support uninstalling components.
For a similar question (and maybe better), see:
Inno Setup: Disable already installed components on upgrade
For checking of installed components, I'd rather suggest you to check for existence of files corresponding to the component.
Anyway, to answer your actual question: If you want to scan the Inno Setup: Selected Components entry, you can use this function:
function ItemExistsInList(Item: string; List: string): Boolean;
var
S: string;
P: Integer;
begin
Result := False;
while (not Result) and (List <> '') do
begin
P := Pos(',', List);
if P > 0 then
begin
S := Copy(List, 1, P - 1);
Delete(List, 1, P);
end
else
begin
S := List;
List := '';
end;
Result := (CompareText(S, Item) = 0);
end;
end;
Note that the uninstall key can be present in HKCU (not in HKLM) under certain circumstances.
I want to copy many files in one, but using multiThread,supposing that file A is the file in which different threads copy datas, in this case each thread is meant to copy one file in file A, using this procedure:
procedure ConcatenateFiles(const InFileNames: array of string;
const OutFileName: string);
var
i: Integer;
InStream, OutStream: TFileStream;
begin
OutStream := TFileStream.Create(OutFileName, fmCreate);
try
for i := 0 to high(InFileNames) do
begin
InStream := TFileStream.Create(InFileNames[i], fmOpenRead);
try
OutStream.CopyFrom(InStream, InStream.Size);
finally
InStream.Free;
end;
end;
finally
OutStream.Free;
end;
end;
First, is it possible to realise multithread copy files in this case, because OutFileName is a global variable, two threads can't use it at the same time, and this is the error that i get,
if this is possible how can I synchronise threads to avoid the use of OutFileName by more than one processus in a moment?
And is it really efficient to make a multithread copy files, I'm talking about the speed of copying files.
thanks for your replies
It's perfectly possible to copy files using multiple threads. You would typically use a single producer thread and multiple consumers to do the work. In your case you are concatenating. So you'd need to work out the start and end point of each source file, and then get the threads to write separate parts of the destination file at the pre-calculated positions. Certainly possible.
However, it's not a good idea idea. Multiple threading works well when the job is CPU bound. File copying is disk bound and no amount of extra threads can help. In fact you will likely end up making performance worse because the multiple threads will just get in each others way whilst fighting over the shared disk resource.
If you want to concatenate multiple input files in parallel into a single destination file, you can do it this way:
pre-allocate the destination file. Create the file, seek to the intended final concatenated file size, and set EOF to allocate the file on the file system. With a TFileStream, this can be accomplished by simply setting the TFileStream.Size property to the intended size. Otherwise, using the Win32 API directly, you would have to use CreateFile(), SetFilePointer(), and SetEndOfFile().
Divide up the destination file into logical sections, each with a starting and ending offset within the file, and assign those sections to your threads as needed. Have each thread open its own local handle to the same destination file. That will allow each thread to seek and write independently. Make sure each thread does not leave its assigned section so it does not corrupt another thread's written data.
For example:
type
TFileInfo = record
InFileName: String;
OutFileName: String;
OutFileStart: Int64;
OutFileSize: Int64;
end;
TCopyThread = class(TThread)
protected
FFileInfo: TFileInfo;
procedure Execute;
public
constructor Create(const AFileInfo: TFileInfo);
end;
constructor TCopyThread.Create(const AFileInfo: TFileInfo);
begin
inherited Create(False);
FFileInfo := AFileInfo;
end;
procedure TCopyThread.Execute;
var
InStream: TFileStream;
OutStream: TFileStream;
begin
InStream := TFileStream.Create(FFileInfo.InFileName, fmOpenRead or fmShareDenyWrite);
try
OutStream := TFileStream.Create(FFileInfo.OutFileName, fmOpenWrite or fmShareDenyNone);
try
OutStream.Position := FFileInfo.OutFileStart;
OutStream.CopyFrom(InStream, FFileInfo.OutFileSize);
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
end;
procedure ConcatenateFiles(const InFileNames: array of string; const OutFileName: string);
var
i: Integer;
OutStream: TFileStream;
FileInfo: array of TFileInfo;
TotalSize: Int64;
sr: TSearchRec;
Threads: array of TCopyThread;
ThreadHandles: array of THandle;
NumThreads: Integer;
begin
SetLength(FileInfo, Length(InFileNames));
NumThreads := 0;
TotalSize := 0;
for i := 0 to High(InFileNames) do
begin
if FindFirst(InFileNames[i], faAnyFile, sr) <> 0 then
raise Exception.CreateFmt('Cannot retrieve size of file: %s', [InFileNames[i]]);
if sr.Size > 0 then
begin
FileInfo[NumThreads].InFileName := InFileNames[i];
FileInfo[NumThreads].OutFileName := OutFileName;
FileInfo[NumThreads].OutFileStart := TotalSize;
FileInfo[NumThreads].OutFileSize := sr.Size;
Inc(NumThreads);
Inc(TotalSize, sr.Size);
end;
FindClose(sr);
end;
OutStream := TFileStream.Create(OutFileName, fmCreate);
try
OutStream.Size := TotalSize;
finally
OutStream.Free;
end;
SetLength(Threads, NumThreads);
SetLength(ThreadHandles, NumThreads);
for i := 0 to NumThreads-1 do
begin
Threads[i] := TCopyThread.Create(FileInfo[i]);
ThreadHandles[i] := Threads[i].Handle;
end;
i := 0;
while i < NumThreads do
begin
WaitForMultipleObjects(Min(NumThreads-i, MAXIMUM_WAIT_OBJECTS), ThreadHandles[i], TRUE, INFINITE);
Inc(i, MAXIMUM_WAIT_OBJECTS);
end;
for i := 0 to NumThreads-1 do
begin
Threads[i].Terminate;
Threads[i].WaitFor;
Threads[i].Free;
end;
end;
As it was mentioned already writing to same file from multiple threads is not so good idea.
If you try doing it in a way that multiple threads share same file handle you end up with big problem of making sure that one thread doesent move file position using Seek command while other one is trying to write some data.
If you try doing it in a way that each thread creates its own handle to the file then you end up with the problem that OS doesen't generally alow having multiple file handles with writing capability simuntaniously as this can be recipie for disaster (data coruption).
Now even if you somehow manage to get this working so that each tread is writing in its own section of the file and that they are not messing with each other you will still be losing some performance due to hard drive limitation (HDD head needs to be repositioned into corect place - lots of back and forth movment).
Hey but you could use miltiple threads to go and prepare the final file inside your memory before it is being written on your hard drive. This can be easily done since memory acces is so fast that you practically don't lose any pefrormance by jumping back and forth. The only problem with this is that you could quickly run out of memory if you are concating several larger files.
EDIT: BTW if you are interested I could share a code example of two threaded double-buffered file copy example that I made several years ago. Note it does not provide any data verification capabilities as it was only written to test a theory or shoud I say break a theory that it isn't possible to copy a file only with Delphi (without uising file copy API from Windows). When doing file copy on same HDD it is a bit slower than built in Windows routine but when copying from one HDD to another it reaches same speed as windows built in routines.
I create a thread
type
ss_thread = class;
ss_thread = class(TThread)
protected
Fff_id : string;
Fff_cmd : string;
Fff_host : string;
Fff_port : TIdPort;
procedure Execute; override;
public
constructor Create(const ff_id, ff_cmd: string; ff_host: string; ff_port: TIdPort);
end;
constructor ss_thread.Create(const ff_id, ff_cmd: string; ff_host: string; ff_port: TIdPort);
begin
inherited Create(False);
Fff_id := ff_id;
Fff_cmd := ff_cmd;
Fff_host := ff_host;
Fff_port := ff_port;
end;
...
id := 123;
...
nst_ss_thread.Create(id, cmd, host, port);
and doing something on
procedure ss_thread.Execute;
var
ws : TIdTCPClient;
data : TIdBytes;
i : integer;
list : TList;
begin
ws := TIdTCPClient.Create(nil);
ws.Host := Fff_host;
ws.Port := Fff_port;
....
How to access this thread 'ws' variable thru another thread using id:=123 of thread ?
Thanks
It cannot.
You've declared ws as a local variable inside ss_thread.execute, which means it's only visible there. It can't be seen outside ss_thread.execute, even by other parts of ss_thread.
If you want it visible from other places or threads, you need to move it to a more visible scope. For instance, if you want it visible from other places in ss_thread, move it to the interface declaration in private or protected sections, and if you want it visible from outside ss_thread move it to the published or public sections.
You'd better not. Thread objects are exactly made to insulate its variables from other threads.
Otherwise all kind of random non-reproducible errors would appear - http://en.wikipedia.org/wiki/Heisenbug
Parallel programming should have very clear separation and insulation. Because You can never predict the timing of execution and which statement would run earlier and which one later.
Imagine that easy scenario:
ws := TIdTCPClient.Create(nil);
ws.Host := Fff_host;
// at this point another thread gets access to ws variable,
// as You demanded - and changes it, so WS gets another value!
ws.Port := Fff_port;
How would you detect such a bug, if it happens only on client multi-processor computer under heavy load once a month ? In your workstation during debug sessions or simulation it would not be reproduced ever! How would you catch it and fix ?
As a rule of thumb, when doing parallel programming the data should be spleat into "shared immutable" and "private mutable" pieces, and when doing inter-thread communication you should - similar to inter-process communications - make some events/messages queue and pass commands and replies to/from threads, like it is done in Windows GDI or like in MPI
Then you thread would fetch "change ws variable" command from queue - in the proper moment when the change is allowed - and change it from inside. Thus you would assume control and assure that variables are only changed in that point and in that manner, that would not derail the code flow.
I suggest you to read OTL examples to see how inter-thread communication is done in more safe way that direct access to objects. http://otl.17slon.com/tutorials.htm
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 }
.
.
.