Shared Memory - who wants it?

[Judd]

I've written a little app that demonstrates the use of shared memory on a Windows NT platform (using VB6 SP3).

I don't know if works on other platforms, but I'd be interested to find out if it does (it relys on standard API, so I should think it would).

Anyone who wants the source, reply here (esp. if you have access to a different platform to run this on).

Cheers big ears,



Dan

[Judd]

Nobody interested in this? Oh well....

(Honest you can use it for loads of stuff ... like ... err ... loads of things ... honest ... OK then what can YOU use it for?)



Dan

[Crazy D]

I replied in the API section....
sure post the code, I'll test it on W2K...

[Judd]

I hesitated at first, because this is quite lengthy, but having seen some of the s**t you guys post to ChitChat ...

(NB1 - that was a joke OK, I don't need to be BK flame grilled for it)

(NB2 ... and I just love that 'lil green guy )

Right, this is it. Its not very complicated, just the basics. If you know a bit more about file pointers and file accessing you can make this a bit more intelligent (i.e. appending to the memory instead of just overwriting it). But we'll stick to the basics for now....

I have a form with a textbox called txtInput, set Multiline to true and set Maxlength to 128. Stick on a couple of buttons: cmdRead and cmdWrite. Then add this code:

Option Explicit

Private Sub cmdRead_Click()
    'Copy the 'file' from its memory location
    CopyMemory glpResult, glpMapPointer, 256
    txtInput.Text = gsResult
End Sub

Private Sub cmdWrite_Click()
    'Lets get some stuff that's been typed in
    gsBuffer = txtInput.Text
    If Len(gsBuffer) < 128 Then gsBuffer = gsBuffer & String(128 - Len(gsBuffer), " ")
    glpBuffer = StrPtr(gsBuffer)
    
    'If we've mapped a file (we should have by now) lets just copy some memory to save
    'some time.
    If glpMapPointer Then
        CopyMemory glpMapPointer, glpBuffer, 256
    Else ' Map the file again
        Call GetLock(LOCKNAME)
        gbRes = SharedFile(SHARENAME, glHandle, glpBuffer, glNumberOfBytesToWrite)
        Call PutLock(LOCKNAME)
    End If
End Sub

Private Sub Form_Load()
    
    'Set up an empty file, and map it into memory
    gsBuffer = String(128, " ")
    glpBuffer = StrPtr(gsBuffer)
    gsResult = String(128, " ")
    glpResult = StrPtr(gsResult)
    glNumberOfBytesToWrite = 256
    
    Call GetLock(LOCKNAME)
    gbRes = SharedFile(SHARENAME, glHandle, glpBuffer, glNumberOfBytesToWrite)
    Call PutLock(LOCKNAME)
   
End Sub

In a Module add this code:

Option Explicit

Global gbRes As Boolean
Global glHandle As Long
Global gsBuffer As String
Global gsResult As String
Global glpBuffer As Long
Global glpResult As Long
Global glNumberOfBytesToWrite As Long

Public Const SHARENAME = "MyShare"
Public Const LOCKNAME = "Generous" & vbNullChar

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_ALWAYS = 4
Public Const CREATE_NEW = 1
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_MAP_WRITE = &H2
Public Const PAGE_READWRITE = &H4
Public Const ZERO = &H0
Public Const LONG_WAIT = 1000000

Global glpMapPointer As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Public Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
    (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, _
    ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, _
    ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
    
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, _
    lpFileSizeHigh As Long) As Long

Public Declare Function GetLastError Lib "kernel32" () As Long

Public Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, _
    ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, _
    ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long

Public Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long

Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
    ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long

'Locking stuff
Public Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _
    (ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, _
    ByVal lpName As String) As Long
    
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
    
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long

Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Function SharedFile(ByVal SHARENAME As String, ByVal handle As Long, _
                        ByRef lpBuffer As Long, nNumberOfBytesToWrite As Long) As Boolean

Dim my_error As Long                'error code from Win32 API
Dim the_file As String              'filename to open/create
Dim lpOverlapped As Long            'not used
Dim result_1 As Long                'whether file-write worked okay
Dim lpNumberOfBytesWritten As Long  'self-explanatory
Dim dwSize As Long                  'size of file in bytes
Dim CreatedHere As Boolean          'TRUE if new file created

SharedFile = True
CreatedHere = False

'----------------------------------
'Obtain the path to create the file
'----------------------------------

the_file = Trim(App.Path)

'----------------------
'Add the name for array
'----------------------
    
the_file = the_file & "\" & SHARENAME & ".shf" & vbNullChar

    '--------------------
    'Try to open the file
    '--------------------

    handle = CreateFile(the_file, (GENERIC_READ Or GENERIC_WRITE), _
                            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
                            ZERO, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ZERO)
    
    'That didn't work because the file doesn't exist, we must create it
    If (handle = INVALID_HANDLE_VALUE) Then
        handle = CreateFile(the_file, (GENERIC_READ Or GENERIC_WRITE), _
                                (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
                                ZERO, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, ZERO)

        CreatedHere = True
    End If

   'Check it exists, then the size
    If (handle <> ZERO) Then

        dwSize = GetFileSize(handle, ZERO)  'pass in NULL-> file isn't huge

        'Check size, and extend if necessary
        If (dwSize < nNumberOfBytesToWrite) Then

            lpOverlapped = ZERO
            result_1 = WriteFile(handle, lpBuffer, nNumberOfBytesToWrite, _
                                lpNumberOfBytesWritten, lpOverlapped)

            If (result_1 = ZERO) Then

                'only ever used when debugging
                my_error = GetLastError()

                'return the appropriate failure flag
                SharedFile = False
                Exit Function
            End If
            
            'because we extended, just like creating
            CreatedHere = True

        End If
    Else
        'again, used solely in the debugger
        my_error = GetLastError()
        'again return the appropriate failure flag
        SharedFile = False
        Exit Function
    End If

    SharedFile = FileMapping(SHARENAME, handle, nNumberOfBytesToWrite, CreatedHere)

End Function

Public Function FileMapping(shared_name, hFile, size, created_here) As Boolean

Dim hMapFile As Long                'handle to the memory-mapped file
Dim hFileMappingObject As Long      'handle of a file-mapping object
Dim dwNumberOfBytesToMap As Long    'number of bytes to map (share)
Dim my_error As Long                'error code of a Win32 API call
Dim shared_handle As Long           'handle of a shared mapped file
Dim i As Long                       'loop counter
    
FileMapping = True

'-------------------------------------
'Open the file mappings if they exists
'-------------------------------------

shared_handle = OpenFileMapping(FILE_MAP_WRITE, ZERO, shared_name)

If (shared_handle = ZERO) Then
    hMapFile = CreateFileMapping(hFile, ZERO, PAGE_READWRITE, ZERO, ZERO, shared_name)
Else
    hMapFile = shared_handle
End If

'----------------------------------
'Create a mapping of the given file
'----------------------------------
    
If (hMapFile <> ZERO) Then
    '----------------------
    'Create the mapped view
    '----------------------

    hFileMappingObject = hMapFile
    dwNumberOfBytesToMap = size
    glpMapPointer = MapViewOfFile(hFileMappingObject, FILE_MAP_WRITE, ZERO, ZERO, _
                                                        dwNumberOfBytesToMap)

    If (created_here) Then
        'You could behave differently if you've created the file
    End If
Else
    FileMapping = False
End If
End Function

Public Sub GetLock(ByVal Name As String)

Dim hHandle As Long
Dim evnt As Long

'---------------------------------
'Ensure null-terminated mutex name
'---------------------------------

If (Right(Name, 1) <> vbNullChar) Then
    Name = Name & vbNullChar
End If

'---------------------------------------------------------------------
'Create the mutex, or get a handle to it if another process created it
'---------------------------------------------------------------------

hHandle = CreateMutex(ZERO, ZERO, Name)

If (hHandle <> 0) Then
    evnt = WaitForSingleObject(hHandle, LONG_WAIT)
Else
    Exit Sub
End If

'----------------
'Close the handle
'----------------
evnt = CloseHandle(hHandle)

End Sub
    
Public Sub PutLock(ByVal Name As String)

Dim hHandle As Long
Dim evnt As Long

'---------------------------------
'Ensure null-terminated mutex name
'---------------------------------

If (Right(Name, 1) <> vbNullChar) Then
    Name = Name & vbNullChar
End If

'---------------------------------------------------------------------
'Create the mutex, or get a handle to it if another process created it
'---------------------------------------------------------------------

hHandle = CreateMutex(ZERO, ZERO, Name)

    If (hHandle <> 0) Then
        'release the mutex for other processes to get
        evnt = ReleaseMutex(hHandle)
        'Close the handle
        evnt = CloseHandle(hHandle)
    End If
End Sub

Compile, run up two instances and you can send messages between them using read and write. If you can't be bothered with all that I can e-mail you the whole jobby.

Thats it.



Dan

[Judd]

Anyone?

[buddhi]

Please Help me............!!

Dear I need to know how to use your code to open and share a memory file not in the disk...In the PageFile...

If you can help me contact me through this page...

If you can please give me the required modification for this code...

Thanking you....

-Buddhi

[Judd]

Hopefully this will help you out. This method always creates a file - you'd have to be cleverer than me to figure out how to use only the page file. But you do also get a shared memory file, which I assume is the main thing you're after...