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 :
permettent respectivement de lire ou écrire 1 octet (byte), 2 octets(integer), 4 octets (long), 8 octets(codages 64 bits)GetMem1, GetMem2, GetMem4, GetMem8, PutMem1, PutMem2, PutMem4, PutMem8
Outre l’avantage d’être distribuées par le runtime, elles procurent aussi un gain en vitesse par rapport à RtlMoveMemory.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)
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é)
Ces 2 exemples montrent toute la puissance de l’utilisation des pointeurs sous VB
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
et qu’il est même possible d’optimiser certaines fonctions natives (vartype par exemple est sensiblement moins rapide qu’un traitement avec GetMem2 …)
Partager