Option Explicit
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)
#End If
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)
#End If
Private Type MONTYPE
L1 As Long
L2 As Long
S As String
End Type
#If Win64 Then
Sub b(MTAdd As LongLong, Lg As Long)
#Else
Sub b(MTAdd As LongPtr, Lg As Long)
#End If
Dim MT As MONTYPE
Dim FixedPart() As Byte
Dim PtrString As LongPtr
' Copier uniquement les parties fixes (L1, L2, et le pointeur de la chaîne)
ReDim FixedPart(0 To LenB(MT) - 1)
CopyMemory ByVal VarPtr(FixedPart(0)), ByVal MTAdd, LenB(MT)
' Reconstruire les parties fixes
CopyMemory MT.L1, FixedPart(0), 4
CopyMemory MT.L2, FixedPart(4), 4
CopyMemory PtrString, FixedPart(8), LenB(PtrString) ' Adresse du contenu de la chaîne
' Reconstruire la chaîne de manière sûre
If PtrString <> 0 Then
MT.S = PtrToString(PtrString)
End If
' Afficher les valeurs
MsgBox MT.L1 & vbCrLf & MT.L2 & vbCrLf & MT.S
End Sub
Private Function PtrToString(ByVal Ptr As LongPtr) As String
Dim StrLen As Long
Dim Buffer() As Byte
' Lire la longueur de la chaîne à partir de la mémoire
CopyMemory StrLen, ByVal Ptr - 4, 4 ' Longueur Unicode
' Copier les données dans un tableau de bytes
If StrLen > 0 Then
ReDim Buffer(0 To (StrLen * 2) - 1) ' Chaque caractère = 2 octets (Unicode)
CopyMemory Buffer(0), ByVal Ptr, StrLen * 2
PtrToString = StrConv(Buffer, vbUnicode)
Else
PtrToString = vbNullString
End If
End Function