Здравствуйте, Anisimov.Slava, Вы писали:

AS>Здравствуйте, wellwell, Вы писали:

W>> MadExcept умеет, если главный тред вешается.
AS>как он может "уметь" если поток повис?
AS>надо как минимум внешний сигнал подать что бы побудить поток к действию.

А что тут такого Висит, например диагностичекий поток и пробует окну из главного потока (например Application.Handle) слать SendMessageTimeout(WM_NULL), если функция завершается по таймуту то есть подозрения что главный поток подвис.

[Skip]

AS>У заказчика можно сделать дамп.
AS>Но что с ним потом делать — не знаю.

Создаем поток, который делает дампы раз в час или после срабатывания какого то именованого события CreateEvent
Снимаем стек с потоков. Пример реализации. Ввырезал у себя, естесвенно не скомпилится.

class function TDCallStackUtils.BuildCallStack(ProcessID, ThreadID : Cardinal; IgnoreLevels, MaxStackEntries
    : Integer): IDCodeEntryInfoCollection;

const
  THREAD_GET_CONTEXT = $0008;
var
  aContext : TContext;
  aStack: STACKFRAME;
  aThreadHandle : THandle;
  aProcessHandle: THandle;
  aDebugInfoList : TJclDebugInfoList;
  aLocationInfo : TJclLocationInfo;
  aCodeEntryInfo : IDCodeEntryInfo;
begin
  Result := TDCodeEntryInfoCollection.Create;

  ZeroMemory(@aContext, SizeOf (aContext));
  aContext.ContextFlags := CONTEXT_FULL;

  if ProcessID = 0 then
    aProcessHandle := GetCurrentProcess
  else
    aProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);

  aDebugInfoList := nil;
  try
    if aProcessHandle <> 0 then
    try
      aThreadHandle := OpenThread (THREAD_GET_CONTEXT, False, ThreadID);
      if aThreadHandle <> 0 then
        try
          if GetThreadContext (aThreadHandle, aContext) then begin
            ZeroMemory(@aStack, sizeof(aStack));
            aStack.AddrPC.Offset    := aContext.Eip;
            aStack.AddrPC.Mode      := AddrModeFlat;
            aStack.AddrStack.Offset := aContext.Esp;
            aStack.AddrStack.Mode   := AddrModeFlat;
            aStack.AddrFrame.Offset := aContext.Ebp;
            aStack.AddrFrame.Mode   := AddrModeFlat;

            aDebugInfoList := TJclDebugInfoList.Create (True);

            while StackWalk(IMAGE_FILE_MACHINE_I386, aProcessHandle, aThreadHandle,
                @aStack, @aContext, nil, SymFunctionTableAccess, SymGetModuleBase, nil) do
            begin
              if IgnoreLevels > 0 then
                Dec(IgnoreLevels)
              else
                if aDebugInfoList.GetLocationInfo(Pointer (aStack.AddrPC.Offset), aLocationInfo) then begin
                  if (MaxStackEntries > 0) and (Result.Count >= MaxStackEntries) then
                    Break;
                  aCodeEntryInfo := Result.AddNew(aLocationInfo.Address, aLocationInfo.LineNumber, aLocationInfo.OffsetFromProcName, aLocationInfo.OffsetFromLineNumber);
                  aCodeEntryInfo.ProcedureInfo := TDProcedureInfo.Create(aLocationInfo.UnitName, aLocationInfo.SourceName, aLocationInfo.ProcedureName, aLocationInfo.DebugInfo.FileName);
                end;
            end;

          end else
            RaiseLastOSError;
        finally
          CloseHandle(aThreadHandle);
        end
      else
        RaiseLastOSError;
    finally
      CloseHandle (aProcessHandle);
    end;
  finally
    aDebugInfoList.Free;
  end;
end;

aDebugInfoList.GetLocationInfo — из JclDebug (что и рекомендую вам задействовать)

Примечание, если поток, стек с которого вы хотите снять, не текущий, необходимо вызвать SuspendThread перед операцией и ResumeThread после после.
Что вам все это даст — вы увидите где потоки висят, а это уже полдела к вылавливанию дедлока. Например сделайте слепки с интервалом в минуту и сравните какие потоки не сдвинулись с места.
Чтоб JclDebug, акуратно визуализировал стек необходимо пару вещей — или поставить галочку для компиляции Include TD32 Info, или генерировать Detailed map file Все это описано не раз и вы можете поискать это в интернете.