I have an app written in Delphi 2006 that regularly reads from a disk file located elsewhere on a network (100Mb ethernet). Occasionally the read over the network takes a very long time (like 20 secs) and the app freezes, as the read is done from an idle handler in the main thread.
OK, I could put the read operation into it's own thread, but what I would like to know is whether it is possible to specify a timeout for a file operation, so that you can give up and go and do something else, or report the fact that the read has snagged a bit earlier than 20 seconds later.
function ReadWithTimeout (var Buffer ;
N : integer ;
Timeout : integer) : boolean ;
begin
Result := false
try
SetReadTimeout (Timeout) ; // <==========================???
FileStream.Read (Buffer, N) ;
Result := true ;
except
...
end ;
end ;
Open the file for asynchronous access by including the File_Flag_Overlapped flag when you call CreateFile. Pass in a TOverlapped record when you call ReadFile, and if the read doesn't complete immediately, the function will return early. You can control how long you wait for the read to complete by calling WaitForSingleObject on the event you store in the TOverlapped structure. You can even use MsgWaitForMultipleObjects to wait; then you can be notified as soon as the read completes or a message arrives, whichever comes first, so your program doesn't need to hang at all. After you finish processing messages, you can check again whether the I/O is complete with GetOverlappedResult, resume waiting, or give up on the I/O by calling CancelIo. Make sure you read the documentation for all those functions carefully; asynchronous I/O isn't trivial.
After you've moved the read operation to a thread, you could store the value returned by timeGetTime before reading:
isReading := true;
try
startedAt := timeGetTime;
FileStream.Read (Buffer, N);
...
finally
isReading := false;
end;
and check in the idle handler if it's taken too long.
eg:
function ticksElapsed( FromTicks, ToTicks : cardinal ) : cardinal;
begin
if FromTicks < ToTicks
then Result := ToTicks - FromTicks
else Result := ( high(cardinal) - FromTicks ) + ToTicks; // There was a wraparound
end;
...
if isReading and ( ticksElapsed( startedAt, timeGetTime ) > 10 * 1000 ) // Taken too long? ~10s
then // Do something
Related
In the example below (from Embarcadero's manual), the MyValue will be retrieved after 3 seconds about. But, the main gui thread would be blocked by the MyValue := FutureObject.Value; call which will wait for the result.
If the Future code will take long, lets say 30 seconds, Windows will show a "... not responding" in the programs caption I guess.
So whats the purpose of this when it will block the main gui thread?
Is there any other way to get the result without blocking the main gui thread?
FutureObject := TTask.Future<Integer>(function: Integer
begin
Sleep(3000);
Result := 16;
end);
// …
MyValue := FutureObject.Value;
By design, the IFuture.Value property blocks the calling thread until another thread assigns a value. So, if you read Value in the main thread, it is going to block the main thread until a value is ready.
If you must read Value in the main thread without blocking, you can either:
use a timer or other asynchronous mechanism to periodically query the IFuture.Status property to check when the IFuture is ready to provide a value before actually reading it.
have the parallel task signal the main thread when it is ready, and then the main thread can read the Value in its signal handler.
I know it might be a bit late but i solved it by creating a TTask that did the
MyValue := FutureObject.Value
FutureObject := TTask.Future<Integer>(function: Integer
begin
Sleep(3000);
Result := 16;
end);
// …
TTask.Run(Procedure begin
MyValue := FutureObject.Value;
end);
I have 2 apps, program.exe and updater.exe, both written in Delphi5.
Program runs without admin-rights (and without manifest), updater has a manifest with "requireAdministrator" because he must be able to write at Program-Folder to update program.exe.
The problem is to launch updater and let him wait until program is closed.
I've found different ways at the web, but none works (in most cases the 1st app starts 2nd app and wait for ending of 2nd app, in my case 2nd app should wait for ending of 1nd app).
Updater should wait, thats easy
updater.exe
{$R manifest.res}
label.caption:='Wait for program.exe closing';
repeat
sleep(1000);
until File is not open
ProgramHandle := Read Handle from File
WaitForSingleObject(ProgramHandle,INFINITE);
label.caption:='program.exe CLOSED';
Do updates
Way 1
Starting updater with CreateProcess:
program.exe
FillChar(siInfo, SizeOf(siInfo), 0);
siInfo.cb := SizeOf(siInfo);
saProcessAttributes.nLength := SizeOf(saProcessAttributes);
saProcessAttributes.lpSecurityDescriptor := nil;
saProcessAttributes.bInheritHandle := TRUE;
saThreadAttributes.nLength := SizeOf(saThreadAttributes);
saThreadAttributes.lpSecurityDescriptor := nil;
saThreadAttributes.bInheritHandle := True;
if CreateProcess(nil,
PChar('updater.exe'),
#saProcessAttributes,
#saThreadAttributes,
TRUE, NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(Application.ExeName)),
siInfo, piInfo) then
begin
DuplicateHandle(GetCurrentProcess, GetCurrentProcess,
piInfo.hProcess, #MyHandle,
PROCESS_QUERY_INFORMATION, TRUE,
DUPLICATE_SAME_ACCESS) then
Write MyHandle in a File
end;
Close program
Doesn't do anything, works only when updater has no manifest with requireAdministrator into.
If i run program with explizit admin-rights, it works too.
Way 2
Starting updater with ShellExecuteEx:
program.exe
FillChar(Info, SizeOf(Info), Chr(0));
Info.cbSize := SizeOf(Info);
Info.fMask := SEE_MASK_NOCLOSEPROCESS;
Info.lpVerb := PChar('runas');
Info.lpFile := PChar('update.exe');
Info.lpDirectory := nil;
Info.nShow := SW_RESTORE;
ShellExecuteEx(#Info);
MyHandle:=OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessId())));
Write MyHandle in a File
Close program
Doesnt' work, MyHandle has a different value each time i run this procedure (without restarting the program), so updater can't work with it.
So i have no idea how to start updater.exe and write the handle of program.exe in the file.
Im not very familiar with these parts of programing ... does somebody has an idea for my proplem?
Your code is not working because the handle table is per process, which means that the second process could have the same handle pointing to another kernel object. Below, there is one of many possible solutions:
When creating the process 2, pass the PID of the process 1 as parameter:
procedure CreateUpdater;
var
Info: TShellExecuteInfo;
begin
FillChar(Info, SizeOf(TShellExecuteInfo), 0);
Info.cbSize := SizeOf(TShellExecuteInfo);
Info.fMask := SEE_MASK_NOCLOSEPROCESS;
Info.lpVerb := PChar('runas');
Info.lpFile := PChar('Update.exe');
Info.lpParameters := PChar(IntToStr(GetCurrentProcessId));
Info.lpDirectory := nil;
Info.nShow := SW_RESTORE;
ShellExecuteEx(#Info);
//NOTE: MISSING ERROR CHECKING!
end;
Inside the Updater, wait for the process1 to terminate:
procedure WaitForAndClose;
var
PID: String;
AHandle: Cardinal;
Ret: longbool;
ExitNumber: DWORD;
begin
PID:= ParamStr(1);
if PID <> '' then
begin
AHandle:= OpenProcess(PROCESS_QUERY_INFORMATION, False, StrToInt(PID));
//NOTE: MISSING ERROR CHECKING!
try
repeat
Ret:= GetExitCodeProcess(AHandle, ExitNumber);
//NOTE: MISSING ERROR CHECKING!
Sleep(1000); //define a time to poolling
until (ExitNumber <> STILL_ACTIVE);
finally
CloseHandle(AHandle);
end;
//Terminate the process;
Application.Terminate;
end;
end;
You can also use WaitForSingleObject to avoid polling:
WaitForSingleObject(AHandle, INFINITE);
//NOTE: MISSING ERROR CHECKING!
But you need the SYNCHRONIZE access to open the process:
AHandle:= OpenProcess(SYNCHRONIZE, False, StrToInt(PID));
//NOTE: MISSING ERROR CHECKING!
Note: There is no error checking here. You should read the docs and properly check for errors.
Note 2: I would like to get your attention to the fact you are leaking a handle.
When you use SEE_MASK_NOCLOSEPROCESS the caller is responsible to close the handle of the calee. In your case I think you don't need that mask at all. I would remove it.
Here is a basic example of how to achieve this using events:
program.exe:
// manual-reset event, non-signaled
Event := CreateEvent(nil, True, False, 'MyUniqueName');
ExecuteUpdater; // via ShellExecuteEx with runas
// synchronize - wait for the event to be signaled
WaitForSingleObject(Event, INFINITE);
// WAIT_OBJECT_0 = The state of the specified object is signaled.
CloseHandle(Event);
updater.exe:
Event := CreateEvent(nil, True, False, 'MyUniqueName');
if Event = 0 then RaiseLastWin32Error;
SetEvent(Event); // sets the event object to the signaled state
CloseHandle(Event);
You should also add a manifest to program.exe (requestedExecutionLevel should be level="asInvoker") to avoid virtualization.
I see the main problem there in indeterminate order of two events: closing of the program and starting of the updater main code.
One possible way to fix it would be using Events - https://msdn.microsoft.com/ru-ru/library/windows/desktop/ms686670(v=vs.85).aspx
The program creates the Event (with an option for the children to inherit it), then launches the updater (passing handles of both the Event and the program's process as integers via the command line to it !), then freezes in WaitForSingleObject on the Event.
This ensures the program would not exit before the updater would be ready to monitor it, so PID would not get invalid.
The updater then calls OpenProcess on the program's PID gained from the command line, then calls SignalAndWait both knocking the Event (gained from the command line) and freezing upon the handle (gained from OpenProcess) - https://msdn.microsoft.com/ru-ru/library/windows/desktop/ms686293(v=vs.85).aspx
The program, now being released from waiting upon Event, terminates.
The termination of the process is signalling it, so now the updater gets released in turn and can start doing the main work.
Another approach suggested at C++, How to determine if a Windows Process is running? is querying the exit code of the program ProcessID - it is said that while the program is still running there would be a specific error code and you can Sleep(100) then try again. Any other result means the program already had finished.
The program exits immediately after launching the updater without waiting for it to starting monitoring.
This seems nice approach except that I do not now any warranty that PID values would not be reused. Chances are infinitesimal, but still not zero.
Personally I would probably use a flag file. The CreateFile API has a very interesting flag - the temporary-file mode. It means, Windows would automatically delete the file after process ends. So then
The program creates a new GUID using Windows API (or a new Random Value using Crypto API).
The program creates in the temporary files folder the temporary-mode file with the name based upon the GUID or the Random value. If by any wild luck such a file already exist - you just obtain a new GUID or Random value.
The program launches the updater and passes the filename to it via the command line
The program exits immediately after launching the updater without waiting for it to starting monitoring.
The updater keeps checking if the file exists (making pauses between attempts). When the file does not more exist - that means the program had finished and Windows auto-deleted it.
Again, there is an infinitesimal chance that some other process would create the flag file with exactly the same name in-between the program terminates and the updater checks again, but that is next to impossible in practice
I am developing a single thread app with Delphi, which will do a time-consuming task, like this:
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
End;
When the loop starts, the application will lose responses to the end user. That is not very good. I also do not want to convert it into a multi-thread application because of its complexity, so I add Application.ProcessMessages accordingly,
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
Application.ProcessMessages;
End;
However, this time although the application will response to user operations, the time-consumed in the loop is much more than the original loop, about 10 times.
Is there a solution to make sure the application does not lose the response while do not increase the consumed time too much?
You really should use a worker thread. This is what threads are good for.
Using Application.ProcessMessages() is a band-aid, not a solution. Your app will still be unresponsive while DoTask() is doing its work, unless you litter DoTask() with additional calls to Application.ProcessMessages(). Plus, calling Application.ProcessMessages() directly introduces reentrant issues if you are not careful.
If you must call Application.ProcessMessages() directly, then don't call it unless there are messages actually waiting to be processed. You can use the Win32 API GetQueueStatus() function to detect that condition, for example:
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
if GetQueueStatus(QS_ALLINPUT) <> 0 then
Application.ProcessMessages;
End;
Otherwise, move the DoTask() loop into a thread (yeah yeah) and then have your main
loop use MsgWaitForMultipleObjects() to wait for the task thread to finish.
That still allows you to detect when to process messages, eg:
procedure TMyTaskThread.Execute;
begin
// time-consuming loop
for I := 0 to 1024 * 65536 do
begin
if Terminated then Exit;
DoTask();
end;
end;
var
MyThread: TMyTaskThread;
Ret: DWORD;
begin
...
MyThread := TMyTaskThread.Create;
repeat
Ret := MsgWaitForMultipleObjects(1, Thread.Handle, FALSE, INFINITE, QS_ALLINPUT);
if (Ret = WAIT_OBJECT_0) or (Ret = WAIT_FAILED) then Break;
if Ret = (WAIT_OBJECT_0+1) then Application.ProcessMessages;
until False;
MyThread.Terminate;
MyThread.WaitFor;
MyThread.Free;
...
end;
You say :
I also do not want to convert it into a multi-thread application
because of its complexity
I can take this to mean one of two things :
Your application is a sprawling mess of legacy code that is so huge and so badly written that encapsulating DoTask in a thread would mean an enormous amount of refactoring for which a viable business case cannot be made.
You feel that writing multithreaded code is too "complex" and you don't want to learn how to do it.
If the case is #2 then there is no excuse whatsoever - multithreading is the clear answer to this problem. It's not so scary to roll a method into a thread and you'll become a better developer for learning how to do it.
If the case is #1, and I leave this to you to decide, then I'll note that for the duration of the loop you will be calling Application.ProcessMessages 67 million times with this :
For I := 0 to 1024 * 65536 do
Begin
DoTask();
Application.ProcessMessages;
End;
The typical way that this crime is covered up is simply by not calling Application.ProcessMessages every time you run through the loop.
For I := 0 to 1024 * 65536 do
Begin
DoTask();
if I mod 1024 = 0 then Application.ProcessMessages;
End;
But if Application.ProcessMessages is actually taking ten times longer than DoTask() to execute then I really question how complex DoTask really is and whether it really is such a hard job to refactor it into a thread. If you fix this with ProcessMessages, you really should consider it a temporary solution.
Especially take care that using ProcessMessages means that you must make sure that all of your message handlers are re-entrant.
Application.ProcessMessages should be avoided. It can cause all sorts of strange things to your program. A must read: The Dark Side of Application.ProcessMessages in Delphi Applications.
In your case a thread is the solution, even though DoTask() may have to be refactored a bit to run in a thread.
Here is a simple example using an anonymous thread. (Requires Delphi-XE or newer).
uses
System.Classes;
procedure TForm1.MyButtonClick( Sender : TObject);
var
aThread : TThread;
begin
aThread :=
TThread.CreateAnonymousThread(
procedure
var
I: Integer;
begin
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
if TThread.CurrentThread.CheckTerminated then
Break;
DoTask();
End;
end
);
// Define a terminate thread event call
aThread.OnTerminate := Self.TaskTerminated;
aThread.Start;
// Thread is self freed on terminate by default
end;
procedure TForm1.TaskTerminated(Sender : TObject);
begin
// Thread is ready, inform the user
end;
The thread is self destroyed, and you can add a OnTerminate call to a method in your form.
Calling Application.ProcessMessages at every iteration will indeed slow down performance, and calling it every few times doesn't always work well if you can't predict how long each iteration will take, so I typically will use GetTickCount to time when 100 milliseconds have passed (1). This is long enough to not slow down performance too much, and fast enough to make the application appear responsive.
var
tc:cardinal;
begin
tc:=GetTickCount;
while something do
begin
if cardinal(GetTickCount-tc)>=100 then
begin
Application.ProcessMessages;
tc:=GetTickCount;
end;
DoSomething;
end;
end;
(1): not exactly 100 milliseconds, but somewhere close. There are more precise ways to measure time like QueryPerformanceTimer, but again this is more work and may hinder performance.
#user2704265, when you mention “application will lose responses to the end user”, do you mean that you want your user to continue working around in your application clicking and typing away? In that case - heed the previous answers and use threading.
If it’s good enough to provide feedback that your application is busy with a lengthy operation [and hasn't frozen] there are some options you can consider:
Dissable user input
Change the cursor to “busy”
Use a progressbar
Add a cancel button
Abiding to your request for a single threaded solution I recommend you start by disabling user input and change the cursor to “busy”.
procedure TForm1.ButtonDoLengthyTaskClick(Sender: TObject);
var i, j : integer;
begin
Screen.Cursor := crHourGlass;
//Disable user input capabilities
ButtonDoLengthyTask.Enabled := false;
Try
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
// Calling Processmessages marginally increases the process time
// If we don't call and user clicks the disabled button while waiting then
// at the end of ButtonDoLengthyTaskClick the proc will be called again
// doubling the execution time.
Application.ProcessMessages;
End;
Finally
Screen.Cursor := crDefault;
ButtonDoLengthyTask.Enabled := true;
End;
End;
I have an application written in Delphi 6 that uses the Indy 9.0.18 HTTP client component to drive a robot. If I recall correctly when I did the Indy install, version 10 and newer does not work with Delphi 6 so I am using 9.0.18. On newer desktops the program runs completely fine. But I am having some problems on older laptops. Note in all case I am getting absolutely no errors or Exceptions.
The robot is an HTTP server that responds to HTTP requests to drive it. To obtain continuous motion, you have to send a drive command (e.g. - move forward) in a continuous loop. A drive command is an HTTP request to the numeric IP address the robot responds to, no domain name is involved with the URL used in the request so that rules out domain name resolution as a problem (I believe). Once you get the response from the last HTTP request, you turn around immediately and send the next one. You can tell when a system is having trouble keeping up with the loop because the robot makes small jerky moves, never able to reach the continuous momentum needed for smooth motion because the motors have time to settle down and stop.
The two systems that are having trouble are laptop computers and have the following CPU and memory and are running Windows XP SP3:
AMD Turion 64 X2 Mobile technology TL-50 (dual core), 1 GB of main memory, 1.6 GHz, dual core.
AMD Sempron(tm) 140 Processor, 1 GB main memory, 2.7 GHZ. Note, this CPU is a dual core but only one core is enabled.
Both of these systems can not obtain smooth motion except transiently as indicated below.
The reason I say it's a laptop problem is because the two systems above are laptops. In contrast, I have an old Pentium 4 single core with Hyperthreading (2.8 GHz, 2.5 GB of memory). It can obtain smooth motion. However, although continuous the robot moves noticeably slower indicating that there's still a slight delay between the HTTP requests, but not enough to completely stop the motors and therefore the motion is still continuous, albeit noticeably slower than on my quad core or a dual core desktop.
I am aware that the other discriminant in the data points is that the old Pentium 4 desktop has 2.5 times memory over the laptops, despite being a nearly archaic PC. Perhaps the real culprit is some memory thrashing? Every now and then the robot does run smoothly but soon reverts back to stuttering again, indicating that without whatever is mucking up the interaction over the socket, smooth motion is occasionally possible. Note, the robot is also streaming audio both ways to and from the PC and streaming video to the PC (but not the other direction), so there's a fair amount of processing going on along with driving the robot.
The Indy HTTP client is created and runs on a background thread, not on the main Delphi thread, in a tight loop with no sleep states. It does do a PeekMessage() call in the loop to see if any new commands have come in that should be looped instead of the currently looping one. The reason for the GetMessage() call in the loop is so that the thread blocks when the robot is supposed to be idle, that is, no HTTP requests should be sent to it until the user decides to drive it again. In that case, posting a new command to the thread unblocks the GetMessage() call and the new command is looped.
I tried raising the thread priority to THREAD_PRIORITY_TIME_CRITICAL but that had absolutely zero effect. Note I did use GetThreadPriority() to make sure the priority was indeed raised and it returned a value of 15 after initially returning 0 before the SetThreadPriority() call.
1) So what can I do to improve the performance on these older low power systems, since several of my best users have them?
2) The other question I have is does anyone know if Indy has to rebuild the connection each HTTP request or does it cache the socket connection intelligently so that would not be the problem? Would it make a difference if I resorted to using a lower level Indy client socket and did the HTTP request crafting myself? I'd like to avoid that possibility since it would be a significant rewrite, but if that's a high certainty solution, let me know.
I have included the loop for the background thread below in case you can see anything inefficient. Commands to be executed are posted to the thread via an asynchronous PostThreadMessage() operation from the main thread.
// Does the actual post to the robot.
function doPost(
commandName, // The robot command (used for reporting purposes)
// commandString, // The robot command string (used for reporting purposes)
URL, // The URL to POST to.
userName, // The user name to use in authenticating.
password, // The password to use.
strPostData // The string containing the POST data.
: string): string;
var
RBody: TStringStream;
bRaiseException: boolean;
theSubstituteAuthLine: string;
begin
try
RBody := TStringStream.Create(strPostData);
// Custom HTTP request headers.
FIdHTTPClient.Request.CustomHeaders := TIdHeaderList.Create;
try
FIdHTTPClient.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
FIdHTTPClient.Request.ContentType := 'application/xml';
FIdHTTPClient.Request.ContentEncoding := 'utf-8';
FIdHTTPClient.Request.CacheControl := 'no-cache';
FIdHTTPClient.Request.UserAgent := 'RobotCommand';
FIdHTTPClient.Request.CustomHeaders.Add('Connection: keep-alive');
FIdHTTPClient.Request.CustomHeaders.Add('Keep-Alive: timeout=30, max=3 header');
// Create the correct authorization line for the commands stream server.
theSubstituteAuthLine :=
basicAuthenticationHeaderLine(userName, password);
FIdHTTPClient.Request.CustomHeaders.Add(theSubstituteAuthLine);
Result := FIdHTTPClient.Post(URL, RBody);
// Let the owner component know the HTTP operation
// completed, whether the response code was
// successful or not. Return the response code in the long
// parameter.
PostMessageWithUserDataIntf(
FOwner.winHandleStable,
WM_HTTP_OPERATION_FINISHED,
POSTMESSAGEUSERDATA_LPARAM_IS_INTF,
TRovioCommandIsFinished.Create(
FIdHttpClient.responseCode,
commandName,
strPostData,
FIdHttpClient.ResponseText)
);
finally
FreeAndNil(RBody);
end; // try/finally
except
{
Exceptions that occur during an HTTP operation should not
break the Execute() loop. That would render this thread
inactive. Instead, call the background Exception handler
and only raise an Exception if requested.
}
On E: Exception do
begin
// Default is to raise an Exception. The background
// Exception event handler, if one exists, can
// override this by setting bRaiseException to
// FALSE.
bRaiseException := true;
FOwner.doBgException(E, bRaiseException);
if bRaiseException then
// Ok, raise it as requested.
raise;
end; // On E: Exception do
end; // try/except
end;
// The background thread's Excecute() method and loop (excerpted).
procedure TClientThread_roviosendcmd_.Execute;
var
errMsg: string;
MsgRec : TMsg;
theHttpCliName: string;
intfCommandTodo, intfNewCommandTodo: IRovioSendCommandsTodo_indy;
bSendResultNotification: boolean;
responseBody, S: string;
dwPriority: DWORD;
begin
// Clear the current command todo and the busy flag.
intfCommandTodo := nil;
FOwner.isBusy := false;
intfNewCommandTodo := nil;
// -------- BEGIN: THREAD PRIORITY SETTING ------------
dwPriority := GetThreadPriority(GetCurrentThread);
{$IFDEF THREADDEBUG}
OutputDebugString(PChar(
Format('Current thread priority for the the send-commands background thread: %d', [dwPriority])
));
{$ENDIF}
// On single CPU systems like our Dell laptop, the system appears
// to have trouble executing smooth motion. Guessing that
// the thread keeps getting interrupted. Raising the thread priority
// to time critical to see if that helps.
if not SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL) then
RaiseLastOSError;
dwPriority := GetThreadPriority(GetCurrentThread);
{$IFDEF THREADDEBUG}
OutputDebugString(PChar(
Format('New thread priority for the the send-commands background thread after SetThreadPriority() call: %d', [dwPriority])
));
{$ENDIF}
// -------- END : THREAD PRIORITY SETTING ------------
// try
// Create the client Indy HTTP component.
theHttpCliName := '(unassigned)';
theHttpCliName := FOwner.Name + '_idhttpcli';
// 1-24-2012: Added empty component name check.
if theHttpCliName = '' then
raise Exception.Create('(TClientThread_roviosendcmd_.Execute) The client HTTP object is nameless.');
FIdHTTPClient := TIdHTTP.Create(nil);
{ If GetMessage retrieves the WM_QUIT, the return value is FALSE and }
{ the message loop is broken. }
while not Application.Terminated do
begin
try
bSendResultNotification := false;
// Reset the variable that detects new commands to do.
intfNewCommandTodo := nil;
{
If we are repeating a command, use PeekMessage so that if
there is nothing in the queue, we do not block and go
on repeating the command. Note, intfCommandTodo
becomes NIL after we execute a single-shot command.
If we are not repeating a command, use GetMessage so
it will block until there is something to do or we
quit.
}
if Assigned(intfCommandTodo) then
begin
// Set the busy flag to let others know we have a command
// to execute (single-shot or looping).
// FOwner.isBusy := true;
{
Note: Might have to start draining the queue to
properly handle WM_QUIT if we have problems with this
code.
}
// See if we have a new command todo.
if Integer(PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE)) > 0 then
begin
// WM_QUIT?
if MsgRec.message = WM_QUIT then
break // We're done.
else
// Recover the command todo if any.
intfNewCommandTodo := getCommandToDo(MsgRec);
end; // if Integer(PeekMessage(MsgRec, FWndProcHandle, 0, 0, PM_REMOVE)) > 0 then
end
else
begin
// Not repeating a command. Block until something new shows
// up or we quit.
if GetMessage(MsgRec, 0, 0, 0) then
// Recover the command todo if any.
intfNewCommandTodo := getCommandToDo(MsgRec)
else
// GetMessage() returned FALSE. We're done.
break;
end; // else - if Assigned(intfCommandTodo) then
// Did we get a new command todo?
if Assigned(intfNewCommandTodo) then
begin
// ----- COMMAND TODO REPLACED!
// Update/Replace the command todo variable. Set the
// busy flag too.
intfCommandTodo := intfNewCommandTodo;
FOwner.isBusy := true;
// Clear the recently received new command todo.
intfNewCommandTodo := nil;
// Need to send a result notification after this command
// executes because it is the first iteration for it.
// (repeating commands only report the first iteration).
bSendResultNotification := true;
end; // if Assigned(intfNewCommandTodo) then
// If we have a command to do, make the request.
if Assigned(intfCommandTodo) then
begin
// Check for the clear command.
if intfCommandTodo.commandName = 'CLEAR' then
begin
// Clear the current command todo and the busy flag.
intfCommandTodo := nil;
FOwner.isBusy := false;
// Return the response as a simple result.
// FOwner.sendSimpleResult(newSimpleResult_basic('CLEAR command was successful'), intfCommandToDo);
end
else
begin
// ------------- SEND THE COMMAND TO ROVIO --------------
// This method makes the actual HTTP request via the TIdHTTP
// Post() method.
responseBody := doPost(
intfCommandTodo.commandName,
intfCommandTodo.cgiScriptName,
intfCommandTodo.userName_auth,
intfCommandTodo.password_auth,
intfCommandTodo.commandString);
// If this is the first or only execution of a command,
// send a result notification back to the owner.
if bSendResultNotification then
begin
// Send back the fully reconstructed response since
// that is what is expected.
S := FIdHTTPClient.Response.ResponseText + CRLF + FIdHTTPClient.Response.RawHeaders.Text + CRLF + responseBody;
// Return the response as a simple result.
FOwner.sendSimpleResult(newSimpleResult_basic(S), intfCommandToDo);
end; // if bSendResultNotification then
// If it is not a repeating command, then clear the
// reference. We don't need it anymore and this lets
// us know we already executed it.
if not intfCommandTodo.isRepeating then
begin
// Clear the current command todo and the busy flag.
intfCommandTodo := nil;
FOwner.isBusy := false;
end; // if not intfCommandTodo.isRepeating then
end; // if intfCommandTodo.commandName = 'CLEAR' then
end
else
// Didn't do anything this iteration. Yield
// control of the thread for a moment.
Sleep(0);
except
// Do not let Exceptions break the loop. That would render the
// component inactive.
On E: Exception do
begin
// Post a message to the component log.
postComponentLogMessage_error('ERROR in client thread for socket(' + theHttpCliName +'). Details: ' + E.Message, Self.ClassName);
// Return the Exception to the current EZTSI if any.
if Assigned(intfCommandTodo) then
begin
if Assigned(intfCommandTodo.intfTinySocket_direct) then
intfCommandTodo.intfTinySocket_direct.sendErrorToRemoteClient(exceptionToErrorObjIntf(E, PERRTYPE_GENERAL_ERROR));
end; // if Assigned(intfCommandTodo) then
// Clear the command todo interfaces to avoid looping an error.
intfNewCommandTodo := nil;
// Clear the current command todo and the busy flag.
intfCommandTodo := nil;
FOwner.isBusy := false;
end; // On E: Exception do
end; // try
end; // while not Application.Terminated do
To make use of HTTP keep-alives correctly, use FIdHTTPClient.Request.Connection := 'keep-alive' instead of FIdHTTPClient.Request.CustomHeaders.Add('Connection: keep-alive'), or set FIdHTTPClient.ProtocolVersion := pv1_1. At least that is how it works in Indy 10. I will double check Indy 9 when I get a chance.
Regardless of which version you use, the robot has to support keep-alives in the first place, or else TIdHTTP has no choice but to make a new socket connection for each request. If the robot sends an HTTP 1.0 response that does not include a Connection: keep-alive header, or an HTTP 1.1 response that includes a Connection: close header, then keep-alives are not supported.
Related to a post of mine ( How to retrieve a file from Internet via HTTP? ) about how to easily and robustly download a file from Internet, I have found a possible solution - however is not working as it was supposed to work.
According to MS documentation, the code below is supposed to time-out at 500ms after I disconnect myself from internet. However, it looks like it totally ignores the 'INTERNET_OPTION_RECEIVE_TIMEOUT' setting. The application freezes during download. It takes about 20-30 to this function to realize that there the Internet connection is down and to give the control back to the GUI.
Anybody knows why?
function GetBinFileHTTP (const aUrl: string; const pStream: TStream; wTimeOut: Word= 500; wSleep: Word= 500; wAttempts: Word= 10): Integer;
CONST
BufferSize = 1024;
VAR
hSession, hService: HINTERNET;
Buffer : array[0..BufferSize-1] of Char;
dwBytesRead, dwBytesAvail: DWORD;
lSucc : LongBool;
lRetries, dwTimeOut: Integer;
begin
Result:= 0;
if NOT IsConnectedToInternet then
begin
Result:= -1;
EXIT;
end;
hSession := InternetOpen(PChar(ExtractFileName(Application.ExeName)), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); { The INTERNET_OPEN_TYPE_PRECONFIG flag specifies that if the user has configured Internet Explorer to use a proxy server, WinInet will use it as well. }
if NOT Assigned(hSession) then
begin
Result:= -4;
EXIT;
end;
TRY
hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if NOT Assigned(hService) then Exit;
TRY
FillChar(Buffer, SizeOf(Buffer), 0);
{ Set time out }
dwTimeOut:= wTimeOut;
InternetSetOption(hService, INTERNET_OPTION_RECEIVE_TIMEOUT, #dwTimeOut, SizeOf(dwTimeOut)); { use INTERNET_FLAG_RELOAD instead of NIL to redownload the file instead of using the cache }
InternetSetOption(hService, INTERNET_OPTION_CONNECT_TIMEOUT, #dwTimeOut, SizeOf(dwTimeOut));
REPEAT
lRetries := 0;
REPEAT
lSucc:= InternetQueryDataAvailable( hService, dwBytesAvail, 0, 0);
if NOT lSucc
then Sleep( wSleep );
if lRetries > wAttempts
then Result:= -2;
UNTIL lSucc OR (Result= -2);
if NOT InternetReadFile(hService, #Buffer, BufferSize, dwBytesRead) then
begin
Result:= -3; { Error: File not found/File cannot be downloaded }
EXIT;
end;
if dwBytesRead = 0
then Break;
pStream.WriteBuffer(Buffer[0], dwBytesRead);
UNTIL False;
FINALLY
InternetCloseHandle(hService);
end;
FINALLY
InternetCloseHandle(hSession);
end;
Result:= 1;
end;
Here is the documentation:
{
INTERNET_OPTION_CONNECT_TIMEOUT Sets or retrieves an unsigned long integer value that contains the time-out value to use for Internet connection requests. If a connection request takes longer than this time-out value, the request is canceled. When attempting to connect to multiple IP addresses for a single host (a multihome host), the timeout limit is cumulative for all of the IP addresses. This option can be used on any HINTERNET handle, including a NULL handle. It is used by InternetQueryOption and InternetSetOption.
INTERNET_OPTION_RECEIVE_TIMEOUT Sets or retrieves an unsigned long integer value that contains the time-out value to receive a response to a request. If the response takes longer than this time-out value, the request is canceled. This option can be used on any HINTERNET handle, including a NULL handle. It is used by InternetQueryOption and InternetSetOption. For using WinInet synchronously, only the default value for this flag can be changed by calling InternetSetOption and passing NULL in the hInternet parameter.
INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT - Identical to INTERNET_OPTION_RECEIVE_TIMEOUT. This is used by InternetQueryOption and InternetSetOption.
}
Edit:
I disconnect the Internet by unplugging the cable or (for wireless) from software AFTER the application starts the download (I chose to download large file). It simulates the web site going offline.
The connect timeout obviously isn't applicable in your test because by the time you start your test (i.e., pull the plug), the connection has already been established. Indeed, the connection is already established before you even get around to setting the timeout option.
The validity of the receive timeout is also suspect, because you've already begun receiving the response, too.
The most promising-looking timeout is the disconnect timeout, but MSDN says that's not implemented yet.
It seems to me that the way to go is to use asynchronous operations. Use InternetReadFileEx and use the irf_Async and irf_No_Wait flags. If too much time passes without receiving any data, close the connection. Another option is to stick with your synchronous calls, but then call InternetCloseHandle from another thread if the download takes too long.
There is a documented bug in MS IE code. Can only be solved by using the code in a thread and re-implementing the time out mechanism.
Details:
"This acticle shows a workaround to the InternetSetOption API bug on setting timeout values by creating a second thread.
InternetSetOption Does Not Set Timeout Values"
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q224318
(Link was reported broken. Blame MS not me)
Maybe somebody can help with implementing this bug fix also in Delphi. I personally don't have experience with C. Even the backbone in pseudo-Pascal will be nice.
IMO, you should run this in a thread. Threading does not have to mean looping - it can be a "one and done" thread. Run it that way, and your GUI remains responsive until the thread finishes. I realize that this does not actually answer your question, but it will make your code better.
Also, if you disconnect the internet during the first loop where you're checking for data, I think it will retry 10 times. You should detect, and then quit right away.
Lastly, I don't think you should use EXIT when you've got handles and stuff open. Break instead, so that you still run through the disconnects. I would expect your code to tie up the socket. I saw this recently during a code review when there was an EXIT intead of a BREAK, and it's causing a memory leak because objects are created and never freed. I'd use the same rule here.
Are you sure that you aren't hitting the INTERNET_OPTION_CONNECT_TIMEOUT? It will try to connect first, then receive.
In order to test the connect timeout, it must resolve, but never connect. In order to test the read timeout, it must connect, but never receive any data.
I generally set my connect timeout to 10 seconds, and the read timeout to 30 seconds. Anything longer than that, I consider down anyway.