[DUG] Critical Section with Timeout

[Ross Levis]

I think I've come up with a solution to provide a critical section with a
timeout, and want some feedback, particularly if you can see any problems
with it.

 

Firstly 2 procedures which are used to enter and leave a section.

 

var

  CS: TRTLCriticalSection;

  LockThreadID: Cardinal;

 

function EnterProc: Boolean;

const

  Timeout = 2000; // 2 seconds

var

  ThreadID: Cardinal;

  Start: Cardinal;

  Elapsed: Integer;

  OK: Boolean;

begin

  EnterCriticalSection(CS);

  ThreadID := GetCurrentThreadID;

  if ThreadID = LockThreadID then

  begin

    Result := False;

    LeaveCriticalSection(CS);

    Exit;

  end;

  OK := True;

  Start := GetTickCount;

  while (LockThreadID <> 0) and OK do

  begin

    Sleep(1);

    Elapsed := GetTickCount-Start;

    OK := (Elapsed >= 0) and (Elapsed < Timeout);

  end;

  LockThreadID := ThreadID;

  Result := True;

  LeaveCriticalSection(CS);

end;

 

procedure LeaveProc;

begin

  LockThreadID := 0;

end;

 

Note that I don't need speed where these procedures will be used, so the
Sleep(1) delay isn't an issue.

 

Now to use it.

 

var  Locked: Boolean;

begin

  Locked := EnterProc;

  try

DoSomething;

  finally

If Locked then LeaveProc;

  end;

end;

 

It appears to work.

 

Ross.

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://listserver.123.net.nz/pipermail/delphi/attachments/20101125/bc4b2da1/attachment.html