PARTAGE DE VARIABLES...

Commentaire de Renfield le 02/07/2008 15:20:53 administrateur CS

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