[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1075
  • Last Modified:

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

0
jetbet
Asked:
jetbet
  • 4
  • 2
  • 2
  • +1
2 Solutions
 
Geert GruwezOracle dbaCommented:
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 ?
0
 
Geert GruwezOracle dbaCommented:
Ctrl-F2
0
 
dprochownikCommented:
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).
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
MerijnBSr. Software EngineerCommented:
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.
0
 
jetbetAuthor Commented:
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

0
 
jetbetAuthor Commented:
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

0
 
jetbetAuthor Commented:
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.
0
 
dprochownikCommented:
Like I said before
It seems like loops in Execute procedure of some threads in yours app never ends. So if you can determine which threads are they, then you could make changes to clean that. But to be honest if you are doing everything fine with this COM component specification and it hangs, the best solution (in my opinion) is to replace that component by anything else. There are many other components allowing read and write to COM ports, for example simple ComDrv32, which I'm using in one of my industrial application. I had similar problems like you with few others COM components and after hours of repairing them I have just replace them and now it works fine :)
0
 
MerijnBSr. Software EngineerCommented:
> Unfortunately the Eureka log trial application install seems incorrect as it does not produce a log, does not capture the freeze

This tells you at least that the message pump of the main thread is still running, this also points to a problem in one of the other threads (although it's interesting to know what the main thread is doing at that moment).

> the best solution (in my opinion) is to replace that component by anything else

I agree with dprochownik here, I've used open source CPort (http://sourceforge.net/projects/comport/) quite a lot of times without any troubles.
0
 
jetbetAuthor Commented:
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
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 4
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now