[DUG] Critical Section with Timeout

[Ross Levis]

A mutex sounds more efficient than the loop with a sleep.  But I assume I
will still need to handle multiple entries for the same thread, which is
allowed, but stop entries from other threads if in use.  I'll try to modify
the existing procedure to use a mutex instead.

 

Ross.

 

From: delphi-bounces at delphi.org.nz [mailto:delphi-bounces at delphi.org.nz] On
Behalf Of Jolyon Smith
Sent: Thursday, 25 November 2010 7:21 AM
To: 'NZ Borland Developers Group - Delphi List'
Subject: Re: [DUG] Critical Section with Timeout

 

Why go to all this trouble?

 

If you need a critical section with the ability to time-out, just use a
mutex and WaitFor(TIMEOUT) instead!

 

 

From: delphi-bounces at delphi.org.nz [mailto:delphi-bounces at delphi.org.nz] On
Behalf Of Ross Levis
Sent: Thursday, 25 November 2010 1:52 a.m.
To: 'NZ Borland Developers Group - Delphi List'
Subject: [DUG] Critical Section with Timeout

 

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/d645e6e8/attachment.html