Memory Scanner converted to Delphi

//Declarations
type
 PMEMBLOCK = ^MEMBLOCK;
 MEMBLOCK = packed record
  hProc: THandle;
  addr: array of byte;
  size: integer;
  buffer: array of byte;
  searchmask: array of byte;
  matches: integer;
  data_size: integer;
  next: array of PMEMBLOCK;
end;

type
 SEARCH_CONDITION = (COND_UNCONDITIONAL, COND_EQUALS, COND_INCREASED, COND_DECREASED);

const
 WRITABLE = (PAGE_READWRITE and PAGE_WRITECOPY and PAGE_EXECUTE_READWRITE and PAGE_EXECUTE_WRITECOPY);

function Is_In_Search(mb: PMEMBLOCK; offset: cardinal): Boolean;
begin
  Result := 0 <> (mb.searchmask[offset div 8] and (1 shl (offset mod 8)));
end;

procedure Remove_From_Search(mb: PMEMBLOCK; offset: cardinal);
begin
  mb.searchmask[offset div 8] := mb.searchmask[offset div 8] and not (1 shl (offset mod 8));
end;


function create_memblock(hProc: THandle; meminfo: MEMORY_BASIC_INFORMATION; data_size: integer): PMemblock;
var
 mb: PMemblock;
 x:integer;
begin
x:= round(meminfo.RegionSize/8);
 mb:= malloc(sizeof(MEMBLOCK));
 if mb<>ptr(0) then begin
  mb.hProc := hProc;
  mb.addr := meminfo.BaseAddress;
  mb.size := meminfo.RegionSize;
  mb.buffer := malloc(meminfo.RegionSize);
  mb.searchmask := malloc(x);
  memset(mb.searchmask, $ff, x);
  mb.matches := meminfo.RegionSize;
  mb.next := NULL;
  mb.data_size := data_size;
 end;
 result := mb;
end;

procedure free_memblock(mb:pmemblock);
begin
 if mb<>ptr(0) then begin
  if mb.buffer<>ptr(0) then free(mb.buffer);
  if mb.searchmask<>ptr(0) then free(mb.searchmask);
  mb:=nil;
 end;
end;

procedure update_memblock(mb:pmemblock; condition:SEARCH_CONDITION; val:cardinal);
var
 tempbuf: array[0..(128*1024)-1] of Byte;
 bytes_left: cardinal;
 total_read: cardinal;
 bytes_to_read: cardinal;
 bytes_read: cardinal;
 offset: cardinal;
 x, z:integer;
 is_match: boolean;
 temp_val, prev_val: cardinal;
begin
 if mb.matches > 0 then begin
  bytes_left := mb.size;
  total_read := 0;
  mb.matches := 0;
  while (bytes_left<>0) do begin
   if bytes_left > sizeof(tempbuf) then bytes_to_read := sizeof(tempbuf) else bytes_to_read := bytes_left;
   //TO USE IN DLL: tempbuf[0] :=  PBYTE(dword(mb.addr)+total_read)^; // bytes_to_read = 1bytes  {PRECISA CRIAR IF PROS OUTROS TIPOS}
   ReadProcessMemory(mb.hProc, pointer(dword(mb.addr)+total_read), @tempbuf, bytes_to_read, dword(bytes_to_read));

   if bytes_read <> bytes_to_read then break;

   if condition = COND_UNCONDITIONAL then begin
    x:= round(total_read/8);
    z:= round(bytes_read/8);
    memset (pointer(dword(mb.searchmask) + x), $ff, z);
    mb.matches :=+ bytes_read;
   end
   else
   begin
     offset:=0;
     while (offset < bytes_read) do
     begin

       if IS_IN_SEARCH(mb, (total_read+offset)) then begin
        is_match:=false;
        prev_val := 0;
       end;

       case mb.data_size of
       1: begin
            temp_val := tempbuf[offset];
            prev_val := PBYTE(mb.buffer[total_read+offset])^;
            break;
          end;
       2: begin
            temp_val := PWORD(tempbuf[offset])^;
            prev_val := PWORD(mb.buffer[total_read+offset])^;
            break;
          end;
       4: begin
            temp_val := PDWORD(tempbuf[offset])^;
            prev_val := PDWORD(mb.buffer[total_read+offset])^;
            break;
          end;
       end;

       case condition of
          COND_EQUALS: begin
                        is_match := temp_val = val;
                        break;
                       end;
       COND_INCREASED: begin
                        is_match := (temp_val > prev_val);
                        break;
                       end;
       COND_DECREASED: begin
                        is_match := (temp_val < prev_val);
                        break;
                       end;
       end;

       if (is_match) then
        inc(mb.matches)
       else
        REMOVE_FROM_SEARCH(mb,(total_read+offset));

        bytes_left :=- bytes_read;
        total_read :=+ bytes_read;

      Inc(offset, mb.data_size);
     end;
   end;

    memcpy(pointer(dword(mb.buffer) + total_read), @tempbuf, bytes_read);

  end;
  mb.size := total_read;
 end;
