observerhexeditor.pas

一个不出名的GBA模拟器

    vmWriteByte(FEditingAt, StrToIntDef(st, vmReadByte(FEditingAt)));

    editor.Visible := false;
    editor.Top := -editor.height;

    UpdateObserver;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  shiftFactor: integer;
begin
  if ssShift in Shift then shiftFactor := 10 else shiftFactor := 1;
  case Key of
    VK_PRIOR: SetAddress(Max(scrollbar.Position - (scrollBar.LargeChange * shiftFactor), scrollbar.Min));
    VK_NEXT: SetAddress(Min(scrollbar.Position + (scrollBar.LargeChange * shiftFactor), scrollbar.Max));
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ChangeDisplayMode(Sender: TObject);
begin
  if rbByte.Checked then
    displayMode := hemByte
  else if rbHalfword.Checked then
    displayMode := hemHalfword
  else if rbWord.Checked then
    displayMode := hemWord
  else
    displayMode := hemStream;

  if editor.visible then FinishEditing;
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ChangeCurrentBank(Sender: TObject);
begin
  case eAddress.ItemIndex of
    0: SetAddress($00000000);
    1: SetAddress($02000000);
    2: SetAddress($03000000);
    3: SetAddress($04000000);
    4: SetAddress($05000000);
    5: SetAddress($06000000);
    6: SetAddress($07000000);
    7: SetAddress($08000000);
    8: SetAddress($0E000000);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.GotoAddress(Sender: TObject);
var
  st: string;
  i: integer;
begin
  st := eAddress.Text;
  i := Pos(' ', st);
  if i > 0 then Delete(st, i, Length(st)-i);

  if Length(st) > 0 then begin
    if st[1] <> '$' then st := '$' + st;
    SetAddress(StrToIntDef(st, scrollbar.Position));
    eAddress.Text := '$' + IntToHex(uint32(scrollbar.Position), 8);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.addressKeyPress(Sender: TObject; var Key: Char);
