asked on

Delphi 2006 application hangs on exit

Hi,
I have written as Delphi application that uses TApdComPort, TTimer, and TTcpClient.

My error control is via raising exceptions and catching them in a single place.

This application has started to hang on close. When running under the debugger you can also not stop it (CTL F2).

The application cannot be stopped even when running from the exe by Task Manager and so the PC needs to be rebooted to try again.

Can anyone give me some code that I can add to the Form OnClose, OnDestroy etc that will clean things up.

I understand that I will need to supply more details but am unsure of how much code to supply.

procedure TFR_Indicator_Main.FormCreate(Sender: TObject);
begin
   Application.OnException := HandleException; // Trap any Application Errors
end;
 
procedure TFR_Indicator_Main.HandleException(Sender: TObject; E: Exception);
begin
  UpdateResponseDisplay('Error : ' + E.Message ,clRed);
  FR_Indicator_Main.PA_Status.Color := clRed;
end;
 
procedure TFR_Indicator_Main.BT_CloseClick(Sender: TObject);
begin
  Close;
end;
 
procedure TFR_Indicator_Main.FormDestroy(Sender: TObject);
begin
  ComPort5.DonePort;
end;

Open in new window

Geert G

put a breakpoint in the routines for closing and destroying of the mainform

close the app and see where it goes
it may be in an infinite loop ...

if you can't stop it with Ctrl-Fé, have you opened an external app, like excel with it ?

Geert G

Ctrl-F2

dprochownik

If break point stuff won't work check if any unregular components you uses are using threads. If yes then check if onDestroy they don't call Terminate for these threads and then WaitFor. If yes then put break points on WaitFor commands and check in debbug mode if yours applications don't hangs on that command, because WaitFor hangs application until thread will trully terminate. Some components are not written so well and it's threads in some cases don't terminates after terminate call.

Also check if you don't have memory leaks or hidden Access Violation error (in try except). In some cases it can be responsilbe for application hanging on. Few years ago I had similar problem when I made a mistake by multiple call free for sub objects of TVirtualStringTree
(I had two trees and I was twice cleanig only one of them).

MerijnB

You might be able to get more information this way:

Install the trial of Eurekalog (www.eurekalog.com). Enable freeze detection: Project -> Eurekalog options -> Advanced options -> Anti-Freeze options.

It point you in the right direction.

jetbet

ASKER

I believe the issue may be in the included function.

I have managed to produce an endless loop here. Unfortunately the Eureka log trial application install seems incorrect as it does not produce a log, does not capture the freeze and I now get an endless loop while it tries to find ExceptionLog.pas.

Once I have uninstalled this application, I will try again. Currently the issue happens about once every 5 or 6 times, but this is an average only.

The only non standard compnent I use is TApdComPort which I have put on the form from the Tool Palette. I may use a variable on the form that is created in FormCreate and then I can call its destroy method directly from the main forms OnDestroy call.

I also do not open any other external app like excel

I will let you know how I get on

function  TApdWin32Thread.WaitForOverlapped(ovl : POverlapped) : Integer;
var
    stat        : DWORD;
    bytesRead   : Cardinal;
begin
    repeat
        stat := WaitForSingleObject(ovl.hEvent, 100);
    until ((stat <> WAIT_TIMEOUT) or Terminated or KillThreads);
    case stat of
      WAIT_OBJECT_0:
        if (GetOverlappedResult(ComHandle,
                                ovl^,
                                bytesRead,
                                True)) then
        begin
            Result := bytesRead;
            ResetEvent(ovl.hEvent);
        end else
            Result := ecDeviceRead;
      WAIT_TIMEOUT:
        Result := 0;
      else
        Result := ecDeviceRead;
    end;
end;

Open in new window

jetbet

ASKER

Another freeze and another loop in the same unit (LNSWin32).

By selecting Run/Program pause and then F8ing I get the following loop from the included code snippit