end;

function create_scan(pid: cardinal; data_size: integer):PMEMBLOCK;
var
 mb_list: PMEMBLOCK;
 meminfo: MEMORY_BASIC_INFORMATION;
 addr: PBYTE;
 hProc: THandle;
 mb: PMEMBLOCK;
begin
 mb_list:=nil;
 addr:=nil;
 hProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, pid);
 if hProc<>0 then begin
  while 1<>0 do begin
    if VirtualQueryEx(hProc, pointer(addr), meminfo, sizeof(meminfo))=0 then break;

     if ((meminfo.State = MEM_COMMIT) and (meminfo.Protect = WRITABLE )) then begin
      mb := create_memblock(hProc, meminfo, data_size);
      if mb<>ptr(0) then begin
            mb.next := @mb_list;
            mb_list := mb;
      end;
     end;
     addr := pbyte(dword(meminfo.BaseAddress) + dword(meminfo.RegionSize));
  end;
 end;
 result := mb_list;
end;


procedure free_scan(mb_list: PMEMBLOCK);
var
 mb: PMEMBLOCK;
begin
     CloseHandle(mb_list.hProc);

     while mb_list<>ptr(0) do
      begin
           mb := mb_list;
           mb_list := @mb_list.next;
           free_memblock(mb);
     end;
end;

procedure update_scan(mb_list: PMEMBLOCK; condition: SEARCH_CONDITION; val: cardinal);
var
 mb: PMEMBLOCK;
begin
     mb := mb_list;
     while mb<>ptr(0) do
     begin
           update_memblock(mb, condition, val);
           mb := @mb.next;
     end;
end;


procedure dump_scan_info(mb_list: PMEMBLOCK);
var
 mb: PMEMBLOCK;
 i: integer;
begin
     mb := mb_list;
     while mb<>ptr(0) do
     begin
           writeln(Format('0x%08x %d',[mb.addr, mb.size]));

           for i := 0 to mb.size do
           begin
               writeln(Format('%02x',[mb.buffer[i]]));
           end;
           writeln('');

           mb := @mb.next;
     end;
end;

procedure poke(hProc:THANDLE; data_size: integer; addr: cardinal; val: cardinal);
var
 write: cardinal;
begin
 if not ReadProcessMemory(hProc, pointer(addr), @val, data_size, write) then
  writeln('poke failed');
end;

function peek(hProc: THandle; data_size: integer; addr: cardinal):cardinal;
var
 val: cardinal;
 write: cardinal;
begin
 val := 0;

 if not ReadProcessMemory(hProc, pointer(addr), @val, data_size, write) then
   writeln('poke failed');


 result := val;
end;

procedure print_matches(mb_list: PMEMBLOCK);
var
 offset: cardinal;
 mb: PMEMBLOCK;
 val: cardinal;
