Debug Infos von TCriticalSection beim compilen von FPC Application

[itblumi]

Falls du damit die InitializeCriticalSectionEx Methode meinst, dann hätte ich hier vielleicht etwas für dich.

Code:

unit CriticalSectionEx;

{$IFDEF FPC}
  {$mode ObjFPC}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, syncobjs;

  function InitializeCriticalSectionEx(var cs: TRTLCriticalSection;
                                       dwSpinCount, Flags: DWORD): Boolean;
                                       stdcall; external 'kernel32.dll';
type

  { TCriticalSectionEx }

  TCriticalSectionEx = class(TSynchroObject)
  protected
    FCriticalSection: TRTLCriticalSection;
  public
    procedure Acquire;override;
    procedure Release;override;
    procedure Enter;
    function  TryEnter:boolean;
    procedure Leave;
    constructor Create; overload;
    constructor Create(ASpinCount, AFlags: DWORD); overload;
    destructor Destroy;override;
  end;

const
  // -> from winnt.h
  // These flags define the upper byte of the critical section SpinCount field
  //
  //#define RTL_CRITICAL_SECTION_FLAG_NO_DEBUG_INFO         0x01000000
  RTL_CRITICAL_SECTION_FLAG_NO_DEBUG_INFO =                 $01000000;
  //#define RTL_CRITICAL_SECTION_FLAG_DYNAMIC_SPIN          0x02000000
  RTL_CRITICAL_SECTION_FLAG_DYNAMIC_SPIN =                  $02000000;
  //#define RTL_CRITICAL_SECTION_FLAG_STATIC_INIT           0x04000000
  RTL_CRITICAL_SECTION_FLAG_STATIC_INIT =                   $04000000;
  //#define RTL_CRITICAL_SECTION_FLAG_RESOURCE_TYPE         0x08000000
  RTL_CRITICAL_SECTION_FLAG_RESOURCE_TYPE =                 $08000000;
  //#define RTL_CRITICAL_SECTION_FLAG_FORCE_DEBUG_INFO      0x10000000
  RTL_CRITICAL_SECTION_FLAG_FORCE_DEBUG_INFO =              $10000000;
  //#define RTL_CRITICAL_SECTION_ALL_FLAG_BITS              0xFF000000
  RTL_CRITICAL_SECTION_ALL_FLAG_BITS =                      $FF000000;

  DEFAULT_SPIN_COUNT = 4000;


implementation


{ TCriticalSectionEx }

procedure TCriticalSectionEx.Acquire;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TCriticalSectionEx.Release;
begin
  LeaveCriticalSection(FCriticalSection);
end;

procedure TCriticalSectionEx.Enter;
begin
  Acquire;
end;

function TCriticalSectionEx.TryEnter: boolean;
begin
  result := TryEnterCriticalSection(FCriticalSection) <> 0;
end;

procedure TCriticalSectionEx.Leave;
begin
  Release;
end;

constructor TCriticalSectionEx.Create;
begin
  inherited Create;
  InitializeCriticalSectionEx(FCriticalSection, DEFAULT_SPIN_COUNT, 0);
end;

constructor TCriticalSectionEx.Create(ASpinCount, AFlags: DWORD);
begin
  InitializeCriticalSectionEx(FCriticalSection, ASpinCount, AFlags);
end;

destructor TCriticalSectionEx.Destroy;
begin
  inherited Destroy;
end;

end.

Könnte es aber sein das du versuchst in eine CriticalSection zu Entern und diese fehl schlägt ?
Vielleicht reicht es auch einfach den Eintritt mit der TryEnter Methode zu versuchen.