La suite logique concernant les pointeurs évoqués la semaine dernière, c’est la lecture et l’écriture en mémoire.

Différentes fonctions d’écriture et de lecture en mémoire peu utilisées :
GetMem1, GetMem2, GetMem4, GetMem8, PutMem1, PutMem2, PutMem4, PutMem8
permettent respectivement de lire ou écrire 1 octet (byte), 2 octets(integer), 4 octets (long), 8 octets(codages 64 bits)
Public Declare Sub GetMem1 Lib "MSVBVM60" (ByVal Addr As Long, retVal As Byte)
Public Declare Sub GetMem2 Lib "MSVBVM60" (ByVal Addr As Long, retVal As Integer)
Public Declare Sub GetMem4 Lib "MSVBVM60" (ByVal Addr As Long, retVal As Long)
Public Declare Sub GetMem8 Lib "MSVBVM60" (ByVal Addr As Long, retVal As Currency)

Public Declare Sub PutMem1 Lib "MSVBVM60" (ByVal Addr As Long, ByRef NewVal As Byte)
Public Declare Sub PutMem2 Lib "MSVBVM60" (ByVal Addr As Long, ByRef NewVal As Integer)
Public Declare Sub PutMem4 Lib "MSVBVM60" (ByVal Addr As Long, ByRef NewVal As Long)
Public Declare Sub PutMem8 Lib "MSVBVM60" (ByVal Addr As Long, ByRef NewVal As Currency)
Outre l’avantage d’être distribuées par le runtime, elles procurent aussi un gain en vitesse par rapport à RtlMoveMemory.

Exemple 1 d’utilisation conjoint avec les pointeurs : l’équivalent de VarType

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
                Public Function GetVarType(var) As Integer
                    ' Valeurs de retour                                 '
                    '---------------------------------------------------'
                    '   IsEmpty     =   &h0     '   vbEmpty             '
                    '   IsNull      =   &h1     '   vbNull              '
                    '   IsInteger   =   &h2     '   vbInteger           '
                    '   IsLong      =   &h3     '   vbLong              '
                    '   IsSingle    =   &h4     '   vbSingle            '
                    '   IsDouble    =   &h5     '   vbLong              '
                    '   IsCurrency  =   &h6     '   vbCurrency          '
                    '   IsDate      =   &h7     '   vbDate              '
                    '   IsString    =   &h8     '   vbString            '
                    '   IsNothing   =   &h9     '   vbObject            '
                    '       IsObject    =   IsNothing                   '
                    '   IsError     =   &hA     '   vbError             '
                    '   IsBoolean   =   &hB     '   vbBoolean           '
                    '       IsVariant   =   IsEmpty                     '   si tableau= &hC     !
                    '       IsUndefined =   IsEmpty                     '   si tableau= &hC     !
                    '   IsDataObject=   &hD     '   vbDataObject        '
                    '   IsDecimal   =   &hE     '   vbDecimal           '
                    '   IsByte      =   &h11    '   vbByte              '
                    '   IsUDT       =   &h24    '   vbUserDefinedType   '
 
                    '   IsArray     =   &H2000  '   vbArray  8192       '
                    '   IsByRef  =   &H4000  '   ByRef   16384       '
 
 
                    GetMem2 ByVal VarPtr(var), GetVarType
                End Function

Exemple 2 d’utilisation conjoint avec les pointeurs :
connaître le nombre de dimensions d’un tableau ( si 0 : tableau non dimensionné)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
        Public Type SAFEARRAYBOUND
            cElements   As Long             ' Nb d'éléments dans la dimension       '
            lLbound     As Long             ' lbound de la dimension                '
        End Type
        Public Type SAFEARRAY
            cDims       As Integer          ' Nb de dimensions du Tableau           '
            fFeatures   As Integer          ' Attribut : tableau fixe/variable ...  '
            cbElements  As Long             ' Nb d'éléments total du tableau        '
            cLocks      As Long             ' Nb de verrouillages                   ' 
            pvData      As Long             ' Pointeur vers les données             '
 
            rgsabound() As SAFEARRAYBOUND   ' Tableau des tailles de chaque dimension
        End Type
 
 
        Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
                Public Function GetArrayDimensions(arr) As Integer
                   Dim ppSA As Long, pSA As Long, intType As Integer
 
                   intType = GetVarType(arr)                    'GetMem2 ByVal VarPtr(arr), intType
                   If intType And &H2000& Then                  '   equiv. VarType(arr)=vbArray     '
                        GetMem4 ByVal VarPtr(arr) + 8, ppSA
 
 
                        If intType And &H4000& Then             '   ByRef ? : passage par référence '
                            GetMem4 ByVal ppSA, pSA
 
                        Else                                    '   ByVal                           '
                           pSA = ppSA
                        End If
 
                        If pSA Then
 
                            ' Cas particulier des tableaux d'objects initialisés à 1 par défaut     '
                            '———————————————————————————————————————————————————————————————————————'
                            If intType And vbObject Then
                                    Dim SA As SAFEARRAY
                                    CopyMemory ByVal VarPtr(SA.cDims), ByVal pSA, 16
 
                                    If SA.cDims = 1 Then
                                        ReDim SA.rgsabound(1 To 1)
                                        CopyMemory ByVal VarPtr(SA.rgsabound(1)), ByVal pSA + 16, SA.cDims * Len(SA.rgsabound(1))
 
                                        GetArrayDimensions = Abs(SA.rgsabound(1).cElements <> 0)
 
                                    Else
                                        GetArrayDimensions = SA.cDims
                                    End If
                            '———————————————————————————————————————————————————————————————————————'
 
                            Else
                                GetMem2 ByVal pSA, GetArrayDimensions
                            End If
                        End If
                   End If
 
                End Function
Ces 2 exemples montrent toute la puissance de l’utilisation des pointeurs sous VB
et qu’il est même possible d’optimiser certaines fonctions natives (vartype par exemple est sensiblement moins rapide qu’un traitement avec GetMem2 …)