[API+VB6] VirtualAlloc / Free / Unalloc

Bonjour à tous,

J'entends ci et là que VB6 ne permet pas d'allouer à notre guise la mémoire dans nos programmes, contrairement à C ou C++.

A quoi peuvent bien me servir ces API alors ?
Je me pose la question dans le cadre d'une étude préliminaire à la réalisation d'un gestionnaire de mémoire en VB6. (mémoire, comprennez ressource système pas document à remettre en fin de master :aie: )

Merci

Mouis, en fouillant sur le CD MSDN on trouve sous
Platform SDK > Windows Base Services > General Library > Memory Management > Memory Management Reference.
Toutes les fonctions de l'API Windows qui consernent la mémoire s'y trouvent expliquées. T'auras deviné que j'ai la version anglaise...

Mais en natif, VB ne comprend pas de commandes de gestion de mémoire.

Un exemple complet extrait de API-Guide de feu AllAPI.net :cry:

J'ai pas pris le temps de l'analyser, mais si ça t'amuse ;)

Code:

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
'This project requries a form with a listbox (List1) on it
'and a class module (MemoryBlock)
 
'In the form:
Option Explicit
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
    dwStructSize As Long
    lpszSourceUrlName As Long
    lpszLocalFileName As Long
    CacheEntryType As Long
    dwUseCount As Long
    dwHitRate As Long
    dwSizeLow As Long
    dwSizeHigh As Long
    LastModifiedTime As FILETIME
    ExpireTime As FILETIME
    LastAccessTime As FILETIME
    LastSyncTime As FILETIME
    lpHeaderInfo As Long
    dwHeaderInfoSize As Long
    lpszFileExtension As Long
    dwReserved As Long
    dwExemptDelta As Long
    'szRestOfData() As Byte
End Type
Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, ByVal lpFirstCacheEntryInfo As Long, ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, ByVal lpNextCacheEntryInfo As Long, ByRef lpdwNextCacheEntryInfoBufferSize As Long) As Long
Private Declare Sub FindCloseUrlCache Lib "wininet.dll" (ByVal hEnumHandle As Long)
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim ICEI As INTERNET_CACHE_ENTRY_INFO, Ret As Long
    Dim hEntry As Long, Msg As VbMsgBoxResult
    Dim MemBlock As New MemoryBlock
    'Start enumerating the visited URLs
    FindFirstUrlCacheEntry vbNullString, ByVal 0&, Ret
    'If Ret is larger than 0...
    If Ret > 0 Then
        '... allocate a buffer
        MemBlock.Allocate Ret
        'call FindFirstUrlCacheEntry
        hEntry = FindFirstUrlCacheEntry(vbNullString, MemBlock.Handle, Ret)
        'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
        MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
        'Add the lpszSourceUrlName string to the listbox
        If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
    End If
    'Loop until there are no more items
    Do While hEntry <> 0
        'Initialize Ret
        Ret = 0
        'Find out the required size for the next item
        FindNextUrlCacheEntry hEntry, ByVal 0&, Ret
        'If we need to allocate a buffer...
        If Ret > 0 Then
            '... do it
            MemBlock.Allocate Ret
            'and retrieve the next item
            FindNextUrlCacheEntry hEntry, MemBlock.Handle, Ret
            'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
            MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
            'Add the lpszSourceUrlName string to the listbox
            If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
        'Else = no more items
        Else
            Exit Do
        End If
    Loop
    'Close enumeration handle
    FindCloseUrlCache hEntry
    'Delete our memory block
    Set MemBlock = Nothing
    Msg = MsgBox("Do you wish to delete the Internet Explorer cache?", vbYesNo + vbDefaultButton2 + vbQuestion)
    If Msg = vbYes Then
        'loop trough the entries...
        For Ret = 0 To List1.ListCount - 1
            '...and delete them
            DeleteUrlCacheEntry List1.List(Ret)
        Next Ret
        MsgBox "Cache deleted..."
    End If
End Sub
 
'In the class module 'MemoryBlock':
Option Explicit
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const PAGE_READONLY = &H2
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_NOCACHE = &H200
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpStringDest As String, ByVal lpStringSrc As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private m_VirtualMem As Long, lLength As Long
'Returns the handle of the allocated memory
Public Property Get Handle() As Long
    Handle = m_VirtualMem
End Property
'Allocates a specific amount of bytes in the Virtual Memory
Public Sub Allocate(lCount As Long)
    ReleaseMemory
    m_VirtualMem = VirtualAlloc(ByVal 0&, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    VirtualLock m_VirtualMem, lCount
End Sub
'Reads from the allocated memory and writes it to a specified pointer
Public Sub ReadFrom(hWritePointer As Long, lLength As Long)
    If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
        CopyMemory hWritePointer, Handle, lLength
    End If
End Sub
'Writes to the allocated memory and reads it from a specified pointer
Public Sub WriteTo(hReadPointer As Long, lLength As Long)
    If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
        CopyMemory Handle, hReadPointer, lLength
    End If
End Sub
'Extracts a string from the allocated memory
Public Function ExtractString(hStartPointer As Long, lMax As Long) As String
    Dim Length As Long
    If IsBadStringPtr(hStartPointer, lMax) = 0 Then
        ExtractString = Space(lMax)
        lstrcpy ExtractString, hStartPointer
        Length = lstrlen(hStartPointer)
        If Length >= 0 Then ExtractString = Left$(ExtractString, Length)
    End If
End Function
'Release the allocated memory
Public Sub ReleaseMemory()
    If m_VirtualMem <> 0 Then
        VirtualUnlock m_VirtualMem, lLength
        VirtualFree m_VirtualMem, lLength, MEM_DECOMMIT
        VirtualFree m_VirtualMem, 0, MEM_RELEASE
        m_VirtualMem = 0
    End If
End Sub
Private Sub Class_Terminate()
    ReleaseMemory
End Sub

Ce site était une mine, je l'ai beaucoup regretté :(

Bon suite à première analyze de ce code, j'ai compris comment allouer de la mémoire/désallouer mais uniquement pour utilisation avec COPYMEMORY.

Je cherchais à par exemple allouer une zone, et forcer VB à taper dans cette zone pour chaque instanciation de classe par "new" notamment.

Il semble que ce ne soit pas possible directement, et qu'il faille que je redéfinisse le "new" de VB de façon à créer des objets COM customisés que je pourrais alors stocker où bon me semble.

Tout ceci restant théorique, l'affirmation suivante me paraît néanmoins assez intéressante :

VB6 est un langage PERMETTANT de gérer son propre pool de mémoire.

Merci Alain.