begin
  if (key = #10) or (key = #13) then begin
    GotoAddress(Sender);
    Key := #0;
  end;
end;

//////////////////////////////////////////////////////////////////////
// Context menu //////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.BrowseTo(Sender: TObject);
var
  st: string;
begin
  try
    st := InputBox('Mappy VM', 'Enter the address (in hex) to display', Format('$%8.8x', [scrollbar.Position]));
    if Length(st) > 0 then begin
      if st[1] <> '$' then st := '$' + st;
      SetAddress(StrToIntDef(st, scrollbar.Position));
    end;
  except
    on e: EConvertError do e.Free;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ReturnToPC(Sender: TObject);
begin
  SetAddress(vmCurrentPC);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ReturnToSP(Sender: TObject);
begin
  SetAddress(vmGetRegister(13));
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayBIOS(Sender: TObject);
begin
  SetAddress($00000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayExWRAM(Sender: TObject);
begin
  SetAddress($02000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayWRAM(Sender: TObject);
begin
  SetAddress($03000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayPalette(Sender: TObject);
begin
  SetAddress($05000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayVRAM(Sender: TObject);
begin
  SetAddress($06000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayOAM(Sender: TObject);
begin
  SetAddress($07000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplayROM(Sender: TObject);
begin
  SetAddress($08000000);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.DisplaySRAM(Sender: TObject);
begin
  SetAddress($0E000000);
end;

//////////////////////////////////////////////////////////////////////
// Advanced Menu /////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.FindPattern(Sender: TObject);
begin
  dbgFindPattern.bFind.OnClick := FindPatternAgain;
  findingAgain := false;
  dbgFindPattern.Show;
end;

//////////////////////////////////////////////////////////////////////

function IncAddress(var addr: uint32; romSize: uint32): boolean;
begin
  Result := false;
  Inc(addr);
  case (addr shr 24) and $F of
    $0,$1: if addr > $00000000 + SYSTEM_ROM_MASK then addr := $02000000;
    $2: if addr > $02000000 + EX_WRAM_MASK then addr := $03000000;
    $3: if addr > $03000000 + WRAM_MASK then addr := $04000000;
    $4: if addr > $04000000 + $804 then addr := $05000000;
    $5: if addr > $05000000 + PALETTE_MASK  then addr := $06000000;
    $6: if addr > $06013FFF then addr := $07000000;
    $7: if addr > $07000000 + OAM_MASK then addr := $08000000;
    $8..$D: if addr >= $08000000 + romSize then addr := $0E000000;
    $E..$F: if addr > $0E00FFFF then begin
      Result := not (MessageDlg('Reached the top of memory, continue from the bottom?', mtConfirmation, [mbYes, mbNo], 0) = mrYes);
      addr := $00000000;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

function DecAddress(var addr: uint32; romSize: uint32): boolean;
begin
  Result := false;
  case (addr shr 24) and $F of
    $0..$1: if addr = $00000000 then begin
      Result := not (MessageDlg('Reached the bottom of memory, continue from the top?', mtConfirmation, [mbYes, mbNo], 0) = mrYes);
      addr := $0E00FFFF;
    end else Dec(addr);
    $2: if addr = $02000000 then addr := SYSTEM_ROM_MASK else Dec(addr);
    $3: if addr = $03000000 then addr := $02000000+EX_WRAM_MASK else Dec(addr);
    $4: if addr = $04000000 then addr := $03000000+WRAM_MASK else Dec(addr);
    $5: if addr = $05000000 then addr := $04000803 else Dec(addr);
    $6: if addr = $06000000 then addr := $05000000+PALETTE_MASK else Dec(addr);
    $7: if addr = $07000000 then addr := $06013FFF else Dec(addr);
    $8..$D: if addr = $08000000 then addr := $07000000+OAM_MASK else Dec(addr);
    $E..$F: if addr = $0E000000 then addr := $08000000+romSize else Dec(addr);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.FindPatternAgain(Sender: TObject);
var
  banks: TvmMemoryLock1;
  addr, backup: uint32;
  matchIndex: integer;
  pattern: Puint8array;
  patternLength: integer;
  done: boolean;
begin
  if dbgFindPattern.data = '' then begin
    Beep;
    Exit;
  end;

  pattern := @(dbgFindPattern.data[1]);
  patternLength := Length(dbgFindPattern.data);
  addr := dbgFindPattern.address;
  backup := addr;
  matchIndex := 0;

  if findingAgain then begin
    if dbgFindPattern.goDown then
      DecAddress(addr, banks.romsize)
    else
      IncAddress(addr, banks.romsize);
  end;
  findingAgain := true;

  repeat
    // Read a byte and test against the pattern
    if vmReadByte(addr) = pattern^[matchIndex] then begin
      if matchIndex = 0 then backup := addr;
      Inc(matchIndex);
    end else begin
      if matchIndex > 0 then addr := backup;
      matchIndex := 0;
    end;

    // Advance the address
    if matchIndex = patternLength then
      done := true
    else begin
      if dbgFindPattern.goDown and (matchIndex = 0) then
        done := DecAddress(addr, banks.romsize)
      else
        done := IncAddress(addr, banks.romsize);
    end;
  until done;

  // Display the search results
  if matchIndex > 0 then begin
    addr := backup;
    SetAddress(addr);
    MessageDlg(Format('Pattern found at $%.8x.', [addr]), mtInformation, [mbOk], 0);
    Beep;
  end;
  
  dbgFindPattern.address := addr;
  dbgFindPattern.cbBaseAddress.Text := '$' + IntToHex(addr, 8);
  dbgFindPattern.Hide;

  vmUnlockMemory(banks);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.LoadRawMemory(Sender: TObject);
var
  st: string;
  stream: TFileStream;
  buf: PByteArray;
  i, addr, size: integer;
begin
  openDialog.Filter := 'All Files|*.*';
  openDialog.DefaultExt := 'raw';
  st := '$08000000';
  if openDialog.Execute then
    if InputQuery('Mappy VM', 'Where should the file be placed in memory?', st) then begin
      // Figure out the address
      addr := StrToIntDef(st, 0);

      // Read in the file
      stream := TFileStream.Create(openDialog.Filename, fmOpenRead);
      size := stream.Size;
      GetMem(buf, size);
      stream.Read(buf^, size);
      stream.Free;

      // Spew the file into memory
      for i := 0 to size - 1 do
        vmWriteByte(addr+i, buf^[i]);

      // Free the temporary buffer
      FreeMem(buf, size);
    end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.SaveRawMemory(Sender: TObject);
var
  st: string;
  stream: TFileStream;
  buf: PByteArray;
  i, addr, size: integer;
begin
  saveDialog.Filter := 'All Files|*.*';
  saveDialog.DefaultExt := 'raw';
  st := '$08000000';
  if saveDialog.Execute then
    if InputQuery('Mappy VM', 'What point in memory should the dump come from?', st) then begin
      addr := StrToIntDef(st, 0);
      st := '1024';
      if InputQuery('Mappy VM', 'How much should be dumped?', st) then begin
        // Get memory
        size := StrToIntDef(st, 10);
        GetMem(buf, size);

        // Read the memory
        for i := 0 to size - 1 do
          buf^[i] := vmReadByte(addr+i);

        // Write the file to disk
        stream := TFileStream.Create(saveDialog.Filename, fmCreate);
        stream.Write(buf^, size);
        stream.Free;
        FreeMem(buf, size);
      end;
    end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ShowMenu(Sender: TObject);
var
  mouse: TPoint;
begin
  GetCursorPos(mouse);
  popupMenu.Popup(mouse.x, mouse.y);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ShowHelp(Sender: TObject);
begin
  ShowWebPage(helpFiles.strings[HelpContext-1]);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.ChangeFont(Sender: TObject);
begin
  if fontString <> '' then StringToFont(fontString, fontDialog.Font);
  if fontDialog.Execute then begin
    fontString := FontToString(fontDialog.Font);
    if fontString <> '' then StringToFont(fontString, Font);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.FormDestroy(Sender: TObject);
begin
  dbgFindPattern.bFind.OnClick := nil;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.LoadSettings(ini: TIniFile);
begin
  inherited;
  fontString := ini.ReadString(OCaption, 'Font', '');
  displayMode := THexEditorMode(ini.ReadInteger(OCaption, 'Mode', Ord(hemByte)));
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevHexEditor.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteString(OCaption, 'Font', fontString);
  ini.WriteInteger(OCaption, 'Mode', Ord(displayMode));
end;

//////////////////////////////////////////////////////////////////////

initialization
  RegisterViewer(TjdevHexEditor);
end.

//////////////////////////////////////////////////////////////////////