Win32: Memory Mapped Files/Control User Count

[Michael Mattias]

4/09/02 - code updated to fix a bug.

$IF 0
'  FILE: Mapfile1.BAS FOR PB/CC 2.0
'  WITH Mutex locking
'  Shows: Controlling and sharing data across multiple copies of the same program.
'  Author: Michael Mattias Racine WI USA
'  Placed in the public domain by the author October 6, 1999
'  04.08.02 Fix Bug: UnmapViewofFile parameter changed to BYVAL pC (was hMemoryFile).
'   Change made allows this to work on Win NT/2K/XP and with any version of the
'   Win32API.INC file supplied by PB, some of which declare the parameter for UnmapViewofFile
'   as "lpBaseAddress AS ANY" and some of which declare the parameter as "BYVAL lpBaseAddress AS DWORD"
'  TO DEMO: Compile to an EXE. '
'  Start three or four copies using Start/Run
'  or double-clicking on the EXE in Explorer.
'  Arrange console windows so that all are visible.
'  Follow the on-screen prompts.
'  An article titled, "Data Sharing in 32-Bit Windows" by the author appeared in the
'  October, 1999 issue of "BASICally Speaking" magazine. The article goes into
'  some depth on the whats, whys and wherefores of both the data sharing and the use
'  of the mutex object as a locking mechanism.
'  Reprints of the article are available through the publisher:
'  Information Management Systems
'  320 Village Walk Dr.
'  Macungie PA 18062
'  Vox: 610-966-5502
'  Fax: 610-966-6981
'  Sales: 1-800-750-6390
'  Mr. Alan C. Earnshaw [email protected]
'  Internet: [email protected]
'  www.infoms.com 

$ENDIF

#REGISTER NONE           ' don't allow PB to assign REGISTER variables.
#DEBUG ERROR ON
$INCLUDE "WIN32API.INC"
' mapping file constants not in WIN32API.INC:
%PAGE_NOACCESS = 1&
%PAGE_READONLY = 2&
%PAGE_READWRITE = 4&
%PAGE_WRITECOPY = 8&
%MUTEX_MODIFY_STATE = 1
%MUTEX_ALL_ACCESS = &H1F0001&
' UDT used for the record layout of the memory-mapped file
TYPE MemoryFileType
     UserCount  AS LONG
     TotalUses  AS LONG
     LastControlNo (1 TO 10) AS LONG
END TYPE

DECLARE FUNCTION GetMemoryFile (C AS MemoryFileType) AS LONG
DECLARE FUNCTION GetNextControlNo (Idx AS LONG) AS LONG

GLOBAL MemoryFileName  AS ASCIIZ * %MAX_PATH
GLOBAL hMemoryFile     AS LONG
GLOBAL MutexName       AS ASCIIZ * %MAX_PATH
GLOBAL hMutex          AS LONG

FUNCTION WinMain (BYVAL hCurInstance  AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  lpszCmdLine         AS ASCIIZ PTR, _
                  BYVAL nCmdShow      AS LONG) EXPORT AS LONG

   DIM ThisFile AS ASCIIZ * 128
   DIM Stat AS LONG, I AS LONG
   Stat = GetModuleFileName (hCurInstance, ThisFile, SIZEOF(ThisFile) )
   PRINT "Hello World from Program " & ThisFile
   ' OK, let's see which user number we are, and what our control numbers are
   DIM ControlNumbers AS MemoryFileType
   DIM J$
   ' set the global object names:
   MemoryFileName = "MemMap1_Memory_File"
   MutexName      = "MemMap1_Mutex"

   Stat = GetMemoryFile (ControlNumbers)
   ' if Stat=0, GLOBAL hMemoryFile is the handle of the object, and UDT Controlnumbers is filled
    IF Stat = 0 THEN
     CONSOLE NAME "User " & STR$(ControlNumbers.UserCount)& "/" & LTRIM$(STR$(ControlNumbers.TotalUses)) & "-Mapfile"
     PRINT "My UserCount is        " & STR$(ControlNumbers.UserCount)
     PRINT "Total Acuumulated Uses " & STR$(ControlNumbers.TotalUses)
     PRINT "My Control Numbers are";
     FOR I = 1 TO 10
         PRINT FORMAT$(ControlNumbers.LastControlNo(I), "###,###");
     NEXT I
     PRINT
     CALL ProcessUserInput (ControlNumbers.UserCount)
   END IF
   PRINT "Press any key to exit..";
   J$ = WAITKEY$

END FUNCTION

