Renfield
|
version .NET : (pas forcément optimale, hein, je tatonne ^^)
mais ca fonctionne...
Imports System.Runtime.InteropServices
Public Class SharedValues
' Pour que plusieurs programmes puissent échanger ces valeurs, il suffit de modifier la clé ci dessous :
Private Const MAPKEY As String = "SharedValues"
' Taille du tampon (8 Ko)
Private Const MAPSIZE = &H2000&
Private Const SECTION_MAP_READ As Integer = &H4
Private Const SECTION_MAP_WRITE As Integer = &H2
Private Const FILE_MAP_READ As Integer = SECTION_MAP_READ
Private Const FILE_MAP_WRITE As Integer = SECTION_MAP_WRITE
Private Const INVALID_HANDLE_VALUE As Integer = &HFFFFFFFF
Private Const PAGE_READWRITE As Integer = &H4
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Integer) As Integer
Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" (ByVal hFile As Integer, ByVal lpFileMappingAttributes As Integer, ByVal flProtect As Integer, ByVal dwMaximumSizeHigh As Integer, ByVal dwMaximumSizeLow As Integer, ByVal lpName As String) As Integer
Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFileMappingObject As Integer, ByVal dwDesiredAccess As Integer, ByVal dwFileOffsetHigh As Integer, ByVal dwFileOffsetLow As Integer, ByVal dwNumberOfBytesToMap As Integer) As Integer
Private Declare Function OpenFileMapping Lib "kernel32.dll" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal lpName As String) As Integer
Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByRef lpBaseAddress As IntPtr) As Integer
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByVal Destination As IntPtr, ByVal Length As Integer)
Private mhMap As Integer
Private msName As String
Private mnSize As Integer
Public ReadOnly Property Name() As String
Get
Name = msName
End Get
End Property
Public ReadOnly Property Size() As Integer
Get
Size = mnSize
End Get
End Property
Public Sub New()
Load(MAPKEY, MAPSIZE)
End Sub
Public Sub New(ByRef vsName As String)
Load(vsName, MAPSIZE)
End Sub
Public Sub New(ByVal vnSize As Integer)
Load(MAPKEY, vnSize)
End Sub
' Cette méthode permet de changer de mappage, ou de changer la taille de celui-ci...
Public Sub New(ByRef vsName As String, ByVal vnSize As Integer)
Load(vsName, vnSize)
End Sub
Private Sub Load(ByRef vsName As String, ByVal vnSize As Integer)
Dim pMem As IntPtr
' Si un mappage est ouvert, on le ferme...
If mhMap Then
CloseHandle(mhMap)
End If
' On enregistre le nom du mappage
msName = vsName
' Et on tente d'ouvrir le mappage
mhMap = OpenFileMapping(FILE_MAP_READ Or FILE_MAP_WRITE, 0, msName)
If mhMap = 0 Then
' Le mappage n'existe pas ?
' Nous allons donc le créer. Il aura la taille demandée par l'utilisateur.
mnSize = vnSize
' Création du mappage
mhMap = CreateFileMapping(INVALID_HANDLE_VALUE, 0, PAGE_READWRITE, 0, mnSize, msName)
If mhMap Then
' Le premier Integer dans le fichier sera la taille du mappage.
' Tout le reste est remplit par des 0
pMem = MapViewOfFile(mhMap, FILE_MAP_WRITE, 0, 0, 0)
If pMem Then
Marshal.WriteInt32(pMem, 0, mnSize)
ZeroMemory(New IntPtr(pMem.ToInt32 + 4), mnSize - 4)
UnmapViewOfFile(pMem)
End If
End If
Else
' Le mappage existe déjà. Nous lisons la taille de celui-ci
pMem = MapViewOfFile(mhMap, FILE_MAP_READ, 0, 0, 0)
If pMem Then
mnSize = Marshal.ReadInt32(pMem, 0)
UnmapViewOfFile(pMem)
End If
End If
End Sub
Public Sub Unload()
' Fermeture du mappage
If mhMap Then
CloseHandle(mhMap)
mhMap = 0
End If
End Sub
' Permet de récupérer une valeur en particulier du Stream.
Public Property Value(ByVal vsName As String) As String
Get
Value = vbNullString
Try
For Each sPair As String In Stream.Split(vbNullChar)
If sPair.StartsWith(vsName & "=") Then
Value = sPair.Substring(vsName.Length + 1)
Exit For
End If
Next sPair
Catch e As NullReferenceException
End Try
End Get
Set(ByVal value As String)
Try
Dim xsParts() As String = Stream.Split(vbNullChar)
For i As Integer = 0 To xsParts.GetUpperBound(0)
If xsParts(i).StartsWith(vsName & "=") Then
' Sinon, on modifie l'élement de notre tableau
xsParts(i) = vsName & "=" & value
' Et on reconstruit le Stream
Stream = Join(xsParts, vbNullChar)
Exit Property
End If
Next i
Stream = Join(xsParts, vbNullChar) & vbNullChar & vsName & "=" & value
Catch e As NullReferenceException
Stream = vsName & "=" & value
End Try
End Set
End Property
' Permet de récupérer le Stream enregistré dans le mapping
Public Property Stream() As String
Get
Dim pMem As IntPtr
Stream = vbNullString
pMem = MapViewOfFile(mhMap, FILE_MAP_READ, 0, 0, 0)
If pMem Then
' On récupère la taille effective des données
Dim nLength As Integer = Marshal.ReadInt32(pMem, 4)
If nLength > 0 Then
Dim xbData As Char() = New String(" ", nLength).ToCharArray
Marshal.Copy(New IntPtr(pMem.ToInt32 + 8), xbData, 0, nLength)
Stream = New String(xbData, 0, nLength)
End If
UnmapViewOfFile(pMem)
End If
End Get
Set(ByVal value As String)
Dim pMem As IntPtr
pMem = MapViewOfFile(mhMap, FILE_MAP_WRITE, 0, 0, 0)
If pMem Then
Dim xbData As Char() = value.ToCharArray
' On regarde si le mapping est assez grand pour contenir les données
If xbData.Length < mnSize Then
' Tous les autres bits sont remis à 0
ZeroMemory(New IntPtr(pMem.ToInt32 + 8 + xbData.Length), mnSize - 8 - xbData.Length)
' On ajoute la taille des données en début de mapping (après la taille du mapping)
Marshal.WriteInt32(pMem, 4, xbData.Length)
' Et, s'il y a des données, on les ajoutes dans le mapping
If xbData.Length > 0 Then
Marshal.Copy(xbData, 0, New IntPtr(pMem.ToInt32 + 8), xbData.Length)
End If
End If
UnmapViewOfFile(pMem)
End If
End Set
End Property
End Class
|