while ((not Terminated) and (not KillThreads)) do
begin
{$IFDEF DebugThreads}
if (DLoggingOn) then
AddDispatchEntry(dtThread, dstThreadSleep, 3, nil, 0);
{$ENDIF}
// Wait for output to appear in the queue or for a flush request
stat := WaitForMultipleObjects(Length(outEvents),
@outEvents[0],
False,
100);
{$IFDEF DebugThreads}
if (DLoggingOn) then
AddDispatchEntry(dtThread, dstThreadWake, 3, nil, 0);
{$ENDIF}
case stat of

procedure TWriteThread.Execute;
var
    outEvents       : array [0..1] of THandle;
    stat            : DWORD;
    ovl             : TOverlapped;
    istat       : Integer;
begin
    ThreadStart(Self);
{$IFDEF DebugThreads}
    if (DLoggingOn) then
        AddDispatchEntry(dtThread, dstThreadStart, 3, nil, 0);
{$ENDIF}
    outEvents[0] := OutputEvent;
    outEvents[1] := OutFlushEvent;
    FillChar(ovl, SizeOf(ovl), 0);
    ovl.hEvent := CreateEvent(nil, True, False, nil);
    try
        ReturnValue := 0;
        while ((not Terminated) and (not KillThreads)) do
        begin
{$IFDEF DebugThreads}
            if (DLoggingOn) then
                AddDispatchEntry(dtThread, dstThreadSleep, 3, nil, 0);
{$ENDIF}
            // Wait for output to appear in the queue or for a flush request
            stat := WaitForMultipleObjects(Length(outEvents),
                                           @outEvents[0],
                                           False,
                                           100);
{$IFDEF DebugThreads}
            if (DLoggingOn) then
                AddDispatchEntry(dtThread, dstThreadWake, 3, nil, 0);
{$ENDIF}
            case stat of
              WAIT_OBJECT_0:
                // Output has arrived in buffer, send it
                if (not KillThreads) then
                    if (WriteSerial(@ovl) <> 0) then
                    begin
                        istat := GetLastError;
{$IFDEF DebugSerialIO}
                        MessageBox(0,
                                   PChar(Format('WriteSerial failed! Error = %d.',
                                                [istat])),
                                   '',
                                   MB_OK or MB_APPLMODAL or MB_ICONEXCLAMATION);
{$ENDIF}
                        // An invalid handle error means that someone else (probably
                        // TAPI) has closed the port. So just quit without an error.
                        if (istat <> ERROR_INVALID_HANDLE) then
                            ReturnValue := ecDeviceWrite;
                        KillThreads := True;
                    end;
              WAIT_OBJECT_0 + 1:
                // Flush of output buffer requested, acknowledge & continue
                SetEvent(GeneralEvent);
              WAIT_TIMEOUT:
                ;
              else
              begin
                ReturnValue := ecDeviceWrite;
                KillThreads := True;
              end;
            end;
        end;
    finally
        CloseHandle(ovl.hEvent);
{$IFDEF DebugThreads}
        if (DLoggingOn) then
            AddDispatchEntry(dtThread, dstThreadExit, 3, nil, 0);
{$ENDIF}
        ThreadGone(Self);
    end;
end;

Open in new window

jetbet

ASKER

Investigation has pretty well proven that the issue is with the TAdpomPort componant and could well be with the dispatcher thread.

Any attempt to Free, Destroy, DonePort etc the Comm Object in OnClose or OnDestroy only makes things worse (locks all the time).

Could someone advise me how to keep this object seperate from the main thread so that I can close in down regardless if it thinks it has more to do.

ASKER CERTIFIED SOLUTION

dprochownik

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

MerijnB

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

jetbet

ASKER

Thanks for your help.
The componant suggested is easy to use. Unfortunately my "Black Box" Legacy application had trouble with the output and gave me the same useless error message I had originally got out of ASyncPro (another issue). To fix Async on this issue rather than using Write string I put the following code in
==========================================
if ComPort5.Open then
begin
for lix := 1 to length(asInput) do
begin
ComPort5.PutChar(asInput[lix]);
end;
end
======================================

My final solution uses Async pro but I have used the conditional "UseAwWin32" to bypass the updated dispatcher where the freeze was being called from.

Thanks again for your time and advice