SUB ProcessUserInput (UserNo AS LONG)
   ' ask any copy to increment a control number
   DIM Value AS STRING, nValue AS LONG
   DIM ControlNo AS LONG

   DO
    PRINT
    PRINT "Waiting for user number" & STR$(UserNo) & " to select"
    LINE INPUT "Enter a Number from 1 to 10, or 0 to exit ", Value
    nValue = VAL(Value)
    IF nValue = 0 THEN
       PRINT "Exiting as requested"
       ControlNo = GetNextControlNo (nValue)   ' calling with zero reduces user count by one
       EXIT DO
    ELSEIF nValue > 0 AND nValue <=10 THEN
       ControlNo = GetNextControlNo (nValue)
       PRINT "Your Control Number " & STR$(nValue) & " =" & STR$(ControlNo)
       PRINT
    ELSE
       PRINT "Naughty, Naughty!"
       MessageBeep %MB_ICONSTOP
   END IF
  LOOP
  ' close this process's handle to the locking mutex
  CloseHandle hMutex
END SUB

FUNCTION GetNextControlNo (Idx AS LONG) AS LONG
   ' gets LastControlNo(idx)+ 1 from current file mapped object
   ' uses GLOBALs hMemoryFile, hMutex
   ' if Idx = 0 it means "decrease user count"

   DIM pc AS MemoryFileType PTR
   DIM LockValue AS LONG, LastError AS LONG

   ' Wait until the mutex object is signaled (i.e., not in use)
   PRINT "Waiting for Lock Mutex"
   LockValue = WaitForSingleObject(hMutex, 30000)     ' 60000= 1 minute; normally %INFINITE
   PRINT "Done Waiting for Mutex"
   SELECT CASE LockValue
     CASE %WAIT_OBJECT_0, %WAIT_ABANDONED             ' it's our turn
        PRINT "Press Any Key to release hold on mutex - it is our turn now."
        WAITKEY$
        pC = MapViewOfFile (hMemoryFile,  %FILE_MAP_WRITE, 0,0, SIZEOF(@pC))
        ' FILE_MAP_WRITE includes READ access
BadPlaceForWindowsToButtIn:
        IF Idx = 0 THEN
           DECR @pc.UserCount
           FUNCTION = 0
        ELSE
           INCR @pc.LastControlNo(Idx)
           FUNCTION = @pC.LastControlNo(Idx)
        END IF
       ' UnmapViewOfFile hMemoryFile
        UnmapViewOfFile BYVAL pC
        ReleaseMutex hMutex           ' return locking mutex to 'available' state
     CASE %WAIT_TIMEOUT
          PRINT "Timed out Waiting for Mutex"
          FUNCTION = -1
     CASE ELSE
          LastError = GetLastError
          PRINT "Error on Wait for Mutex# & STR$(LastError)
          FUNCTION = LastError * -1
   END SELECT

END FUNCTION

FUNCTION GetMemoryFile (C AS MemoryFileType) AS LONG
   ' returns: 0 = success, else error
   ' sets: hMemoryFile and hMutex, GLOBALs used for access throughout the program.
   ' uses: GLOBAL MemoryFileName, MutexName

   DIM J AS STRING
   DIM LastError AS LONG
   DIM BytesRead AS LONG, I AS LONG
   DIM Stat AS LONG, hCreate  AS LONG, pC AS MemoryFileType PTR

   hMemoryFile = CreateFileMapping ( BYVAL -1&, BYVAL %NULL, %PAGE_READWRITE, BYVAL %NULL, BYVAL CLNG(SIZEOF(C)), MemoryFileName)
   LastError = GetLastError
   IF ISTRUE (hMemoryFile) THEN
       pC = MapViewOfFile (hMemoryFile,  %FILE_MAP_WRITE, 0,0, SIZEOF(C))
       IF LastError = %ERROR_ALREADY_EXISTS THEN
         ' file is already open, so there must be another user, so read the current value and
         ' increment the user count
          C = @pC
          INCR C.UserCount
          INCR C.TotalUses
          ' open the mutex object to get this process's handle to it
         hMutex = OpenMutex (%MUTEX_ALL_ACCESS, 0, MutexName)
        ELSE
          ' we are the first user
          C.UserCount = 1
          C.TotalUses = 1
          FOR I = 1 TO 10
              C.LastControlNo(I) = 100 * I
          NEXT I
          ' create the Mutex object (for file locking)
          hMutex = CreateMutex (BYVAL %NULL, 0, MutexName)
        END IF
       ' store the updated control member in the mapping area
       ' the returned version is in C to be returned
        @pC = C
        'UnmapViewOfFile hMemoryFile
        UnmapViewofFile BYVAL pC
   ELSE
       PRINT "Error Creating Memory File, GetLastError=" & STR$(LastError)
       FUNCTION = LastError
   END IF
END FUNCTION

------------------
Michael Mattias
Racine WI USA
[email protected]



[This message has been edited by Michael Mattias (edited April 09, 2002).]

[Edwin Knoppert]

Small error:

Print "Error on Wait for Mutex# & STR$(LastError)

Should be:

Print "Error on Wait for Mutex#" & STR$(LastError)