cheat-engine/Cheat Engine/disassemblerviewunit.pas
Dark Byte df50882b23 add SelectionSize to disassembler view
script templates now take the selection into account for minimum originalcode size
2023-11-23 14:29:33 +01:00

1666 lines
44 KiB
ObjectPascal
Executable File

unit disassemblerviewunit;
{$MODE Delphi}
{
Disassemblerview is a component that displays the memory using the disassembler routines
requirements:
display disassembled lines split up into sections, resizable with a section bar
selecting one or more lines
keyboard navigation
show function names before each function
extra classes:
Lines
Lines contain he disassembled address and the description of that line
}
interface
uses {$ifdef darwin}macport,messages,lcltype,{$endif}
{$ifdef windows}jwawindows, windows,commctrl,{$endif}
sysutils, LCLIntf, forms, classes, controls, comctrls, stdctrls, extctrls, symbolhandler,
cefuncproc, NewKernelHandler, graphics, disassemblerviewlinesunit, disassembler,
math, lmessages, menus, DissectCodeThread, tcclib
{$ifdef USELAZFREETYPE}
,cefreetype,FPCanvas, EasyLazFreeType, LazFreeTypeFontCollection, LazFreeTypeIntfDrawer,
LazFreeTypeFPImageDrawer, IntfGraphics, fpimage, graphtype
{$endif}
, betterControls, Contnrs;
type TShowjumplineState=(jlsAll, jlsOnlyWithinRange);
type TDisassemblerSelectionChangeEvent=procedure (sender: TObject; address, address2: ptruint) of object;
type TDisassemblerExtraLineRender=function(sender: TObject; Address: ptruint; AboveInstruction: boolean; selected: boolean; var x: integer; var y: integer): TRasterImage of object;
type TDisassemblerViewOverrideCallback=procedure(address: ptruint; var addressstring: string; var bytestring: string; var opcodestring: string; var parameterstring: string; var specialstring: string) of object;
type TDisassemblerview=class(TPanel)
private
statusinfo: TPanel;
statusinfolabel: TLabel;
header: THeaderControl;
previousCommentsTabWidth: integer;
scrollbox: TScrollbox; //for the header
verticalscrollbar: TScrollbar;
disassembleDescription: TPanel;
disCanvas: TPaintbox;
isUpdating: boolean;
fTotalvisibledisassemblerlines: integer;
disassemblerlines: tlist;
offscreenbitmap: TBitmap;
lastselected1, lastselected2: ptruint; //reminder for the update on what the previous address was
fSelectedAddress: ptrUint; //normal selected address
fSelectedAddress2: ptrUint; //secondary selected address (when using shift selecting)
fTopAddress: ptrUint; //address to start disassembling from
fTopSubline: integer; //in case of multiline lines
fShowJumplines: boolean; //defines if it should draw jumplines or not
fShowjumplineState: TShowjumplineState;
fCenterOnAddressChangeOutsideView: boolean;
// fdissectCode: TDissectCodeThread;
lastupdate: dword;
destroyed: boolean;
fOnSelectionChange: TDisassemblerSelectionChangeEvent;
fOnExtraLineRender: TDisassemblerExtraLineRender;
fspaceAboveLines: integer;
fspaceBelowLines: integer;
fjlThickness: integer;
fjlSpacing: integer;
fhidefocusrect: boolean;
scrolltimer: ttimer;
fOnDisassemblerViewOverride: TDisassemblerViewOverrideCallback;
fCR3: qword;
fCurrentDisassembler: TDisassembler;
fUseRelativeBase: boolean;
fRelativeBase: ptruint;
procedure updateScrollbox;
procedure scrollboxResize(Sender: TObject);
//-scrollbar-
procedure scrollUp(sender: TObject);
procedure scrollDown(sender: TObject);
procedure updateScroller(speed: integer);
procedure scrollbarChange(Sender: TObject);
procedure scrollbarKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure scrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure headerSectionResize(HeaderControl: TCustomHeaderControl; Section: THeaderSection);
procedure headerSectionTrack(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
procedure OnLostFocus(sender: TObject);
procedure MouseScroll(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure DisCanvasPaint(Sender: TObject);
procedure DisCanvasMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure DisCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure SetOriginalPopupMenu(p: Tpopupmenu);
function getOriginalPopupMenu: Tpopupmenu;
procedure setSelectedAddress(address: ptrUint);
procedure setSelectedAddress2(address: ptrUint);
procedure setTopAddress(address: ptrUint);
function getOnDblClick: TNotifyEvent;
procedure setOnDblClick(x: TNotifyEvent);
procedure renderJumpLines;
procedure setJumpLines(state: boolean);
procedure setJumplineState(state: tshowjumplinestate);
procedure synchronizeDisassembler;
procedure StatusInfoLabelCopy(sender: TObject);
procedure setCR3(pa: QWORD);
function getSelectionSize: integer;
procedure setSelectionSize(s: integer);
protected
backlist: TStack;
goingback: boolean;
procedure HandleSpecialKey(key: word);
procedure WndProc(var msg: TMessage); override;
procedure DoEnter; override;
procedure DoExit; override;
procedure DoAutoSize; override;
published
property OnKeyDown;
property OnDblClick: TNotifyEvent read getOnDblClick write setOnDblClick;
public
colors: TDisassemblerViewColors;
jlCallColor: TColor;
jlConditionalJumpColor: TColor;
jlUnConditionalJumpColor: TColor;
statusErrorColor: TColor;
LastFormActiveEvent: qword;
{$ifdef USELAZFREETYPE}
FTFont: TFreeTypeFont;
FTFontb: TFreeTypeFont; //bold version
IntfImage: TLazIntfImage;
drawer: TIntfFreeTypeDrawer;
{$endif}
procedure GoBack;
function hasBackList: boolean;
procedure DoDisassemblerViewLineOverride(address: ptruint; var addressstring: string; var bytestring: string; var opcodestring: string; var parameterstring: string; var specialstring: string);
procedure reinitialize; //deletes the assemblerlines
procedure BeginUpdate; //stops painting until endupdate
procedure EndUpdate;
procedure Update; override;
procedure setCommentsTab(state: boolean);
function getheaderWidth(headerid: integer): integer;
procedure setheaderWidth(headerid: integer; size: integer);
property Totalvisibledisassemblerlines: integer read fTotalvisibledisassemblerlines;
procedure getDefaultColors(var c: Tdisassemblerviewcolors);
function getDisassemblerLineAtPoint(p: tpoint): TDisassemblerLine;
function getReferencedByLineAtPos(p: tpoint): ptruint;
function getSourceCodeAtPos(p: tpoint): PLineNumberInfo;
function ClientToCanvas(p: tpoint): TPoint;
constructor create(AOwner: TComponent); override;
destructor destroy; override;
published
property HideFocusRect: boolean read fhidefocusrect write fhidefocusrect;
property SpaceAboveLines: integer read fspaceAboveLines write fspaceAboveLines;
property SpaceBelowLines: integer read fspaceBelowLines write fspaceBelowLines;
property jlThickness: integer read fjlThickness write fjlThickness;
property jlSpacing: integer read fjlSpacing write fjlSpacing;
property ShowJumplines: boolean read fShowJumplines write setJumpLines;
property ShowJumplineState: TShowJumplineState read fShowjumplinestate write setJumplineState;
property TopAddress: ptrUint read fTopAddress write setTopAddress;
property SelectedAddress: ptrUint read fSelectedAddress write setSelectedAddress;
property SelectedAddress2: ptrUint read fSelectedAddress2 write setSelectedAddress2;
property OnSelectionChange: TDisassemblerSelectionChangeEvent read fOnSelectionChange write fOnSelectionChange;
property PopupMenu: TPopupMenu read getOriginalPopupMenu write SetOriginalPopupMenu;
property Osb: TBitmap read offscreenbitmap;
property OnExtraLineRender: TDisassemblerExtraLineRender read fOnExtraLineRender write fOnExtraLineRender;
property OnDisassemblerViewOverride: TDisassemblerViewOverrideCallback read fOnDisassemblerViewOverride write fOnDisassemblerViewOverride;
property CR3: qword read fCR3 write setCR3;
property CurrentDisassembler: TDisassembler read fCurrentDisassembler;
property SelectionSize: integer read getSelectionSize write setSelectionSize;
property RelativeBase: ptruint read fRelativeBase write fRelativeBase;
property UseRelativeBase: boolean read fUseRelativeBase write fUseRelativeBase;
property CenterOnAddressChangeOutsideView: boolean read fCenterOnAddressChangeOutsideView write fCenterOnAddressChangeOutsideView; //if false, top
end;
implementation
uses ProcessHandlerUnit, Parsers, Clipbrd, Globals;
resourcestring
rsDebugSymbolsAreBeingLoaded = 'Debug symbols are being loaded (%d %% (%s))';
rsSymbolsAreBeingLoaded = 'Symbols are being loaded (%d %%)';
rsStructuresAreBeingParsed = 'Structures are being parsed';
rsExtendedDebugInfoIsLoaded = 'Extended debug info is being loaded (%d %%)';
rsPleaseOpenAProcessFirst = 'Please open a process first';
rsAddress = 'Address';
rsBytes = 'Bytes';
rsOpcode = 'Opcode';
rsComment = 'Comment';
rsCopy = 'Copy';
procedure TDisassemblerview.DoDisassemblerViewLineOverride(address: ptruint; var addressstring: string; var bytestring: string; var opcodestring: string; var parameterstring: string; var specialstring: string);
var i: integer;
begin
if assigned(fOnDisassemblerViewOverride) then
fOnDisassemblerViewOverride(address, addressstring, bytestring, opcodestring, parameterstring, specialstring);
end;
procedure TDisassemblerview.SetOriginalPopupMenu(p: Tpopupmenu);
begin
inherited popupmenu:=p;
end;
function TDisassemblerview.getOriginalPopupMenu: Tpopupmenu;
begin
result:=inherited popupmenu;
end;
procedure TDisassemblerview.setJumplineState(state: tshowjumplinestate);
begin
fShowjumplineState:=state;
update;
end;
procedure TDisassemblerview.setJumpLines(state: boolean);
begin
fShowJumplines:=state;
update;
end;
function TDisassemblerview.getOnDblClick: TNotifyEvent;
begin
if discanvas<>nil then
result:=disCanvas.OnDblClick
else
result:=nil;
end;
procedure TDisassemblerview.setOnDblClick(x: TNotifyEvent);
begin
if discanvas<>nil then
disCanvas.OnDblClick:=x;
end;
function TDisassemblerview.getheaderWidth(headerid: integer): integer;
begin
if header<>nil then
result:=header.Sections[headerid].width
else
result:=0;
end;
procedure TDisassemblerview.setheaderWidth(headerid: integer; size: integer);
begin
if header<>nil then
header.Sections[headerid].width:=size;
end;
procedure TDisassemblerview.setCommentsTab(state:boolean);
begin
if header<>nil then
begin
if not state then
begin
previousCommentsTabWidth:=header.Sections[3].Width;
header.Sections[3].MinWidth:=0;
header.Sections[3].Width:=0;
header.Sections[3].MaxWidth:=0;
end
else
begin
header.Sections[3].MaxWidth:=10000;
if previousCommentsTabWidth>0 then
header.Sections[3].Width:=previousCommentsTabWidth;
header.Sections[3].MinWidth:=5;
end;
update;
headerSectionResize(header, header.Sections[3]);
end;
end;
procedure TDisassemblerview.setTopAddress(address: ptrUint);
begin
fTopAddress:=address;
fSelectedAddress:=address;
fSelectedAddress2:=address;
update;
end;
procedure TDisassemblerview.setSelectedAddress2(address: ptrUint);
begin
//just set the address and refresh, no need to do anything special
fSelectedAddress2:=address;
update;
end;
procedure TDisassemblerview.setSelectedAddress(address: ptrUint);
var i: integer;
found: boolean;
viewchanged: boolean;
count: integer;
begin
if (fSelectedAddress<>0) and (fselectedAddress<>address) and (not goingback) then
backlist.Push(pointer(fselectedAddress));
fSelectedAddress:=address;
fSelectedAddress2:=address;
viewchanged:=false;
if (fTotalvisibledisassemblerlines>1) and (InRangeX(fSelectedAddress, Tdisassemblerline(disassemblerlines[0]).address, Tdisassemblerline(disassemblerlines[fTotalvisibledisassemblerlines-2]).address)) then
begin
//in range
found:=false;
for i:=0 to fTotalvisibledisassemblerlines-1 do
if address=Tdisassemblerline(disassemblerlines[i]).address then
begin
found:=true;
break;
end;
//not in one of the current lines. Looks like the disassembler order is wrong. Fix it by setting it to the top address
if not found then
begin
fTopAddress:=address;
fTopSubline:=0;
viewchanged:=true;
end;
end else
begin
fTopAddress:=address;
fTopSubline:=0;
viewchanged:=true;
end;
if fCenterOnAddressChangeOutsideView and viewchanged then
begin
BeginUpdate;
count:=0;
repeat
fTopAddress:=fTopAddress-1;
update;
inc(count);
until (Tdisassemblerline(disassemblerlines[fTotalvisibledisassemblerlines div 2]).Address=address) or (Tdisassemblerline(disassemblerlines[fTotalvisibledisassemblerlines-1]).Address<address) or (count>1000);
if (Tdisassemblerline(disassemblerlines[fTotalvisibledisassemblerlines-1]).Address<address) or (count>1000) then //failed to center
fTopAddress:=address;
EndUpdate;
end;
update;
end;
function TDisassemblerview.getSelectionSize: integer;
var
lastaddr: ptruint;
d: TDisassembler;
begin
d:=TDisassembler.create;
lastaddr:=max(fSelectedAddress2, fSelectedAddress);
d.disassemble(lastaddr);
d.free;
result:=lastaddr-min(fSelectedAddress2, fSelectedAddress);
end;
procedure TDisassemblerview.setSelectionSize(s: integer);
var
first: ptruint;
last: ptruint;
current: ptruint;
stop: ptruint;
d: TDisassembler;
begin
first:=min(fSelectedAddress2, fSelectedAddress);
fselectedaddress:=first;
current:=first;
stop:=first+s;
d:=TDisassembler.create;
while current<stop do
begin
fselectedaddress2:=current;
d.disassemble(current);
end;
d.free;
update;
end;
procedure TDisassemblerview.GoBack;
begin
if hasBackList then
begin
goingback:=true;
setSelectedAddress(ptruint(backlist.Pop));
goingback:=false;
end;
end;
function TDisassemblerview.hasBackList: boolean;
begin
result:=backlist.count>0;
end;
procedure TDisassemblerview.MouseScroll(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var pos: integer;
begin
// messagebox(0,'scroll','',0);
pos:=0;
if wheelDelta>0 then
scrollBarScroll(sender, scLineUp, pos)
else
scrollBarScroll(sender, scLineDown, pos)
// update;
end;
{
function TDisassemblerview.getPopupMenu: Tpopupmenu;
begin
if discanvas<>nil then
result:=discanvas.PopupMenu
else
result:=TControl(self).PopupMenu;
end;
procedure TDisassemblerview.SetPopupMenu(p: tpopupmenu);
begin
TControl(self).PopupMenu:=p;
if discanvas<>nil then
discanvas.PopupMenu:=p;
end; }
procedure TDisassemblerview.HandleSpecialKey(key: word);
var i: integer;
shiftispressed: boolean;
// ctrlispressed: boolean;
// altispressed: boolean;
begin
// messagebox(0,'secial key','',0);
beginupdate;
shiftispressed:=GetBit(15, GetKeyState(VK_SHIFT))=1;
// ctrlispressed:=GetBit(15, GetKeyState(VK_CONTROL))=1;
// altispressed:=GetBit(15, GetKeyState(VK_MENU))=1;
case key of
VK_UP:
begin
fSelectedAddress:=previousopcode(fSelectedAddress);
if (fSelectedAddress<fTopAddress) then
fTopAddress:=fSelectedAddress;
end;
VK_DOWN:
begin
disassemble(fSelectedAddress);
if (fTotalvisibledisassemblerlines-2)>0 then
begin
if (fSelectedAddress >= TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address) then
begin
disassemble(fTopAddress);
update;
fSelectedAddress:=TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address;
end;
end;
end;
VK_LEFT:
dec(fTopAddress);
VK_RIGHT:
inc(fTopAddress);
vk_prior:
begin
if fSelectedAddress>TDisassemblerLine(disassemblerlines[0]).address then fSelectedAddress:=TDisassemblerLine(disassemblerlines[0]).address else
begin
for i:=0 to fTotalvisibledisassemblerlines-2 do
fTopAddress:=previousopcode(fTopAddress); //go 'numberofaddresses'-1 times up
fSelectedAddress:=0;
update;
fSelectedAddress:=TDisassemblerLine(disassemblerlines[0]).address;
end;
end;
vk_next:
begin
if fSelectedAddress<TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address then
fSelectedAddress:=TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address
else
begin
fTopAddress:=TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address;
fSelectedAddress:=0;
update;
fSelectedAddress:=TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-2]).address;
end;
end;
end;
//check if shift is pressed
if not shiftispressed then
fSelectedAddress2:=fSelectedAddress;
endupdate;
end;
procedure TDisassemblerview.WndProc(var msg: TMessage);
{$ifdef cpu64}
type
TWMKey2 = record
Msg: dword;
filler: dword; //fpc 2.4.1 has a broken tmessage structure
CharCode: Word;
Unused: Word;
KeyData: Longint;
Result: LRESULT;
end;
var
y: ^TWMKey2;
x: TWMKey2;
{$else}
var
y: ^TWMKey;
x: TWMKey;
{$endif}
begin
y:=@msg;
x:=y^;
//outputdebugstring(inttohex(msg.msg,8));
{if msg.msg=WM_MOUSEWHEEL then
begin
// messagebox(0,'wm_mousewheel','',0);
end;}
if msg.Msg=CN_KEYDOWN then
begin
// messagebox(0,pchar('1 : '+inttohex(ptrUint(@msg.msg),8)+' - '+inttohex(ptrUint(@msg.wparam),8)+' - '+inttohex(ptrUint(@msg.lparam),8) ),'',0);
// messagebox(0,pchar('CN_KEYDOWN : '+inttohex(ptrUint(@y^.CharCode),8)+' - '+inttohex(ptrUint(@msg.wparam),8)+' - '+inttohex(msg.wparam,8)),'',0);
case x.CharCode of
VK_LEFT, //direction keys
VK_RIGHT,
VK_UP,
VK_DOWN,
VK_NEXT,
VK_PRIOR,
VK_HOME,
VK_END: HandleSpecialKey(x.CharCode);
else inherited WndProc(msg);
end;
end else inherited WndProc(msg);
end;
procedure TDisassemblerview.DoEnter;
begin
inherited DoEnter;
update;
end;
procedure TDisassemblerview.DoExit;
begin
inherited DoExit;
update;
end;
procedure TDisassemblerview.DoAutoSize;
begin
DisableAutoSizing;
disassembleDescription.ClientHeight:=disassembleDescription.Canvas.TextHeight('GgXxYj')+4;
header.Height:=Canvas.TextHeight('GgXxyJjlL')+4;
disassembleDescription.Font.Height:=GetFontData(font.Handle).Height;
EnableAutoSizing;
inherited DoAutoSize;
end;
procedure TDisassemblerview.DisCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var timepassed: qword;
begin
timepassed:=gettickcount64-LastFormActiveEvent;
if timepassed>=50 then
begin
if ssLeft in shift then
DisCanvas.OnMouseDown(self,mbleft,shift,x,y);
end
else
begin
//outputdebugstring('skipped due to '+inttostr(timepassed)+' milliseconds');
end;
end;
procedure TDisassemblerview.DisCanvasMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var i: integer;
found: boolean;
line: TDisassemblerLine;
begin
if not Focused then SetFocus;
if (y<0) or (y>discanvas.Height) then exit; //moved out of range
//find the selected line
line:=nil;
found:=false;
for i:=0 to fTotalvisibledisassemblerlines-1 do
begin
line:=disassemblerlines[i];
if (y>=line.getTop) and (y<(line.getTop+line.getHeight)) then
begin
//found the selected line
found:=true;
break;
end;
end;
if (line=nil) or (not found) then exit; //not found, which is weird, but whatever...
if line.address<>fSelectedAddress then
begin
//not the selected address
fSelectedAddress:=line.address;
//set the secondary address to the same as the first if shift isn't pressed
if not (ssShift in shift) then
fSelectedAddress2:=fSelectedAddress;
end;
//now update the RWAddress
update;
end;
procedure TDisassemblerview.DisCanvasPaint(Sender: TObject);
var cr: Trect;
begin
cr:=discanvas.Canvas.ClipRect;
discanvas.Canvas.CopyRect(cr,offscreenbitmap.Canvas,cr);
end;
procedure TDisassemblerview.renderJumpLines;
{
will render the lines of visible jumps
pre: must be called after the disassemblerlines have been created and configured
}
var
currentline,linex: TDisassemblerLine;
i,j: integer;
address: ptrUint;
found: boolean;
trianglesize: integer;
jumplineoffset: integer;
begin
if fTotalvisibledisassemblerlines=0 then exit;
trianglesize:=TDisassemblerLine(disassemblerlines[0]).defaultHeight div 4;
jumplineoffset:=trianglesize;
found:=false;
for i:=0 to fTotalvisibledisassemblerlines-1 do
begin
currentline:=disassemblerlines[i];
if currentline.isJumpOrCall(address) then
begin
for j:=0 to fTotalvisibledisassemblerlines-1 do
begin
linex:=disassemblerlines[j];
if linex.address=address then
begin
currentline.drawJumplineTo(linex.instructionCenter, jumplineoffset);
found:=true;
break;
end else
if (j>0) and (linex.address>address) and (TDisassemblerline(disassemblerlines[j-1]).address<address) then //we past it...
begin
currentline.drawJumplineTo(linex.gettop, jumplineoffset);
found:=true;
break;
end;
end;
if fShowjumplineState=jlsAll then
begin
if not found then
begin
//not in the visible region
if currentline.address>address then
begin
//line to the top
currentline.drawJumplineTo(0, jumplineoffset,false);
end
else
begin
//line to the bottom
currentline.drawJumplineTo(offscreenbitmap.Height-1, jumplineoffset,false);
end;
end;
end;
inc(jumplineoffset,jlSpacing);
end;
end;
end;
procedure TDisassemblerview.synchronizeDisassembler;
begin
visibleDisassembler.showmodules:=symhandler.showModules;
visibleDisassembler.showsymbols:=symhandler.showsymbols;
visibleDisassembler.showsections:=symhandler.showsections;
fCurrentDisassembler.showmodules:=symhandler.showModules;
fCurrentDisassembler.showsymbols:=symhandler.showsymbols;
fCurrentDisassembler.showsections:=symhandler.showsections;
fCurrentDisassembler.is64bitOverride:=visibleDisassembler.is64bitOverride;
if visibleDisassembler.architecture<>fCurrentDisassembler.architecture then
OutputDebugString('Architecture changed');
fCurrentDisassembler.architecture:=visibleDisassembler.architecture;
end;
procedure TDisassemblerview.StatusInfoLabelCopy(sender: TObject);
begin
Clipboard.AsText:=statusinfolabel.Caption;
end;
function TDisassemblerview.ClientToCanvas(p: tpoint): TPoint;
begin
result:=p;
dec(result.y, disCanvas.top+scrollbox.top);
end;
function TDisassemblerview.getReferencedByLineAtPos(p: tpoint): ptruint;
var cp: tpoint;
d: TDisassemblerLine;
y: integer;
begin
result:=0;
cp:=ClientToCanvas(p);
d:=getDisassemblerLineAtPoint(p);
if d<>nil then
result:=d.getReferencedByAddress(cp.y-d.top);
end;
function TDisassemblerview.getSourceCodeAtPos(p: tpoint): PLineNumberInfo;
var cp: tpoint;
d: TDisassemblerLine;
y: integer;
begin
result:=nil;
cp:=ClientToCanvas(p);
d:=getDisassemblerLineAtPoint(p);
if d<>nil then
result:=d.getSourceCode(cp.y-d.top);
end;
function TDisassemblerview.getDisassemblerLineAtPoint(p: tpoint): TDisassemblerLine;
var cp: tpoint; //canvas point
i: integer;
begin
//checks the y coordinate and returns the appropriate disassemblerline
//p is in disassemblerview coordinates, convert it to line coordinates
result:=nil;
cp:=ClientToCanvas(p);
if cp.y>=0 then
begin
for i:=0 to disassemblerlines.Count-1 do
if InRange(cp.y, TDisassemblerLine(disassemblerlines[i]).top, TDisassemblerLine(disassemblerlines[i]).top+TDisassemblerLine(disassemblerlines[i]).height) then
begin
result:=TDisassemblerLine(disassemblerlines[i]);
exit;
end;
end;
end;
procedure TDisassemblerview.update;
{
fills in all the lines according to the current state
and then renders the lines to the offscreen bitmap
finally the bitmap is rendered by the onpaint event of the discanvas
}
var
currenttop:integer; //determines the current position that lines are getting renderesd
i: integer;
currentline: TDisassemblerLine;
currentAddress: ptrUint;
selstart, selstop: ptrUint;
description: string;
x: ptrUint;
{$ifdef USELAZFREETYPE}
b: tbitmap;
{$endif}
begin
inherited update;
if destroyed then exit;
synchronizeDisassembler;
//if gettickcount-lastupdate>50 then
begin
if (symhandler.parsingdebuginfo or symhandler.loadingExtendedData or symhandler.parsingStructures or (not symhandler.isloaded)) and (not symhandler.haserror) then
begin
if processid>0 then
begin
// symhandler.currentState:=
if symhandler.parsingdebuginfo then
begin
statusinfolabel.Caption:=format(rsDebugSymbolsAreBeingLoaded,[symhandler.progress, symhandler.currentModule])
end
else
if symhandler.loadingExtendedData then
begin
statusinfolabel.Caption:=format(rsExtendedDebugInfoIsLoaded,[symhandler.extendedDataProgess])
end
else
if symhandler.parsingStructures then
statusinfolabel.Caption:=rsStructuresAreBeingParsed
else
statusinfolabel.Caption:=format(rsSymbolsAreBeingLoaded,[symhandler.progress])
end
else
statusinfolabel.Caption:=rsPleaseOpenAProcessFirst;
end
else
begin
if symhandler.haserror then
statusinfolabel.Font.Color:=statusErrorColor
else
statusinfolabel.Font.Color:=clWindowText;
statusinfolabel.Caption:=AnsiToUtf8(symhandler.getnamefromaddress(TopAddress,symhandler.showsymbols, symhandler.showmodules,symhandler.showsections , nil,nil,8,false));
end;
//initialize bitmap dimensions
if discanvas.width>scrollbox.HorzScrollBar.Range then
offscreenbitmap.Width:=discanvas.width
else
offscreenbitmap.Width:=scrollbox.HorzScrollBar.Range;
offscreenbitmap.Height:=discanvas.Height;
//clear bitmap
{$ifdef USELAZFREETYPE}
if (not UseOriginalRenderingSystem) and (drawer<>nil) then
begin
if (IntfImage.Width<>offscreenbitmap.width) or (IntfImage.Height<>offscreenbitmap.Height) then
IntfImage.SetSize(offscreenbitmap.width, offscreenbitmap.height);
drawer.FillPixels(TColorToFPColor(ColorToRGB(clBtnFace)));
end
else
{$endif}
begin
offscreenbitmap.Canvas.Brush.Color:=clBtnFace;
offscreenbitmap.Canvas.FillRect(rect(0,0,offscreenbitmap.Width, offscreenbitmap.Height));
end;
currenttop:=-fTopSubline;
i:=0;
currentAddress:=fTopAddress;
selstart:=minX(fSelectedAddress,fSelectedAddress2);
selstop:=maxX(fSelectedAddress,fSelectedAddress2);
offscreenbitmap.Canvas.Font:=font;
while currenttop<offscreenbitmap.Height do
begin
while i>=disassemblerlines.Count do //add a new line
disassemblerlines.Add(TDisassemblerLine.Create(self, offscreenbitmap, header.Sections, @colors));
currentline:=disassemblerlines[i];
currentline.renderLine(currentAddress,currenttop, inrangeX(currentAddress,selStart,selStop), currentAddress=fSelectedAddress, fspaceAboveLines, fSpaceBelowLines);
inc(currenttop, currentline.getHeight);
inc(i);
end;
{$ifdef USELAZFREETYPE}
if (not UseOriginalRenderingSystem) and (IntfImage<>nil) then
begin
b:=tbitmap.create();
b.LoadFromIntfImage(IntfImage);
offscreenbitmap.Canvas.Draw(0,0,b);
b.free;
end;
{$endif}
fTotalvisibledisassemblerlines:=i;
x:=fSelectedAddress;
disassemble(x,description);
if disassembleDescription.caption<>description then disassembleDescription.caption:=description;
if ShowJumplines then
renderjumplines;
if not isupdating then
disCanvas.Repaint;
lastupdate:=gettickcount;
end;
if assigned(fOnSelectionChange) then
begin
//check if there has been a change since last update
if (lastselected1<>fSelectedAddress) or (lastselected2<>fselectedaddress2) then
fOnSelectionChange(self, fselectedaddress, fselectedaddress2);
end;
lastselected1:=fselectedaddress;
lastselected2:=fSelectedAddress2;
end;
procedure TDisassemblerview.reinitialize;
var i: integer;
begin
fTotalvisibledisassemblerlines:=0;
if disassemblerlines<>nil then
begin
for i:=0 to disassemblerlines.Count-1 do
TDisassemblerLine(disassemblerlines[i]).free;
disassemblerlines.Clear;
end;
end;
procedure TDisassemblerview.BeginUpdate;
begin
isUpdating:=true;
end;
procedure TDisassemblerview.EndUpdate;
begin
isUpdating:=false;
update;
end;
procedure TDisassemblerview.updateScrollbox;
var x: integer;
begin
scrollbox.OnResize:=nil;
x:=(header.Sections[header.Sections.Count-1].Left+header.Sections[header.Sections.Count-1].Width);
header.width:=max(x, scrollbox.ClientWidth);
discanvas.width:=max(x, scrollbox.ClientWidth);
discanvas.height:=scrollbox.ClientHeight-header.height;
scrollbox.VertScrollBar.Visible:=false;
scrollbox.HorzScrollBar.Range:=(x+scrollbox.HorzScrollBar.Page)-scrollbox.clientwidth;
scrollbox.HorzScrollBar.Visible:=true;
update;
scrollbox.OnResize:=scrollboxResize;
end;
procedure TDisassemblerView.scrollboxResize(Sender: TObject);
begin
updatescrollbox;
end;
//scrollbar
procedure TDisassemblerView.scrollbarChange(Sender: TObject);
begin
update;
end;
procedure TDisassemblerView.scrollbarKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
GetFocus;
end;
procedure TDisassemblerView.scrollUp(sender: tobject);
var
i: integer;
pos: integer;
begin
beginupdate;
pos:=verticalscrollbar.Position;
for i:=0 to floor(power(abs(pos-50),0.5)) do
begin
scrollBarScroll(nil,scLineUp, pos);
update;
end;
EndUpdate;
end;
procedure TDisassemblerView.scrollDown(sender: TObject);
var
i: integer;
pos: integer;
begin
beginupdate;
pos:=verticalscrollbar.Position;
for i:=0 to floor(power(abs(pos-50),0.5)) do
begin
scrollBarScroll(nil,scLineDown, pos);
update;
end;
EndUpdate;
end;
procedure TDisassemblerView.updateScroller(speed: integer);
begin
if (speed<>0) then
begin
if scrolltimer=nil then
scrolltimer:=ttimer.create(self);
//max speed is 50 (50 and -50)
scrolltimer.Interval:=10+100-(abs(speed)*(100 div 50));
if speed<0 then
scrolltimer.OnTimer:=scrollUp
else
scrolltimer.OnTimer:=scrollDown;
scrolltimer.enabled:=true;
end
else
begin
if scrolltimer<>nil then
scrolltimer.enabled:=false;
end;
end;
procedure TDisassemblerView.scrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
var x: integer;
found: boolean;
temp: string;
delta: integer;
i: integer;
dl: TDisassemblerLine;
shiftispressed: boolean;
begin
if sender<>nil then
beginupdate;
if scrollcode=sctrack then
begin
delta:=scrollpos-50;
updatescroller(delta);
{
if delta>0 then
begin
for i:=0 to delta do
scrollBarScroll(Sender,scLineDown, scrollpos);
end
else
begin
for i:=delta to 0 do
scrollBarScroll(Sender,scLineUp, scrollpos);
end;
}
endupdate;
exit;
end;
shiftispressed:=GetBit(15, GetKeyState(VK_SHIFT))=1;
case scrollcode of
scLineUp:
begin
if shiftispressed then
fTopAddress:=fTopAddress-1
else
begin
dl:=TDisassemblerLine(disassemblerlines[0]);
dec(fTopSubline, dl.defaultHeight);
if fTopSubline<0 then
begin
fTopAddress:=previousopcode(fTopAddress);
update; //this will generate the proper disassemblerline data but won't render as beginupdate was called (if called from the scroll updater beginupdate was called there)
dl:=TDisassemblerLine(disassemblerlines[0]);
inc(fTopSubline, dl.height);
if fTopSubline<0 then
fTopSubline:=0;
end;
end;
end;
scLineDown:
begin
found:=false;
if shiftispressed then
fTopAddress:=fTopAddress+1
else
if fTotalvisibledisassemblerlines>0 then
begin
dl:=TDisassemblerLine(disassemblerlines[0]);
inc(fTopSubline, dl.defaultHeight); //go to the next line
//if the current position is bigger than the line, go to the next address (most of the time)
if fTopSubline>=dl.height then //next address
begin
for x:=0 to fTotalvisibledisassemblerlines-1 do
if fTopAddress<>TDisassemblerLine(disassemblerlines[x]).address then
begin
fTopAddress:=TDisassemblerLine(disassemblerlines[x]).address;
found:=true;
break;
end;
if not found then //disassemble
disassemble(fTopAddress,temp);
fTopSubline:=fTopSubline mod dl.defaultHeight;
end;
end;
end;
scPageDown:
begin
if TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-1]).address=fTopAddress then
begin
for x:=0 to fTotalvisibledisassemblerlines-1 do
disassemble(fTopAddress,temp);
end
else fTopAddress:=TDisassemblerLine(disassemblerlines[fTotalvisibledisassemblerlines-1]).address;
fTopSubline:=0;
end;
scPageUp:
begin
for x:=0 to fTotalvisibledisassemblerlines-2 do
fTopAddress:=previousopcode(fTopAddress); //go 'numberofaddresses'-1 times up
fTopSubline:=0;
end;
scEndScroll:
begin
scrollpos:=50;
updatescroller(0);
end;
end;
if sender<>nil then //not sent from the component
begin
scrollpos:=50; //i dont want the slider to work 100%
endupdate;
SetFocus;
end;
end;
//header
procedure TDisassemblerview.headerSectionTrack(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
begin
updatescrollbox;
end;
procedure TDisassemblerview.headerSectionResize(HeaderControl: TCustomHeaderControl; Section: THeaderSection);
begin
updatescrollbox;
end;
procedure TDisassemblerView.OnLostFocus(sender: TObject);
begin
self.SetFocus;
end;
procedure TDisassemblerview.setCR3(pa: QWORD);
begin
{$ifdef windows}
if pa=fcr3 then exit;
if fCurrentDisassembler<>visibleDisassembler then
freeAndNil(fCurrentDisassembler);
if pa<>0 then
begin
fCurrentDisassembler:=TCR3Disassembler.Create;
TCR3Disassembler(fCurrentDisassembler).CR3:=pa;
fCurrentDisassembler.syntaxhighlighting:=true;
end
else
begin
if MainThreadID=GetCurrentThreadId then
fCurrentDisassembler:=visibleDisassembler
else
begin
fCurrentDisassembler:=TDisassembler.Create;
fCurrentDisassembler.syntaxhighlighting:=true;
end;
end;
fCR3:=pa;
{$endif}
update;
end;
destructor TDisassemblerview.destroy;
begin
destroyed:=true;
if backlist<>nil then
freeandnil(backlist);
reinitialize;
if disassemblerlines<>nil then
freeandnil(disassemblerlines);
if offscreenbitmap<>nil then
freeandnil(offscreenbitmap);
if disCanvas<>nil then
freeandnil(disCanvas);
if header<>nil then
freeandnil(header);
if scrollbox<>nil then
freeandnil(scrollbox);
if disassembleDescription<>nil then
freeandnil(disassembleDescription);
if statusinfolabel<>nil then
freeandnil(statusinfolabel);
if statusinfo<>nil then
freeandnil(statusinfo);
if (fCurrentDisassembler<>nil) and (fCurrentDisassembler<>visibleDisassembler) then
freeAndNil(fCurrentDisassembler);
inherited destroy;
end;
constructor TDisassemblerview.create(AOwner: TComponent);
var
emptymenu: TPopupMenu;
mi: TMenuItem;
begin
inherited create(AOwner);
backlist:=TStack.Create;
if MainThreadID=GetCurrentThreadId then
fCurrentDisassembler:=visibleDisassembler
else
begin
fCurrentDisassembler:=TDisassembler.Create;
fCurrentDisassembler.syntaxhighlighting:=true;
end;
{$ifdef USELAZFREETYPE}
if loadCEFreeTypeFonts then
begin
FTFont:=TFreeTypeFont.Create;
FTFont.Name:='Courier New';
FTFontb:=TFreeTypeFont.Create;
FTFontb.Name:='Courier New';
FTFontb.Style:=[ftsBold];
FTFontb.Hinted:=false;
IntfImage:=TLazIntfImage.Create(0,0, [riqfRGB]);
drawer:=TIntfFreeTypeDrawer.Create(IntfImage);
end;
{$endif}
jlSpacing:=2;
jlThickness:=1;
emptymenu:=TPopupMenu.create(self);
tabstop:=true;
DoubleBuffered:=true;
AutoSize:=false;
statusinfo:=tpanel.Create(self);
with statusinfo do
begin
autosize:=true;
ParentFont:=true;
align:=alTop;
bevelInner:=bvLowered;
// height:=19;
parent:=self;
PopupMenu:=emptymenu;
color:=clBtnFace;
end;
statusinfolabel:=TLabel.Create(self);
with statusinfolabel do
begin
parentfont:=true;
align:=alClient;
Alignment:=taCenter;
autosize:=true;
//font.Size:=25;
//transparent:=false;
parent:=statusinfo;
PopupMenu:=TPopupMenu.Create(statusinfolabel);
with popupmenu do
begin
name:='StatusInfoLabelPopupMenu';
mi:=tmenuitem.create(PopupMenu);
mi.caption:=rsCopy;
mi.OnClick:=StatusInfoLabelCopy;
mi.name:='miStatusInfoLabelCopy';
items.Add(mi);
end;
Font.Color:=clWindowText;
end;
disassembleDescription:=Tpanel.Create(self);
with disassembleDescription do
begin
align:=alBottom;
//autosize:=true;
bevelInner:=bvLowered;
bevelOuter:=bvLowered;
Color:=colorset.TextBackground;
ParentFont:=false;
Font.Charset:=DEFAULT_CHARSET;
Font.Color:=clBtnText;
Font.Name:='Courier New';
Font.Style:=[];
parent:=self;
PopupMenu:=emptymenu;
end;
verticalscrollbar:=TScrollBar.Create(self);
with verticalscrollbar do
begin
align:=alright;
kind:=sbVertical;
pagesize:=2;
position:=50;
parent:=self;
OnEnter:=OnLostFocus;
OnChange:=scrollbarChange;
OnKeyDown:=scrollbarKeyDown;
OnScroll:=scrollBarScroll;
end;
scrollbox:=TScrollbox.Create(self);
with scrollbox do
begin
DoubleBuffered:=true;
align:=alClient;
// bevelInner:=bvNone;
// bevelOuter:=bvNone;
Borderstyle:=bsNone;
HorzScrollBar.Tracking:=true;
VertScrollBar.Visible:=false;
scrollbox.OnResize:=scrollboxResize;
parent:=self;
OnEnter:=OnLostFocus;
//PopupMenu:=emptymenu;
//OnMouseWheel:=MouseScroll;
end;
header:=THeaderControl.Create(self);
with header do
begin
top:=0;
//autosize:=true;
//height:=20;
OnSectionResize:=headerSectionResize;
OnSectionTrack:=headerSectionTrack;
parent:=scrollbox;
onenter:=OnLostFocus;
//header.Align:=alTop;
//header.ParentFont:=false;
PopupMenu:=emptymenu;
font.color:=clWindowtext;
name:='Header';
end;
with header.Sections.Add do
begin
ImageIndex:=-1;
MinWidth:=50;
Text:=rsAddress;
Width:=80;
end;
with header.Sections.Add do
begin
ImageIndex:=-1;
MinWidth:=50;
Text:=rsBytes;
Width:=140;
end;
with header.Sections.Add do
begin
ImageIndex:=-1;
MinWidth:=50;
Text:=rsOpcode;
Width:=200;
end;
with header.Sections.Add do
begin
ImageIndex:=-1;
MinWidth:=5;
Text:=rsComment;
AutoSize:=true;
Width:=100;
end;
disCanvas:=TPaintbox.Create(self);
with disCanvas do
begin
AnchorSideTop.control:=header;
anchorsidetop.Side:=asrBottom;
ParentFont:=true; //False;
AnchorSideBottom.control:=scrollbox;
AnchorSideBottom.side:=asrBottom;
anchors:=[akBottom, akLeft, akTop, akRight];
parent:=scrollbox;
OnPaint:=DisCanvasPaint;
OnMouseDown:=DisCanvasMouseDown;
OnMouseMove:=DisCanvasMouseMove;
OnMouseWheel:=mousescroll;
name:='PaintBox';
end;
offscreenbitmap:=Tbitmap.Create;
disassemblerlines:=TList.Create;
fShowjumplineState:=jlsOnlyWithinRange;
fShowJumplines:=true;
self.OnMouseWheel:=mousescroll;
getDefaultColors(colors);
scrollbox.AutoSize:=false;
scrollbox.AutoScroll:=false;
end;
procedure TDisassemblerview.getDefaultColors(var c: Tdisassemblerviewcolors);
var defaultHexColor: TColor;
begin
//setup the default colors:
if ShouldAppsUseDarkMode() then
defaultHexColor:=$ff7f00
else
defaultHexColor:=clBlue;
c[csNormal].backgroundcolor:=clBtnFace;
c[csNormal].normalcolor:=clWindowText;
c[csNormal].registercolor:=clRed;
c[csNormal].symbolcolor:=clGreen;
if ShouldAppsUseDarkMode() then
c[csNormal].hexcolor:=$ff7f00 //inccolor(clBlue,18)
else
c[csNormal].hexcolor:=clBlue;
c[csHighlighted].backgroundcolor:=clHighlight;
c[csHighlighted].normalcolor:=clHighlightText;
c[csHighlighted].registercolor:=clRed;
c[csHighlighted].symbolcolor:=clLime;
c[csHighlighted].hexcolor:=clYellow;
c[csSecondaryHighlighted].backgroundcolor:=clGradientActiveCaption;
c[csSecondaryHighlighted].normalcolor:=clHighlightText;
c[csSecondaryHighlighted].registercolor:=clRed;
c[csSecondaryHighlighted].symbolcolor:=clBlue;
c[csSecondaryHighlighted].hexcolor:=clOlive;
c[csBreakpoint].backgroundcolor:=clRed;
c[csBreakpoint].normalcolor:=clBlack;
c[csBreakpoint].registercolor:=clGreen;
c[csBreakpoint].symbolcolor:=clLime;
c[csBreakpoint].hexcolor:=clBlue;
c[csHighlightedbreakpoint].backgroundcolor:=clGreen;
c[csHighlightedbreakpoint].normalcolor:=clWhite;
c[csHighlightedbreakpoint].registercolor:=clRed;
c[csHighlightedbreakpoint].symbolcolor:=clLime;
c[csHighlightedbreakpoint].hexcolor:=clBlue;
c[csSecondaryHighlightedbreakpoint].backgroundcolor:=clGreen;
c[csSecondaryHighlightedbreakpoint].normalcolor:=clWhite;
c[csSecondaryHighlightedbreakpoint].registercolor:=clRed;
c[csSecondaryHighlightedbreakpoint].symbolcolor:=clLime;
c[csSecondaryHighlightedbreakpoint].hexcolor:=clBlue;
//ultimap2
c[csUltimap].backgroundcolor:=clYellow;
c[csUltimap].normalcolor:=clBlack;
c[csUltimap].registercolor:=clGreen;
c[csUltimap].symbolcolor:=clBlue;
c[csUltimap].hexcolor:=clBlue;
c[csHighlightedUltimap].backgroundcolor:=clGreen;
c[csHighlightedUltimap].normalcolor:=clWhite;
c[csHighlightedUltimap].registercolor:=clRed;
c[csHighlightedUltimap].symbolcolor:=clLime;
c[csHighlightedUltimap].hexcolor:=clBlue;
c[csSecondaryHighlightedUltimap].backgroundcolor:=clGreen;
c[csSecondaryHighlightedUltimap].normalcolor:=clWhite;
c[csSecondaryHighlightedUltimap].registercolor:=clRed;
c[csSecondaryHighlightedUltimap].symbolcolor:=clLime;
c[csSecondaryHighlightedUltimap].hexcolor:=clBlue;
jlConditionalJumpColor:=clRed;
jlUnconditionalJumpColor:=clGreen;
jlCallColor:=clYellow;
statusErrorColor:=clred;
end;
end.