However since Michael continues to challange my POV I'll post some VB6 code
to wrap a Mutex when I get the chance.
So here it is. Create a VB6 dll project called MutexFactory.
Set project properties Unattended Execution and Retain in Memory
Keep the Threading Model Apartment Threaded.
Add the following Mutex.cls Class Module set it's Instancing to
PublicNotCreatable.
Obviously you'll have undo the line wraps created by the reader.
Option Explicit
Private Const mcsModule = "Mutex."
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const LANG_NEUTRAL = &H0
Private Const WAIT_OBJECT_0 As Long = &H0
Private Const WAIT_TIMEOUT As Long = 258&
Private Const WAIT_ABANDONED As Long = &H80
Private Const WAIT_FAILED As Long = -1
Private Const HRESULT_WIN32 As Long = &H8007000
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA"
(lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As
String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long)
As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA"
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal
dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long,
Arguments As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle
As Long, ByVal dwMilliseconds As Long) As Long
Public Enum OwnershipState
TimedOut = 0
Succeeded
TakenAbandoned
End Enum
Private mhMutex As Long
Private mlOwnershipCnt As Long
Friend Sub Init(rsName As String)
mhMutex = CreateMutex(ByVal 0&, 0, rsName)
If mhMutex = 0 Then ApiRaise Err.LastDllError, mcsModule & "Init"
End Sub
Public Function GetOwnership(ByVal Timeout As Long) As OwnershipState
Dim lResult As Long
lResult = WaitForSingleObject(mhMutex, Timeout)
Select Case lResult
Case WAIT_FAILED
ApiRaise Err.LastDllError, mcsModule & "GetOwnership"
Case WAIT_OBJECT_0
mlOwnershipCnt = mlOwnershipCnt + 1
GetOwnership = Succeeded
Case WAIT_TIMEOUT
GetOwnership = TimedOut
Case WAIT_ABANDONED
mlOwnershipCnt = mlOwnershipCnt + 1
GetOwnership = TakenAbandoned
End Select
End Function
Public Function Release() As Boolean
Dim lResult As Long
lResult = ReleaseMutex(mhMutex)
If lResult <> 0 Then
mlOwnershipCnt = mlOwnershipCnt - 1
Else
ApiRaise Err.LastDllError, mcsModule & "Release"
End If
End Function
Private Sub Class_Terminate()
Dim i As Long
If mhMutex <> 0 Then
For i = 1 To mlOwnershipCnt
ReleaseMutex mhMutex
Next
CloseHandle mhMutex
mhMutex = 0
End If
End Sub
Public Sub ApiRaise(ByVal vlError As Long, rsSource As String)
Err.Raise vlError And &HFFFF& Or HRESULT_WIN32, rsSource, ApiError(vlError)
End Sub
Private Function ApiError(ByVal vlError As Long) As String
Dim s As String
Dim lCnt As Long
s = String(256, 0)
lCnt = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or
FORMAT_MESSAGE_IGNORE_INSERTS, _
ByVal 0&, vlError And &HFFFF&, LANG_NEUTRAL, s, Len(s),
ByVal 0&)
If lCnt <> 0 Then ApiError = Left$(s, lCnt)
End Function
Add other Class called Factory leave it's instancing set to Multiuse:-
Option Explicit
Private Declare Sub SleepApi Lib "kernel32" Alias "Sleep" (ByVal
dwMilliseconds As Long)
Public Function GetMutex(ByVal Name As String) As Mutex
Set GetMutex = New Mutex
GetMutex.Init Name
End Function
Public Sub Sleep(ByVal Milliseconds As Long)
SleepApi Milliseconds
End Sub
I've included the sleep method which helps with testing.
Compile this up.
Usage:
Create an instance of the Factory object ("MutexFactory.Factory")
oMF = Server.CreateObject("MutexFactory.Factory")
To get a mutex call the Factory GetMutex method with a unique name for the
resource you want to protect. The INSTANCE_META_PATH server variable can be
useful if there are multiple instances of your app on the server. Be
careful not to exceed MAX_PATH I recommend you don't make the string longer
than 255.
oMutex = oMF.GetMutex("Unique_Name")
To enter serialise a chunk of code you first need to take ownership of the
Mutex.
The GetOwnership method takes a timeout value in milliseconds. -1 is
indefinite (not recommended).
lResult = oMutex.GetOwnership(5000) ' Wait for 5 seconds to get ownership
0 = Timed out.
1 = Successfully acquired ownership of Mutex
2 = Aquired ownership of a Mutex that had been abandoned (the previously
owning thread terminated before releasing the mutex)
If ownership has been aquired the Mutex should be released as soon as is
possible.
oMutex.Release()
Multiple successful calls to GetOwnership should be matched by an equal
number of calls to Release.
Example:-
This page is serialises all calls to it without impacting any other pages
(apart from consuming worker threads that might otherwise be processing
other requests)
'Serialised.asp
<html>
<head>
<title>Serialised</title>
</head>
<body>
<%
Dim oMF: Set oMF = Server.CreateObject("MutexFactory.Factory")
Dim oMutex: Set oMutex = oMF.GetMutex(ScriptName)
Dim lOwnershipState
lOwnershipState = oMutex.GetOwnership(7000)
If lOwnershipState Then
Response.Write "Doing work<br />"
oMF.Sleep 5000
Response.Write "Finished"
oMutex.Release()
Else
Response.Write "Timeout trying to own mutex"
End If
Function ScriptName()
ScriptName = Request.ServerVariables("INSTANCE_META_PATH") &
Request.ServerVariables("SCRIPT_NAME")
End Function
%>
</body>
</html>
If the amount of work involved is significant it may be worth setting the
timeout low and responding back to the client asking them to try again later
(or if you can use a javascript solution to retry all the better). This
would avoid consuming threads if many requests want this resource on an
otherwise busy site.
I hope you find this useful.
Anthony.
