VirtualFreeEx La Suite

Question

Bonjour,
Voila maintenant j'ai un code propre je pense, le programme ne me renvoie aucune erreur mais la mémoire allouée avec VirtualAllocEx n'est jamais libérée.
J'ai fait un test en allouant 10 Mo dans explorer.
Regardez dans le gestionnaire des taches la mémoire augmente sans jamais se libérer! (pour la libérer fermer le processus explorer et le relancer)
J'ai repris le code de plein de programmes différents qui utilisent VirtualAllocEx et VirtualFreeEx et ca fait exactement la meme chose. A croire qu'il y a un bug dans la fonction ou que beaucoup de monde ne sait pas l'utiliser !

Avis a la population, le premier qui trouve a gagné....

voici le code a ajouter dans un module :

--------------------------------------------------------------

Option Explicit

Public Const PAGE_READWRITE As Long = &H4
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const SYNCHRONIZE As Long = &H100000
Public Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Public L_FI As Long, R_FI1 As Long, R_FI2 As Long, R_FI3 As Long, R_FI4 As Long, R_FI5 As Long, R_FI6 As Long, R_FI7 As Long, R_FI8 As Long

Public Const MEM_RELEASE = &H8000
Public Const MEM_COMMIT As Long = &H1000

Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Private Function GetSysLVHwnd() As Long
   Dim h As Long
   h = FindWindow("Progman", vbNullString)
   h = FindWindowEx(h, 0, "SHELLDLL_defVIEW", vbNullString)
   GetSysLVHwnd = FindWindowEx(h, 0, "SysListView32", vbNullString)
End Function

Sub Main()
   Dim pid As Long
   Dim h As Long
   Dim AllocMemory As Long
   
   On Error GoTo erreur
   
   h = GetSysLVHwnd
   GetWindowThreadProcessId h, pid

   AllocMemory = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
   
   R_FI1 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI2 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI3 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI4 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI5 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI6 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI7 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)
   R_FI8 = VirtualAllocEx(AllocMemory, ByVal 0, LenB(L_FI), MEM_COMMIT, PAGE_READWRITE)

   VirtualFreeEx ByVal AllocMemory, R_FI1, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI2, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI3, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI4, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI5, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI6, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI7, 0, MEM_RELEASE
   VirtualFreeEx ByVal AllocMemory, R_FI8, 0, MEM_RELEASE
   
   CloseHandle AllocMemory
 
 GoTo endprog

erreur:
If Err.Number <> 20 Then
MsgBox " Err.Description = " & Err.Description & vbCrLf & " LastDllError= " & Err.LastDllError & vbCrLf & " err.number= " & Err.Number & vbCrLf & "  Err.source= " & Err.Source, vbExclamation, "Erreur"
Err.Clear
Resume Next
End If

endprog:
End Sub

ShareVB · Answer

salut

bon je viens de retester : tu changes
Public Const MEM_RELEASE = &H8000
Public Const MEM_COMMIT As Long = &H1000
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

en

Public Const MEM_RELEASE = &H8000&
Public Const MEM_COMMIT As Long = &H1000&
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long,byval lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

voila

ShareVB