OPTIMISATION GESTION MÉMOIRE SUR SYSTEM NT (W2K XP)

' API, Type pour Infos mémoire -------------------------------------------------------------------------------------------
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Type MEMORYSTATUS
    dwLength As Long            'la taille de la structure.
    dwMemoryLoad As Long        'le % de mémoire actuellement utilisé.
    dwTotalPhys As Long         'la taille totale de la mémoire physique (en octets).
    dwAvailPhys As Long         'la taille de la mémoire physique disponible (en octets).
    dwTotalPageFile As Long     'la taille totale que peut atteindre le fichier d'échange (en octets).
    dwAvailPageFile As Long     'l'espace disponible dans le fichier d'échange (en octets).
    dwTotalVirtual As Long      'la mémoire totale pouvant être utilisée par l'application courante (en octets).
    dwAvailVirtual As Long      'l'espace libre totale (en octets).
End Type

'API, Constantes pour mise à jour BdR ------------------------------------------------------------------------------------
    'Const HKEY_CLASSES_ROOT = &H80000000
    'Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    'Const HKEY_USERS = &H80000003
    'Const HKEY_DYN_DATA = &H80000004
'pour créer ou ouvrir une clé
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, _
     ByVal lpSubKey As String, phkResult As Long) As Long
'pour fixer ou créer une valeur
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, _
     ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, _
     lpData As Any, ByVal cbData As Long) As Long
'pour fermer une clé ouverte
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long

' variables
Global lgMem As MEMORYSTATUS
Global szBrut As Long

Public Sub Main()
Dim Ret As Long, HdK As Long
Const memoryK As String = "SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management"
Const REG_DWORD As Long = 4
Const REG_SZ As Long = 1
Dim RS As Object, msg As String
'création d'un point de restauration par précaution
Set RS = GetObject("winmgmts:\\.\root\default:Systemrestore")
    'info création du point de restauration
    msg = "Un point de restauration a été créé." & vbCr
    msg = msg & "Il est daté du " & Date & " " & Time
    

If (RS.createrestorepoint("Point de Restauration automatique", 0, 100)) = 0 Then
    MsgBox msg
        'Identifie la taille de la mémoire sur la machine
    GlobalMemoryStatus lgMem
    szBrut = lgMem.dwTotalPhys
    szBrut = (szBrut \ (1024 ^ 2)) + 1 'ramène la taille en Mo
    
    
    'Optimise la gestion de la mémoire en fonction de sa taille
    
        'DisablePagingExecutive (Force le noyau du système à être conservé en mémoire au lieu du disque)
    If szBrut > 512 Then    'seulement si taille mémoire importante, > 128 Mo, ici mis en place si >512 Mo
        Ret = RegCreateKey(HKEY_LOCAL_MACHINE, memoryK, HdK)
        If Ret = 0 Then
            'Fixe la valeur à 1 (0=désactivé, 1=activé), Si la valeur n'existe pas, elle sera automatiquement crée.
            Ret = RegSetValueEx(HdK, "DisablePagingExecutive", 0&, REG_DWORD, 1, 4)
            'Ferme la clé
            RegCloseKey HdK
        End If
    End If
    
        'IoPageLockLimit (quantité mémoire allouée aux opérations Entrées Sorties, par défaut à 0 équivalent à 512K)
    Ret = RegCreateKey(HKEY_LOCAL_MACHINE, memoryK, HdK)
    Select Case szBrut ' à allouer en fonction de la taille mémoire
        Case Is < 65 'si <=64 Mo, soustraire 7 Mo de la quantité totale
            RegSetValueEx HdK, "IoPageLockLimit", 0&, REG_DWORD, (szBrut - 7) * 1024, 4
        Case Is > 512 'si >512 Mo, soustraire 64 Mo de la quantité totale
            RegSetValueEx HdK, "IoPageLockLimit", 0&, REG_DWORD, (szBrut - 64) * 1024, 4
        Case Else 'si de 64 à 512 Mo, soustraire 16 Mo de la quantité totale
            RegSetValueEx HdK, "IoPageLockLimit", 0&, REG_DWORD, (szBrut - 16) * 1024, 4
    End Select
    
        'LargeSystemCache (accélère performance du cache disque)
    If szBrut > 128 Then    'seulement si taille mémoire > 128 Mo
            'Fixe la valeur à 1 (0=désactivé, 1=activé), Si la valeur n'existe pas, elle sera automatiquement crée.
            Ret = RegSetValueEx(HdK, "LargeSystemCache", 0&, REG_DWORD, 1, 4)
    End If
    RegCloseKey HdK  'Ferme la clé
Else
    MsgBox "Cette optimisation n'a pas été exécutée car il n'a pas été possible de créer un point de restauration !", vbExclamation, "Optimisation non traitée par précaution"
End If
'libère l'objet
Set RS = Nothing


End Sub