Date de création : 31/12/2006 à 01:33:00 0 Commentaire(s)

sebdraluorg

Ce code permet de recuperer et de modifier la taille du Cache System comme CacheSet de SysInternals...

Notez que pour modifier la taille du cache vous devez avoir le privilege SE_INCREASE_QUOTA_NAME

Pour Vider le cahce, mettez -1 pour MinimumWorkingSet et pour MaximumWorkingSet.

++

Private Declare Function NtSetSystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As Long, ByVal SystemInformation As Long, ByVal SystemInformationLength As Long) As Long
Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As Long, ByVal SystemInformation As Long, ByVal SystemInformationLength As Long, ReturnLength As Long) As Long

Private Const SystemCacheInformation As Long = 21

Public Type SYSTEM_CACHE_INFORMATION
    CurrentSize As Long
    PeakSize As Long
    PageFaultCount As Long
    MinimumWorkingSet As Long
    MaximumWorkingSet As Long
    Unused(4) As Long
End Type


Private Declare Function RtlNtStatusToDosError Lib "NTDLL.DLL" (ByVal hError As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Private Const FORMAT_MESSAGE_FROM_SYSTEM    As Long = &H1000
Private Const LANG_NEUTRAL                  As Long = &H0
Private Const SUBLANG_DEFAULT              As Long = &H1

Public Function GetError(ByVal hError As Long) As String

    Dim Buffer As String
   
    Buffer = Space$(1024)
    FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, hError, LANG_NEUTRAL, Buffer, Len(Buffer), ByVal 0&
    GetError = Trim$(Buffer)
   
End Function


Public Function SetSystemCache(ByRef SCI As SYSTEM_CACHE_INFORMATION) As String

    Dim hRes        As Long
   
    hRes = NtSetSystemInformation(SystemCacheInformation, VarPtr(SCI), Len(SCI))
    SetSystemCache = GetError(RtlNtStatusToDosError(hRes))

End Function

Public Function GetSystemCache(ByRef SCI As SYSTEM_CACHE_INFORMATION) As String

    Dim hRes  As Long
   
    hRes = NtQuerySystemInformation(SystemCacheInformation, ByVal VarPtr(SCI), Len(SCI), ByVal 0&)
    GetSystemCache = GetError(RtlNtStatusToDosError(hRes))

End Function

Vous devez être connecté pour pouvoir poster un commentaire.