#define fbc -dll -x memsearch.dll

#include "windows.bi"
#include "crt.bi"

const sTitle = "Mysoft MemSearch"

static shared as integer iConsoleCreated
static shared as HMODULE hModThis

sub CreateConsole() constructor
  'Create a console
  iConsoleCreated = AllocConsole()
  'if iConsoleCreated then
  'and reopen CRT to use that console
  freopen("CONIN$", "r", stdin)
  freopen("CONOUT$", "w", stdout)
  freopen("CONOUT$", "w", stderr)
  setvbuf(stdout,0,_IONBF,0)
end sub
sub DestroyConsole() destructor
  Messagebox(null,"DLL will be unloaded...",sTitle,MB_ICONINFORMATION or MB_SYSTEMMODAL)
  if iConsoleCreated then
    iConsoleCreated=0
    FreeConsole()
  end if
end sub

function GetModuleByPtr( pAddr as any ptr ) as zstring ptr
  static as zstring*MAX_PATH zTemp = any
  dim as HMODULE hModChk = any
  const gmhFlags = 4 or 2
  if GetModuleHandleEx(gmhFlags,pAddr,@hModChk) then
    GetModuleFilename(hModChk,@zTemp,MAX_PATH)
    return @zTemp+instrrev(zTemp,"\")
  end if
  return 0
end function
function GetProt( dwProt as DWORD ) as string
  dim as string sResult
  select case (dwProt and &hFF)
  case PAGE_READONLY          : sResult = "R"
  case PAGE_READWRITE         : sResult = "RW"
  case PAGE_WRITECOPY         : sResult = "RC"
  case PAGE_EXECUTE           : sResult = "E"
  case PAGE_EXECUTE_READ      : sResult = "RE"
  case PAGE_EXECUTE_READWRITE   : sResult = "RWE"
  case PAGE_EXECUTE_WRITECOPY   : sResult = "RWEC"
  case PAGE_NOACCESS            : sResult = "NA"
  case else                   : return hex$(dwProt,8)
  end select
  if (dwProt and PAGE_GUARD) then sResult += " G"
  if (dwProt and PAGE_NOCACHE) then sResult += " N"
  return sResult
end function
sub DumpInfo( tMem as MEMORY_BASIC_INFORMATION )
  with tMem
    var pzState = cast(zstring ptr,iif(.State=MEM_COMMIT,@"YES",@"NO"))
    var pzMod = GetModuleByPtr(cast(any ptr,tMem.BaseAddress))
    if pzMod=0 then pzMod = @"???"

    select case .State
    case MEM_COMMIT
      printf(!"%p %p %-8s %p %-8s %-8s %s\r\n", .BaseAddress,.AllocationBase, _
      pzState,cast(any ptr,.RegionSize),GetProt(.Protect),GetProt(.AllocationProtect),pzMod)
    case MEM_RESERVE
      printf(!"%p %p %-8s %p %-8s %-8s %s\r\n", .BaseAddress,.AllocationBase, _
      pzState,cast(any ptr,.RegionSize),"-",GetProt(.AllocationProtect),pzMod)
    case MEM_FREE
      printf(!"%p %-8s %-8s %p %-8s %-8s %s\r\n", .BaseAddress,"-", _
      pzState,cast(any ptr,.RegionSize),"-","-",pzMod)
    end select
  end with
end sub

sub MemSearch()
  printf(!"DLL loaded...")
  Messagebox(null,"DLL loaded...",sTitle,MB_ICONINFORMATION or MB_SYSTEMMODAL)
  dim as MEMORY_BASIC_INFORMATION tMem
  dim as any ptr pBlock = any

  #if 0
  color 15 : printf(!"Base     Alloc    Commit   Size     Prot     OrgProt  Type\r\n") : color 7
  dim as integer iTot
  pBlock = cast(any ptr,&h10000)
  do
    if VirtualQuery(pBlock,@tMem,sizeof(tMem))=0 then exit do
    DumpInfo( tMem )
    if tMem.State = MEM_COMMIT then iTot += tMem.RegionSize
    pBlock += tMem.RegionSize
  loop while pBlock
  printf(!"Total: %i kb\r\n",clng(iTot\1024))
  #endif

  type fbString
    pzData as zstring ptr
    uLen   as uinteger
    uSize  as uinteger
  end type

  var sHello = "Hello World", sHello2 = ""
  dim as zstring*24 zStore
  *cptr(fbString ptr,@sHello2) = type(@zStore,len(sHello)*2,24)
  for N as integer = 0 to len(sHello)-1
    sHello2[N*2] = sHello[N]
  next N

  pBlock = cast(any ptr,&h10000)
  dim as string sTemp
  'printf(!"Stack=%08X\r\n",clng(@sTemp) and &hFFFF0000)
  do
    if VirtualQuery(pBlock,@tMem,sizeof(tMem))=0 then exit do
    if tMem.State = MEM_COMMIT andalso (.tMem.Protect and PAGE_GUARD)=0 then
      var lA = (cast(LONG_PTR,pBlock) and &hFFFFFFFFFF0000), lB = (cast(LONG_PTR,@sTemp) and &hFFFFFFFFFF0000)
      'printf(!"%08X  ",lA,lB)
      print hex$(pBlock),
      if .tMem.RegionSize andalso lA <> lB then
        dim as dword dwOldProt
        if ((.tMem.Protect and &hFF)=PAGE_NOACCESS) then continue do
          'VirtualProtect(pBlock,tMem.RegionSize,PAGE_READONLY,@dwOldProt)
        'end if
        *cptr(fbString ptr,@sTemp) = type(pBlock,tMem.RegionSize,.tMem.RegionSize)
        var iPos = 1, iFound = 0
        do
          iPos = instr(iPos,sTemp,sHello2)
          if iPos = 0 then exit do
          var pFound = pBlock+iPos-1
          lA = (cast(LONG_PTR,pFound) and &hFFFFFFFFFFFF0000)
          if lA <> lB then
            printf(!"\r\nfound at 0x%p\r\n",pFound)
            sleep 100,1
            VirtualProtect(pBlock,tMem.RegionSize,PAGE_READWRITE,@dwOldProt)
            puts("protection changed... now changing value")
            sleep 100,1
            memcpy(pFound,@wstr("You are OK!"),22)
            puts("changing protection back")
            sleep 100,1
            VirtualProtect(pBlock,tMem.RegionSize,dwOldProt,@dwOldProt)
            printf(!"changed...\r\n")
            sleep 100,1
            'exit do,do
            iFound = 1
          end if
          iPos += 1
        loop
        'if iFound=0 then
        '  printf(!"nothing found on this block\r\n")
        'end if
        'if ((.tMem.Protect and &hFF)=PAGE_NOACCESS) then
        '  VirtualProtect(pBlock,tMem.RegionSize,dwOldProt,@dwOldProt)
        'end if

      end if
    end if
    pBlock = cast(any ptr,tMem.BaseAddress+tMem.RegionSize)
  loop while pBlock

  puts(!"Done...")
  zStore = space(23)
  *cptr(fbString ptr,@sTemp) = type(0,0,0)
  *cptr(fbString ptr,@sHello2) = type(0,0,0)
  sHello = ""

end sub
sub DllThread(ID as any ptr) export
  MemSearch()
  puts(!"exitting...")
  FreeLibraryAndExitThread( hModThis , 0 )
end sub

const gmhFlags = 4 or 2
if GetModuleHandleEx(gmhFlags,cast(any ptr,@DllThread),@hModThis) then
  'CreateThread(null,65535,
  ThreadCreate(@DllThread,0)
else
  Messagebox(null,"Init failed",sTitle,MB_ICONERROR or MB_SYSTEMMODAL)
end if