How to make a memory page not cached out
In the previous article, i showed how to list pages.
Modifying the attributes is not a big job, but it seems only to work on memory pages with write access. I have not discovered yet how to enable write on a memory page that is marked as read-only.
This code will loop all memory pages, if it finds an executable page with write access, it will set the NOCACHE attribute, forcing windows never to swap out this memory page.
Warning: writing wrong values may cause a process to suddenly crash. Make sure you are not busy with important documents on your computer while running this code.
We use the VirtualProtectEx api to modify the attribute.
procedure TForm1.Button1Click(Sender: TObject);
var i,l:integer;
pid:THandle;
meminfo:MEMORY_BASIC_INFORMATION;
memstart:pointer;
memsize:Integer;
newprotect, oldprotect: DWORD;
var s:String;
var lpMsgBuf : PCHAR;
begin
button1.enabled := false;
for i:=0 to 2000 do //
begin //PROCESS_QUERY_INFORMATION
pid:=OpenProcess (PROCESS_ALL_ACCESS{PROCESS_VM_OPERATION or PROCESS_QUERY_INFORMATION or PROCESS_VM_WRITE}, false, i*4);
if pid<>0 then
begin
memstart := 0;
l:=VirtualQueryEx (pid,
memstart,
MemInfo,
SizeOf(MEMORY_BASIC_INFORMATION));
while (l=SizeOf(MEMORY_BASIC_INFORMATION)) do
begin
Application.ProcessMessages;
if Application.Terminated then
break;
if meminfo.Protect = PAGE_EXECUTE_READ then
//make it readwrite:
newprotect := PAGE_EXECUTE_READWRITE
else
if 0<>(memInfo.Protect and (PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE)) then
newprotect := meminfo.Protect or PAGE_NOCACHE
else
newProtect := meminfo.Protect;
memstart := meminfo.BaseAddress;
memsize := meminfo.regionsize;
if (meminfo.state=MEM_COMMIT) and
((meminfo.protect<>newprotect)) and
((meminfo.protect and PAGE_GUARD)=0)// and
// ((meminfo.Type_9 and (mem_private or mem_mapped))=0)
then //allocated
begin
if not VirtualProtectEx (pid,
memstart,
memsize,
newprotect,
@oldprotect) then
begin
FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, Nil, GetLastError, $00000400, (*LANG_NEUTRAL, SUBLANG_DEFAULT*) @lpMsgBuf, 0, Nil );
if lpMsgBuf <> Nil then
begin
// showmessage (lpMsgBuf);
LocalFree(Integer(lpMsgBuf));
end;
end
else
//;// showmessage ('ok');
memsize := memsize + 0;
sleep(2);
end;
integer(memstart):=integer(memstart)+memsize;
l:=VirtualQueryEx (pid,
memstart,
MemInfo,
SizeOf(MEMORY_BASIC_INFORMATION));
end;
closehandle (pid);
if Application.Terminated then
break;
end;
end;
button1.enabled := true;
end;