begin
     mb := mb_list;

     while mb<>ptr(0) do
     begin
           offset:=0;
           while (offset<mb.size) do
           begin

               if IS_IN_SEARCH(mb, offset) then begin
                  val := peek(mb.hProc, mb.data_size, dword(dword(mb.addr) + offset));
                  writeln(format('0x%08x: 0x%08x (%d)',[dword(dword(mb.addr) + offset), val]));
               end;

           Inc(offset, mb.data_size);
           end;

           mb := @mb.next;
     end;
end;

function get_match_count(mb_list: PMEMBLOCK): integer;
var
 mb: PMEMBLOCK;
 count: integer;
begin
    mb := mb_list;
    count := 0;

    while mb<>ptr(0) do
    begin
          count :=+ mb.matches;
          mb := @mb.next;
    end;

    Result := count;
end;

function ui_new_scan: PMEMBLOCK;
var
 scan: PMEMBLOCK;
 pid: dword;
 data_size: integer;
 start_val: cardinal;
 start_cond: SEARCH_CONDITION;
 s: array [0..19] of char;
begin
 scan := nil;

 while 1<>0 do
 begin
  writeln('Digite o pid: ');
  readln(s);
  pid := strtoint(s);
  writeln('Enter the data size: ');
  readln(s);
  data_size := strtoint(s);
  writeln('Enter the start value, or ''u'' for unknown:  ');
  readln(s);
  if s[0] = 'u' then begin
   start_cond := COND_UNCONDITIONAL;
   start_val := 0;
  end else
  begin
   start_cond := COND_EQUALS;
   start_val := strtoint(s);
  end;
   scan := create_scan (pid, data_size);
   if scan<>ptr(0) then break;
   writeln('Invalid scan');
 end;
   update_scan(scan, start_cond, start_val);
   writeln(Format('%d matches found', [get_match_count(scan)]));

   Result := scan;
end;

procedure ui_poke(hProc: THandle; data_size: integer);
var
 addr: cardinal;
 val: cardinal;
 s: array [0..19] of char;
begin
  writeln('Enter the address: ');
  readln(s);
  addr := strtoint(s);
  writeln('Enter the value: ');
  readln(s);
  val := strtoint(s);
  writeln('');
  poke(hProc, data_size, addr, val);
end;

function CaseOfString(s: string; a: array of string): Integer;
begin
  Result := 0;
  while (Result < Length(a)) and (a[Result] <> s) do
    Inc(Result);
  if a[Result] <> s then
    Result := -1;
end;

procedure ui_run_scan;
var
 val: cardinal;
 s: array [0..19] of char;
 scan: PMEMBLOCK;
begin
 scan := ui_new_scan();

 while 1<>0 do
 begin
   writeln('Enter the next value or');
   writeln('[i] increased');
   writeln('[d] decreased');
   writeln('[m] print matches');
   writeln('[p] poke address');
   writeln('[n] new scan');
   writeln('[q] quit');

   readln(s);

   if s[0] = 'i' then begin
    update_scan(scan, COND_INCREASED, 0);
    writeln(Format(' %d matches found', [get_match_count(scan)]));
    break;
   end;

   if s[0] = 'd' then begin
    update_scan(scan, COND_DECREASED, 0);
    writeln(Format(' %d matches found', [get_match_count(scan)]));
    break;
   end;

   if s[0] = 'm' then begin
    print_matches(scan);
    break;
   end;

   if s[0] = 'p' then begin
    ui_poke (scan.hProc, scan.data_size);
    break;
   end;

   if s[0] = 'n' then begin
     free_scan(scan);
     scan := ui_new_scan();
    break;
   end;

   if s[0] = 'q' then begin
    free_scan(scan);
    exit;
   end;

   if s[0] = 'p' then begin
    ui_poke (scan.hProc, scan.data_size);
    break;
   end;

   if (s[0]<>'i') and (s[0]<>'d') and (s[0]<>'m') and (s[0]<>'p') and (s[0]<>'n') and (s[0]<>'q') then begin
     val := strtoint(s);
     update_scan(scan, COND_EQUALS, val);
     writeln(Format('%d matches found', [get_match_count(scan)]));
     break;
   end;
 end;
end;

procedure Main;
begin
 ui_run_scan();
end;