解决临界区死锁

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
   
    procedure RunPorc(s:string);
  public
    { Public declarations }
  end;

  TestThread = class(TThread)
  protected
    procedure Execute;override;
  public
    s: string;
  end;

var
  Form2: TForm2;
  dmLock: TRTLCriticalSection;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  with TestThread.Create(True) do
  begin
      s:='A';
      outputdebugstring(Pchar(inttostr(Threadid)));
      Resume;
  end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  with TestThread.Create(True) do
  begin
      s:='B';
      outputdebugstring(Pchar(inttostr(Threadid)));
      Resume;
  end;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  dmlock.LockCount:=-1;
  dmlock.RecursionCount:=0;
  outputdebugstring(Pchar(inttostr(dmlock.OwningThread)));
  TerminateThread(dmlock.OwningThread);
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  RunPorc('');
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  InitializeCriticalSection(dmLock);
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(dmLock);
end;

procedure TForm2.RunPorc(s: string);
var i:integer;
begin
  i:=0;
  outputdebugstring(Pchar(s+'work begin'));
  while not TryEnterCriticalSection(dmLock) do;
    //Application.ProcessMessages;
  //EnterCriticalSection(dmLock);
  try
    outputdebugstring(Pchar(s+'working'));
    while i<1000 do
    begin
      sleep(5);
      inc(i);
      Application.ProcessMessages;
    end;
  finally
    LeaveCriticalSection(dmLock);
    outputdebugstring(Pchar(s+'work end'));
  end;
end;

{ TestThread }

procedure TestThread.Execute;
var i:integer;
begin
  inherited;
  i:=0;
  outputdebugstring(Pchar(s+'work begin'));
  while not TryEnterCriticalSection(dmLock) do;
    //Application.ProcessMessages;
  //EnterCriticalSection(dmLock);
  try
    outputdebugstring(Pchar(s+'working'));
    while i<10000 do
    begin
      sleep(5);
      inc(i);
      //Application.ProcessMessages;
    end;
  finally
    LeaveCriticalSection(dmLock);
    outputdebugstring(Pchar(s+'work end'));
  end;

end;

end.