unit MainUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComCtrls, StdCtrls, Menus, CEFuncproc, Buttons,shellapi, ExtCtrls, Dialogs, Clipbrd,debugger,kerneldebugger, assemblerunit, registry,{xpman,}math,hexeditor, Gauges, ImgList,commctrl,NewKernelHandler, hotkeyhandler,tlhelp32,winsvc,imagehlp,unrandomizer,symbolhandler, ActnList,hypermode,autoassembler,injectedpointerscanunit,plugin,savefirstscan, foundlisthelper,disassembler, underc, psapi, peinfounit, PEInfoFunctions, memscan, formsextra, speedhack2, menuitemExtra, AccessCheck, KIcon, frmCScriptUnit, XMLDoc, XMLIntf, simpleaobscanner, pointervaluelist, ManualModuleLoader, windows7taskbar, VistaAltFixUnit; //the following are just for compatibility const copypasteversion=4; const wm_freedebugger=WM_USER+1; const wm_scandone=WM_USER+2; type TFlash = class (TThread) public procedure Execute; override; procedure col; end; type TToggleWindows = class(TThread) private public constructor Create(CreateSuspended: Boolean); procedure Execute; override; end; type grouptype = array[1..6] of boolean; type TFcontrol= class( TEdit) private public procedure wmMouseWheel (var Msg : TWMMouseWheel); message wm_MouseWheel; end; type TMainForm = class(TForm) Panel1: TPanel; Panel2: TPanel; SortByFrozenButton: TButton; SortByDescriptionButton: TButton; SortByAddressButton: TButton; SortByTypeButton: TButton; SortByValueButton: TButton; UpdateTimer: TTimer; FreezeTimer: TTimer; PopupMenu2: TPopupMenu; Deletethisrecord1: TMenuItem; Browsethismemoryregion1: TMenuItem; Calculatenewvaluepart21: TMenuItem; Freezealladdresses2: TMenuItem; sep1: TMenuItem; Unfreezealladdresses1: TMenuItem; N1: TMenuItem; Groupoption1: TMenuItem; Settogroup11: TMenuItem; Settogroup21: TMenuItem; Settogroup31: TMenuItem; Settogroup41: TMenuItem; Settonogroup1: TMenuItem; N2: TMenuItem; N3: TMenuItem; Sortaddressesbygroup1: TMenuItem; N4: TMenuItem; Copy1: TMenuItem; Paste1: TMenuItem; Cut1: TMenuItem; Setbreakpoint1: TMenuItem; SetHotkey1: TMenuItem; Findoutwhatreadsfromthisaddress1obsolete: TMenuItem; N5: TMenuItem; Panel4: TPanel; advancedbutton: TSpeedButton; Label7: TLabel; CommentButton: TSpeedButton; Panel5: TPanel; ProcessLabel: TLabel; foundcountlabel: TLabel; ScanText: TLabel; Label4: TLabel; Label8: TLabel; LoadButton: TSpeedButton; SaveButton: TSpeedButton; Label6: TLabel; SpeedButton2: TSpeedButton; SpeedButton3: TSpeedButton; GroupBox1: TGroupBox; Label1: TLabel; Label2: TLabel; Windows: TRadioButton; Readonly: TCheckBox; FromAddress: TMemo; ToAddress: TMemo; NewScan: TButton; NextScanButton: TButton; ScanType: TComboBox; VarType: TComboBox; btnMemoryView: TButton; Button1: TButton; ProgressBar1: TProgressBar; HexadecimalCheckbox: TCheckBox; UndoScan: TButton; rbBit: TRadioButton; rbDec: TRadioButton; scanvalue: TEdit; PopupMenu1: TPopupMenu; Browsethismemoryarrea1: TMenuItem; Removeselectedaddresses1: TMenuItem; Selectallitems1: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; TopDisabler: TTimer; emptypopup: TPopupMenu; ccpmenu: TPopupMenu; Cut2: TMenuItem; Copy2: TMenuItem; Paste2: TMenuItem; Splitter1: TSplitter; SpeedButton4: TSpeedButton; cbCaseSensitive: TCheckBox; cbFastScan: TCheckBox; btnShowRegions: TButton; Foundlist3: TListView; Findoutwhataccessesthisaddress1: TMenuItem; Showashexadecimal1: TMenuItem; Settogroup42: TMenuItem; Settogroup51: TMenuItem; cbFasterScan: TCheckBox; rbAllMemory: TRadioButton; Panel7: TPanel; SpeedButton1: TSpeedButton; cbPauseWhileScanning: TCheckBox; btnSetSpeedhack: TButton; Label51: TLabel; Label52: TLabel; Edit2: TEdit; Edit1: TEdit; Change1: TMenuItem; Description1: TMenuItem; Address1: TMenuItem; ype1: TMenuItem; Value1: TMenuItem; LabelModifiedmem: TLabel; pnlFloat: TPanel; rt3: TRadioButton; rt1: TRadioButton; rt2: TRadioButton; cbUnicode: TCheckBox; cbUnrandomizer: TCheckBox; Changescript1: TMenuItem; ActionList1: TActionList; actSave: TAction; actOpen: TAction; ImageList1: TImageList; actAutoAssemble: TAction; Forcerechecksymbols1: TMenuItem; Label5: TLabel; Label38: TLabel; Smarteditaddresses1: TMenuItem; Label53: TLabel; Pointerscanforthisaddress1: TMenuItem; Label55: TLabel; Label57: TLabel; Label58: TLabel; Plugins1: TMenuItem; Label59: TLabel; UpdateFoundlisttimer: TTimer; mode16: TCheckBox; Browsethismemoryregioninthedisassembler1: TMenuItem; AutoAttachTimer: TTimer; Button2: TButton; Button4: TButton; LogoPanel: TPanel; Logo: TImage; ScrollBox1: TScrollBox; HeaderControl1: THeaderControl; Panel3: TPanel; Label30: TLabel; Label29: TLabel; Label12: TLabel; Label27: TLabel; Label15: TLabel; Label16: TLabel; Label13: TLabel; Label18: TLabel; Label23: TLabel; Label28: TLabel; Label3: TLabel; Label9: TLabel; Label10: TLabel; Label11: TLabel; Label14: TLabel; Label17: TLabel; Label19: TLabel; Label20: TLabel; Label21: TLabel; Label22: TLabel; Label24: TLabel; Label25: TLabel; Label26: TLabel; Label31: TLabel; Label32: TLabel; Label33: TLabel; Label34: TLabel; Label35: TLabel; Label36: TLabel; Label37: TLabel; Label39: TLabel; Label40: TLabel; Label41: TLabel; Label42: TLabel; Label43: TLabel; Label44: TLabel; Label45: TLabel; Label46: TLabel; Label47: TLabel; Label48: TLabel; Label49: TLabel; Label50: TLabel; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; CheckBox4: TCheckBox; CheckBox5: TCheckBox; CheckBox6: TCheckBox; CheckBox7: TCheckBox; vscrollpanel: TPanel; ScrollBar1: TScrollBar; Panel14: TPanel; btnSetSpeedhack2: TButton; editSH2: TEdit; Label54: TLabel; tbSpeed: TTrackBar; Label56: TLabel; Label60: TLabel; cbSpeedhack: TCheckBox; MainMenu1: TMainMenu; File1: TMenuItem; Process1: TMenuItem; Help1: TMenuItem; Edit3: TMenuItem; About1: TMenuItem; OpenProcess1: TMenuItem; Save1: TMenuItem; Load1: TMenuItem; Settings1: TMenuItem; N6: TMenuItem; a1: TMenuItem; b1: TMenuItem; c1: TMenuItem; d1: TMenuItem; e1: TMenuItem; CreateProcess1: TMenuItem; New1: TMenuItem; N7: TMenuItem; ools1: TMenuItem; N8: TMenuItem; Helpindex1: TMenuItem; actScriptEngine: TAction; Plugins2: TMenuItem; actMemoryView: TAction; Label61: TLabel; actOpenProcesslist: TAction; procedure ShowProcessListButtonClick(Sender: TObject); procedure NewScanClick(Sender: TObject); procedure NextScanButtonClick(Sender: TObject); procedure btnMemoryViewClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure AddressKeyPress(Sender: TObject; var Key: Char); procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure FoundListDblClick(Sender: TObject); procedure Browsethismemoryarrea1Click(Sender: TObject); procedure UpdateTimerTimer(Sender: TObject); procedure FreezeTimerTimer(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure Label28Click(Sender: TObject); procedure AddressClick(Sender: TObject); procedure TypeClick(Sender: TObject); procedure ValueClick(Sender: TObject); procedure Browsethismemoryregion1Click(Sender: TObject); procedure Label24ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure Deletethisrecord1Click(Sender: TObject); procedure SortByFrozenButtonClick(Sender: TObject); procedure SortByDescriptionButtonClick(Sender: TObject); procedure SortByAddressButtonClick(Sender: TObject); procedure SortByTypeButtonClick(Sender: TObject); procedure SortByValueButtonClick(Sender: TObject); procedure ScanvalueoldKeyPress(Sender: TObject; var Key: Char); procedure Calculatenewvaluepart21Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ScanTypeChange(Sender: TObject); procedure VarTypeChange(Sender: TObject); procedure LogoClick(Sender: TObject); procedure WindowsClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure Selectallitems1Click(Sender: TObject); procedure Label37Click(Sender: TObject); procedure Freezealladdresses2Click(Sender: TObject); procedure SlectItem(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PopupMenu2Popup(Sender: TObject); procedure CheckBox2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure CheckBox1Click(Sender: TObject); procedure Unfreezealladdresses1Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure Removeselectedaddresses1Click(Sender: TObject); procedure FControlKeyPress(Sender: TObject; var Key: Char); procedure FControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ScrollBar1Enter(Sender: TObject); procedure FControlExit(Sender: TObject); procedure Panel1Click(Sender: TObject); procedure FControlEnter(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure CommentButtonClick(Sender: TObject); procedure CommentButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SettogroupXClick(Sender: TObject); procedure Settonogroup1Click(Sender: TObject); procedure SetPrioritys1Click(Sender: TObject); procedure Copy1Click(Sender: TObject); procedure Cut1Click(Sender: TObject); procedure Paste1Click(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Sortaddressesbygroup1Click(Sender: TObject); procedure Setbreakpoint1Click(Sender: TObject); procedure TopDisablerTimer(Sender: TObject); procedure Panel1Resize(Sender: TObject); procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure advancedbuttonClick(Sender: TObject); procedure HexadecimalCheckboxClick(Sender: TObject); procedure SetHotkey1Click(Sender: TObject); procedure Findoutwhatreadsfromthisaddress1obsoleteClick(Sender: TObject); procedure UndoScanClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure rbBitClick(Sender: TObject); procedure rbDecClick(Sender: TObject); procedure Cut2Click(Sender: TObject); procedure Copy2Click(Sender: TObject); procedure Paste2Click(Sender: TObject); procedure ccpmenuPopup(Sender: TObject); procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure Splitter1Moved(Sender: TObject); procedure SettingsClick(Sender: TObject); procedure cbCaseSensitiveClick(Sender: TObject); procedure LogoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure directionclick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnShowRegionsClick(Sender: TObject); procedure Findoutwhataccessesthisaddress1Click(Sender: TObject); procedure OpenProcesslist1Click(Sender: TObject); procedure CloseCheatEngine1Click(Sender: TObject); procedure Showashexadecimal1Click(Sender: TObject); procedure OpenMemorybrowser1Click(Sender: TObject); procedure cbFastScanClick(Sender: TObject); procedure rbAllMemoryClick(Sender: TObject); procedure cbPauseWhileScanningClick(Sender: TObject); procedure btnSetSpeedhackClick(Sender: TObject); procedure Description1Click(Sender: TObject); procedure Address1Click(Sender: TObject); procedure ype1Click(Sender: TObject); procedure Value1Click(Sender: TObject); procedure ProcessLabelDblClick(Sender: TObject); procedure ProcessLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure cbUnrandomizerClick(Sender: TObject); procedure cbUnrandomizerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Foundlist3CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); procedure actOpenExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject); procedure actAutoAssembleExecute(Sender: TObject); procedure Changescript1Click(Sender: TObject); procedure Forcerechecksymbols1Click(Sender: TObject); procedure Label5Click(Sender: TObject); procedure Smarteditaddresses1Click(Sender: TObject); procedure Pointerscanforthisaddress1Click(Sender: TObject); procedure Label53Click(Sender: TObject); procedure Label57Click(Sender: TObject); procedure Foundlist3Data(Sender: TObject; Item: TListItem); procedure UpdateFoundlisttimerTimer(Sender: TObject); procedure Foundlist3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure mode16Click(Sender: TObject); procedure Label59Click(Sender: TObject); procedure Browsethismemoryregioninthedisassembler1Click( Sender: TObject); procedure AutoAttachTimerTimer(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure ScanTypeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection); procedure HeaderControl1SectionResize(HeaderControl: THeaderControl; Section: THeaderSection); procedure FormDestroy(Sender: TObject); procedure tbSpeedChange(Sender: TObject); procedure btnSetSpeedhack2Click(Sender: TObject); procedure cbSpeedhackClick(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure Process1Click(Sender: TObject); procedure About1Click(Sender: TObject); procedure CreateProcess1Click(Sender: TObject); procedure Helpindex1Click(Sender: TObject); procedure New1Click(Sender: TObject); procedure actScriptEngineExecute(Sender: TObject); procedure File1Click(Sender: TObject); procedure Label61Click(Sender: TObject); procedure actOpenProcesslistExecute(Sender: TObject); procedure Panel5Resize(Sender: TObject); procedure Foundlist3Resize(Sender: TObject); private oldscanvalue2text: string; fcontrol: tfcontrol; aaa:single; hotkeypressed: integer; cancelbutton: Tbutton; //cancel button that spawns during a scan, disabled initially to prevent doubleclick accidents cancelbuttonenabler: TTimer; //timer that will enable the cancelbutton after 3 seconds CreateCustomScanButton: TButton; EditCustomScanButton: TButton; CustomScanScripts: array of record name: string; data: TStringlist; CustomScanType: TCustomScanType; end; oldwidth,oldheight: integer; newaddress: Dword; isbit: boolean; tempbitmap: Tbitmap; dontrunshow:boolean; LastWasHex: boolean; dontconvert:boolean; FlashProcessButton: TFlash; oldvartype: integer; unrandomize: Tunrandomize; scantext2: tlabel; andlabel: tlabel; scanvalue2: tedit; cbpercentage: tcheckbox; ceclipboardformat: THandle; reinterpretcheck: integer; ffoundcount: int64; SaveFirstScanThread: TSaveFirstScanThread; foundlist: Tfoundlist; lastscantype: integer; editingscript: boolean; editedscript: integer; oldhandle: thandle; hexstateForIntTypes: boolean; function openprocessPrologue: boolean; procedure openProcessEpilogue(oldprocessname: string; oldprocess: dword; oldprocesshandle: dword;autoattachopen: boolean=false); procedure doNewScan; procedure SetExpectedTableName; procedure autoattachcheck; procedure aprilfoolsscan; function CheckIfSaved: Boolean; procedure checkpaste; procedure hotkey(var Message: TMessage); message WM_HOTKEY; procedure WMGetMinMaxInfo(var Message: TMessage); message WM_GETMINMAXINFO; procedure freedebugger(var Message: TMessage); message WM_FREEDEBUGGER; procedure pointerscanner_addaddress(var Message: TMessage); message WM_COPYDATA; procedure Hotkey2(var Message:TMessage); message wm_hotkey2; procedure ScanDone(var message: TMessage); message WM_SCANDONE; procedure FreezeThem; Procedure Edit; function paste(simplecopypaste: boolean): integer; procedure CopySelectedRecords; procedure DeleteRecords; procedure Deletegroups(groups: grouptype); procedure exceptionhandler(Sender: TObject; E: Exception); procedure ResizeScreen; procedure SetReadWriteBreakpoint(address: dword; size: dword); procedure toggleWindow; procedure adjustbringtofronttext; procedure scanEpilogue(canceled: boolean); procedure CancelbuttonClick(sender: TObject); procedure CancelbuttonenablerInterval(sender: TObject); procedure CreateCustomScanButtonClick(sender: TObject); procedure EditCustomScanButtonClick(sender: TObject); procedure changeScriptCallback(script: string; changed: boolean); //processlist procedure ProcessItemClick(Sender: TObject); //property functions function GetRoundingType: TRoundingType; procedure SetRoundingType(rt: TRoundingType); function getScanStart: Dword; procedure setScanStart(newscanstart: dword); function getScanStop: Dword; procedure setScanStop(newscanstop: dword); function getFastscan: boolean; procedure setFastScan(state: boolean); function getScanReadonly: boolean; procedure setScanReadOnly(state: boolean); function getSelectedCustomScanData: TStringlist; function getSelectedCustomScanType: TCustomScanType; function getSelectedVariableType: TVariableType; procedure setfoundcount(x: int64); public { Public declarations } test: single; itemshavechanged: boolean; debugproc: boolean; autoopen: boolean; //boolean set when table is opened by other means than user file picker oldNumberOfRecords: Integer; oldMemrec: array of memoryrecord; OldComments: String; oldcodelistcount: integer; NumberOfRecords: Integer; memrec: array of memoryrecord; FrozenFvalue: Array of Double; FrozenStrings: Array of string; FrozenBytes: array of array of byte; Hotkeystrings: Array of string; Hotkeys: array of integer; Selected: Array of Boolean; lastselected: Integer; LastLastSelected: Integer; FirstShiftSelected: Integer; //-1 = no shift pressed before else it contains the record that has been selected lastsave: array of memoryrecord; lastsavecount: Integer; NumberofLines: integer; freezedirection: array of TLabel; frozenbox: array of TCheckbox; description: array of TLabel; address: array of TLabel; ValType: array of TLabel; Value: array of TLabel; Select: array of TLabel; Priority: Dword; memimage: TMemorystream; canceled: boolean; originalheight:integer; originalwidth:integer; fronttext: string; aprilfools: boolean; editedsincelastsave: boolean; autoattachlist: tstringlist; memscan: tmemscan; procedure ChangedHandle(Sender: TObject); procedure plugintype0click(Sender:tObject); procedure plugintype5click(Sender:tObject); procedure OnToolsClick(sender: TObject); procedure AddToRecord(Line: Integer); procedure AddAutoAssembleScript(script:string); procedure reinterpretaddresses; procedure ClearList; procedure Updatelist; Procedure UpdateScreen; procedure SetWriteBreakpoint(address: dword; size: dword); procedure SetReadBreakpoint(address: dword; size: dword); procedure reserveMem; procedure ChangeValue(Itemnr: integer; NewValue:String); function getStringFromRecord(itemid: Integer):string; procedure EnableHypermode; procedure disableHypermode; Procedure UpdateScanType; procedure enableGui(isnextscan: boolean); procedure disableGui; procedure SpawnCancelButton; procedure DestroyCancelButton; procedure disableautoassemblecheat(i: integer); procedure enableautoassemblecheat(i: integer); procedure addaddress(description: string; address:dword; const offsets: array of dword; offsetcount: integer; ispointer: boolean; vartype: integer; length: integer; startbit:integer; unicode: boolean); overload; procedure addaddress(description: string; address:dword; const offsets: array of dword; offsetcount: integer; ispointer: boolean; vartype: integer; length: integer; startbit:integer; unicode,showashex: boolean); overload; property foundcount: int64 read ffoundcount write setfoundcount; property RoundingType: TRoundingType read GetRoundingType write SetRoundingType; property ScanStart: dword read getScanStart write setScanStart; property ScanStop: dword read getScanStop write setScanStop; property FastScan: boolean read getFastscan write setFastscan; property ScanReadOnly: boolean read getScanReadonly write setScanReadonly; property SelectedCustomScanData: Tstringlist read getSelectedCustomScanData; property SelectedCustomScanType: TCustomScanType read getSelectedCustomScanType; property SelectedVariableType: TVariableType read getSelectedVariableType; end; var MainForm: TMainForm; ToggleWindows: TTogglewindows; implementation uses mainunit2,ProcessWindowUnit, MemoryBrowserFormUnit, TypePopup, AddAddress, HotKeys, standaloneunit, aboutunit, CommentsUnit, formsettingsunit, Changeoffsetunit, FoundCodeUnit, advancedoptionsunit, formScanningUnit, formDifferentBitSizeUnit,OpenSave, formMemoryTrainerUnit, MemoryTrainerDesignUnit, formhotkeyunit, formAddressChangeUnit, formmemoryregionsunit,formPointerOrPointeeUnit, frmProcessWatcherUnit, formProcessInfo, frmautoinjectunit, PasteTableentryFRM, pointerscannerfrm, PointerscannerSettingsFrm, InjectedpointerscanornotFRM, frmGDTunit, frmFunctionlistUnit, frmFloatingPointPanelUnit; {$R *.DFM} var ncol: TColor; procedure TFlash.Col; begin mainform.panel7.Color:=ncol; end; procedure TFlash.Execute; var red,green: byte; decreasered: boolean; begin {$ifndef ceasinjecteddll} freeonterminate:=true; decreasered:=true; red:=254; green:=0; while not terminated do begin if decreasered then begin dec(red,2); inc(green,2); if green>=250 then decreasered:=false; end else begin inc(red,2); dec(green,2); if red>=254 then decreasered:=true; end; ncol:=(green shl 8)+red; synchronize(col); //sigh (without it works too, but at least with this I know for sure it works. sleep(10); end; {$endif} mainform.Panel7.Color:=clBtnFace; end; constructor TToggleWindows.Create(CreateSuspended: Boolean); begin freeonterminate:=true; inherited Create(CreateSuspended); end; procedure TToggleWindows.Execute; begin toggleotherwindows; togglewindows:=nil; end; procedure TMainForm.WMGetMinMaxInfo(var Message: TMessage); var MMInfo: ^MINMAXINFO; begin //the constraint function of the form behaves weird when draging from the top or left side, so I have to do this myself. //mainform.pix MMInfo:=ptr(message.LParam); if pixelsperinch=96 then begin MMInfo.ptMinTrackSize:=point(490,460); end; end; procedure TFcontrol.wmMouseWheel(var msg: TWMMousewheel); var k: word; begin //move down message if msg.WheelDelta>0 then k:=vk_up else k:=vk_down; mainform.FControlKeyDown(self, k,[]); end; procedure TMainform.Hotkey2(var Message:TMessage); var i:integer; a,b: single; s: string; begin case message.WParam of 0: begin //popup/hide CE if advancedoptions.Pausebutton.Down then begin errorbeep; exit; end; beep; if formsettings.cbHideAllWindows.checked then begin ToggleWindow; if formsettings.cbCenterOnPopup.checked then if not allwindowsareback then setwindowpos(mainform.Handle,HWND_NOTOPMOST,(screen.Width div 2)-(mainform.Width div 2),(screen.Height div 2)-(mainform.height div 2),mainform.Width,mainform.Height,SWP_NOZORDER or SWP_NOACTIVATE); if not allwindowsareback then application.BringToFront else setforegroundwindow(lastforeground); adjustbringtofronttext; exit; end; application.BringToFront; SetForegroundWindow(mainform.Handle); mainform.SetFocus; if formsettings.cbCenterOnPopup.checked then setwindowpos(mainform.Handle,HWND_NOTOPMOST,(screen.Width div 2)-(mainform.Width div 2),(screen.Height div 2)-(mainform.height div 2),mainform.Width,mainform.Height,SWP_NOZORDER or SWP_NOACTIVATE); formstyle:=fsStayOnTop; end; 1: //Pause begin with advancedoptions do begin pausedbyhotkey:=true; pausebutton.down:=not pausebutton.down; pausebutton.Click; pausedbyhotkey:=false; end; end; 2: //speedhack begin if cbSpeedhack.Enabled then begin beep; cbSpeedhack.checked:=not cbSpeedhack.Checked; end; end; //3..7=set speedhack speed 3: begin if cbspeedhack.enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.checked then begin edit2.Text:=format('%.2f',[speedhackspeed1.speed]); edit1.Text:=inttostr(speedhackspeed1.sleeptime); btnSetSpeedhack.Click; end; end; end; 4: begin if cbspeedhack.enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.checked then begin edit2.Text:=format('%.2f',[speedhackspeed2.speed]); edit1.Text:=inttostr(speedhackspeed2.sleeptime); btnSetSpeedhack.Click; end; end; end; 5: begin if cbspeedhack.enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.checked then begin edit2.Text:=format('%.2f',[speedhackspeed3.speed]); edit1.Text:=inttostr(speedhackspeed3.sleeptime); btnSetSpeedhack.Click; end; end; end; 6: begin if cbspeedhack.enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.checked then begin edit2.Text:=format('%.2f',[speedhackspeed4.speed]); edit1.Text:=inttostr(speedhackspeed4.sleeptime); btnSetSpeedhack.Click; end; end; end; 7: begin if cbspeedhack.enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.checked then begin edit2.Text:=format('%.2f',[speedhackspeed5.speed]); edit1.Text:=inttostr(speedhackspeed5.sleeptime); btnSetSpeedhack.Click; end; end; end; 8: begin //increase speed try if cbspeedhack.Enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.Checked then begin a:=strtofloat(edit2.text); a:=a+speedupdelta; edit2.Text:=format('%.2f',[a]); btnSetSpeedhack.Click; end; end; except end; end; 9: begin //decrease speed try if cbspeedhack.Enabled then begin cbspeedhack.Checked:=true; if cbspeedhack.Checked then begin b:=strtofloat(edit2.text); b:=b-slowdowndelta; edit2.Text:=format('%.2f',[b]); btnSetSpeedhack.Click; end; end; except end; end; 10..18: //Change type (if possible) begin if vartype.Enabled then vartype.itemindex:=message.WParam-3 else begin errorbeep; end; end; 19://new scan begin if not newscan.Enabled then exit; //only when no process is opened if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning i:=vartype.ItemIndex; if newscan.Caption=strNewScan then newscan.Click; //start new scan vartype.ItemIndex:=i; vartype.OnChange(vartype); //set previous type end; 20: //new scan Exact value begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning i:=vartype.itemindex; s:=scanvalue.Text; if s='' then exit; if newscan.Caption=strNewScan then newscan.Click; //start new scan vartype.ItemIndex:=i; vartype.OnChange(vartype); //set previous type scanvalue.Text:=s; newscan.Click; end; 21: //new scan unknown initial value begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning i:=vartype.ItemIndex; if newscan.Caption=strNewScan then newscan.Click; //start new scan vartype.ItemIndex:=i; vartype.OnChange(vartype); scantype.ItemIndex:=scantype.Items.IndexOf(StrUnknownInitialValue); scantype.OnChange(scantype); newscan.Click; end; 22: //next scan Exact value begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(StrExactValue); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 23: //next scan IncreasedValue begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(StrIncreasedValue); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 24: //next scan DecreasedValue begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(StrDecreasedValue); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 25: //next scan ChangedValue begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(StrChangedValue); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 26: //next scan unchangedValue begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(StrUnchangedValue); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 27: //next scan Same as first begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if nextscanbutton.Enabled then begin scantype.ItemIndex:=scantype.Items.IndexOf(strSameAsFirstScan); scantype.OnChange(scantype); nextscanbutton.click; end else Errorbeep; end; 28: //undo lastscan begin if not newscan.Enabled then exit; if (formscanning<>nil) and (formscanning.Visible) then exit; //it's scanning if undoscan.Enabled then undoscan.Click else Errorbeep; end; 29: //cancel current scan begin if (formscanning<>nil) and (formscanning.btnCancel.Enabled) then formscanning.btnCancel.Click; end; 30: //debug->run begin MemoryBrowser.Run1.Click; end; end; end; procedure TMainForm.hotkey(var Message: TMessage); //stays because the old hotkeyhandler is still used in some places var x: TDevMode; i: integer; c: integer; begin if ((hotkeyform<>nil) and (hotkeyform.Visible)) or ((formhotkey<>nil) and (formhotkey.visible)) then exit; if Message.wparam=0 then begin //bring to front try unregisterhotkey(mainform.handle,0); if advancedoptions.Pausebutton.Down then begin beep; sleep(100); beep; sleep(100); beep; sleep(100); exit; end; beep; if formsettings.cbHideAllWindows.checked then begin ToggleWindow; // ToggleOtherWindows; if formsettings.cbCenterOnPopup.checked then if not allwindowsareback then setwindowpos(mainform.Handle,HWND_NOTOPMOST,(screen.Width div 2)-(mainform.Width div 2),(screen.Height div 2)-(mainform.height div 2),mainform.Width,mainform.Height,SWP_NOZORDER or SWP_NOACTIVATE); if not allwindowsareback then application.BringToFront else begin setforegroundwindow(lastforeground); // setactivewindow(lastactive); end; adjustbringtofronttext; exit; end; // if length(windowlist)<>0 then application.BringToFront; if formsettings.cbCenterOnPopup.checked then setwindowpos(mainform.Handle,HWND_NOTOPMOST,(screen.Width div 2)-(mainform.Width div 2),(screen.Height div 2)-(mainform.height div 2),mainform.Width,mainform.Height,SWP_NOZORDER or SWP_NOACTIVATE); formstyle:=fsStayOnTop; finally registerhotkey(mainform.handle,0,message.lparamlo,message.LParamHi); //restore the hotkey end; end; if message.WParam=2 then //toggle speedhack begin try unregisterhotkey(mainform.handle,2); if cbSpeedhack.Enabled then begin beep; cbSpeedhack.checked:=not cbSpeedhack.Checked; end; finally registerhotkey(mainform.handle,2,message.lparamlo,message.LParamHi); //restore the hotkey end; end; if message.WParam>=10 then //it's a record with a hotkey begin for i:=0 to numberofrecords-1 do begin //find the record if message.WParam=hotkeys[i] then begin if memrec[i].VarType=255 then begin if memrec[i].Frozen then disableautoassemblecheat(i) else enableautoassemblecheat(i); updatescreen; exit; end; //set the value to what it was when the hotkey got set hotkeypressed:=i; memrec[i].Frozen:=true; FreezeThem; memrec[i].Frozen:=false; hotkeypressed:=-1; exit; end; end; end; end; //---------------------------------- function TMainform.getSelectedCustomScanData: TStringlist; var index: integer; begin index:=scantype.itemindex; if (getSelectedVariableType=vtCustom) and (index>=0) then result:=CustomScanScripts[index].data else result:=nil; end; function TMainform.getSelectedCustomScanType: TCustomScanType; var index: integer; begin index:=scantype.itemindex; if (getSelectedVariableType=vtCustom) and (index>=0) then result:=CustomScanScripts[index].CustomScanType else result:=cstNone; end; function TMainform.getSelectedVariableType: TVariableType; {wrapper for the new getVarType2 in the new scanroutine} begin result:=getVarType2; end; function TMainform.getScanStart: Dword; begin try result:=strtoint('$'+FromAddress.text); except raise exception.Create('Invalid start address: '+FromAddress.text); end; end; procedure TMainform.setScanStart(newscanstart: dword); begin FromAddress.text:=inttohex(newscanstart,8); end; function TMainform.getScanStop: Dword; begin try result:=strtoint('$'+ToAddress.text); except raise exception.Create('Invalid stop address: '+ToAddress.text); end; end; procedure TMainform.setScanStop(newscanstop: dword); begin ToAddress.text:=inttohex(newscanstop,8); end; function TMainform.getFastscan: boolean; begin result:=cbFastscan.checked; end; procedure TMainform.setFastScan(state: boolean); begin cbFastscan.checked:=state; end; function TMainform.getScanReadonly: boolean; begin result:=Readonly.checked; end; procedure TMainform.setScanReadOnly(state: boolean); begin readonly.checked:=state; end; function TMainform.GetRoundingType: TRoundingType; {Property function to get the current rounding type} begin result:=rtTruncated; if rt1.checked then result:=rtRounded else if rt2.checked then result:=rtExtremerounded else if rt3.Checked then result:=rtTruncated; end; procedure TMainform.SetRoundingType(rt: TRoundingType); {Property function to set the current rounding type} begin case rt of rtRounded: rt1.checked; rtExtremerounded: rt2.checked; rtTruncated: rt3.checked; end; end; procedure TMainform.setfoundcount(x: int64); var xdouble: double; begin ffoundcount:=x; xdouble:=x; // foundcountlabel.Caption:=inttostr(x); foundcountlabel.Caption:=Format('%.0n', [xdouble]); end; procedure TMainform.DestroyCancelButton; begin if cancelbutton<>nil then freeandnil(cancelbutton); if cancelbuttonenabler<>nil then freeandnil(cancelbuttonenabler); end; procedure TMainform.SpawnCancelButton; begin cancelbutton:=TButton.create(self); with cancelbutton do begin top:=newscan.top; left:=newscan.left; width:=(nextscanbutton.left+nextscanbutton.width)-left; height:=newscan.height; caption:='Cancel'; onclick:=cancelbuttonclick; enabled:=false; tag:=0; //0=normal 1=force Hint:='This button will try to cancel the current scan. Click twice to force an exit'; ParentShowHint:=false; ShowHint:=true; parent:=panel5; end; cancelbuttonenabler:=TTimer.create(self); with cancelbuttonenabler do begin interval:=2000; //2 seconds OnTimer:=cancelbuttonenablerinterval; enabled:=true; parent:=self; end; end; procedure TMainform.DisableGui; { This procedure will disable the gui. E.g while scanning the memory with no wait screen. } var i: integer; begin Groupbox1.Enabled:=false; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=false; scanvalue.Enabled:=false; if scanvalue2<>nil then begin scanvalue2.Enabled:=false; andlabel.Enabled:=false; scantext2.Enabled:=false; end; vartype.Enabled:=false; scantype.Enabled:=false; scantext.enabled:=false; label4.enabled:=false; label8.Enabled:=false; HexadecimalCheckbox.Enabled:=false; cbCaseSensitive.Enabled:=false; newscan.enabled:=false; nextscanbutton.enabled:=false; undoscan.enabled:=false; end; procedure TMainform.EnableGui(isnextscan: boolean); { Enables the gui options according to what type of scan is currently used no scan, enable everything already scanning, disable the group and type } var i: integer; fname,expectedfilename: string; scanstarted: boolean; begin scanstarted:=newscan.caption=strnewscan; if not scanstarted then begin Groupbox1.Enabled:=true; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=true; end; scanvalue.Enabled:=true; if scanvalue2<>nil then begin scanvalue2.Enabled:=true; andlabel.Enabled:=true; scantext2.Enabled:=true; end; newscan.Enabled:=true; undoscan.Enabled:=isnextscan; //nextscan was already enabled nextscanbutton.Enabled:=scanstarted; vartype.Enabled:=not scanstarted; scantype.Enabled:=true; scantext.enabled:=true; label4.enabled:=true; label8.Enabled:=true; HexadecimalCheckbox.Enabled:=true; cbCaseSensitive.Enabled:=true; scanvalue.visible:=true; scantext.Visible:=true; Updatescantype; Scantype.ItemIndex:=0; //----------------------- //Get the expectedFilename //----------------------- SetExpectedTableName; cbspeedhack.enabled:=true; cbunrandomizer.Enabled:=true; end; procedure TMainform.toggleWindow; resourcestring strWindowFailedToHide='A window failed to hide'; var c: integer; begin togglewindows:=TTogglewindows.Create(false); c:=0; while togglewindows<>nil do begin if c=500 then begin togglewindows.free; raise exception.Create(strWindowFailedToHide); end; sleep(10); inc(c); end; end; procedure TMainForm.ReserveMem; var before: integer; i: integer; begin before:=length(memrec); if numberofrecordsbefore then begin //initialize the new memory for i:=before to numberofrecords-1 do begin zeromemory(@memrec[i],sizeof(memrec[i])); zeromemory(@frozenfvalue[i],sizeof(frozenfvalue[i])); zeromemory(@frozenStrings[i],sizeof(frozenStrings[i])); zeromemory(@frozenbytes[i],sizeof(frozenbytes[i])); zeromemory(@selected[i],sizeof(selected[i])); zeromemory(@hotkeystrings[i],sizeof(hotkeystrings[i])); zeromemory(@Hotkeys[i],sizeof(Hotkeys[i])); end; end; end; procedure TMainform.exceptionhandler(Sender: TObject; E: Exception); begin if (E.Message='Error creating window device context') then exit; screen.Cursor:=crdefault; closefile(addressfile); closefile(memoryfile); closefile(newAddressfile); closefile(newmemoryfile); Application.ShowException(E); end; procedure TMainForm.freedebugger; begin //the debugger says the process has ended, or the thread has stopped freeandnil(debuggerthread); advancedoptions.Pausebutton.Down:=false; end; procedure TMainform.SetReadWriteBreakpoint(address: dword; size: dword); var mbi: _Memory_Basic_Information; i: integer; ct: _context; regsinuse: integer; originaladdress,originalsize: dword; dr: dword; procedure Set4bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0rw or debugexact or reg0len4; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1rw or debugexact or reg1len4; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2rw or debugexact or reg2len4; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3rw or debugexact or reg3len4; end; end; inc(address,4); dec(size,4); inc(regsinuse); end; procedure Set2bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0rw or debugexact or reg0len2; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1rw or debugexact or reg1len2; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2rw or debugexact or reg2len2; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3rw or debugexact or reg3len2; end; end; inc(address,2); dec(size,2); inc(regsinuse); end; procedure Set1bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0rw or debugexact; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1rw or debugexact; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2rw or debugexact; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3rw or debugexact; end; end; inc(address); dec(size); inc(regsinuse); end; resourcestring strAccessed='The following opcodes accessed the selected address'; var rd: dword; tmp: byte; ths: thandle; th: thandle; tE: threadentry32; begin //check if you can read address to address+size if not (formsettings.rbDebugRegisters.checked or formsettings.cbKDebug.checked) then begin readprocessmemory(processhandle,pointer(address),@tmp,1,rd); if rd<>1 then raise exception.Create(strAddressHasToBeReadable); end; if foundcodedialog<>nil then raise exception.Create('The debugger is already trying to find out what reads,writes or accesses a certain address. First close the other window'); if (formsettings.cbKdebug.checked) and (debuggerthread=nil) and (not KDebugger.isActive) then KDebugger.startDebugger; //start the kerneldebugger foundcodedialog:=TFoundcodedialog.create(self); foundcodedialog.Caption:=strAccessed; foundcodedialog.btnOK.caption:=strStop; originaladdress:=address; originalsize:=size; zeromemory(@ct,sizeof(ct)); ct.ContextFlags:=CONTEXT_DEBUG_REGISTERS; //configure the debugregs if formsettings.rbDebugRegisters.checked or formsettings.cbKDebug.checked then begin foundcodedialog.useexceptions:=false; regsinuse:=0; ct.dr7:=0; while (regsinuse<4) and (size>0) do begin if size>=4 then begin if (address mod 4)>0 then begin if (address mod 2)>0 then begin set1bytebreak; //watch on a byte continue; end else begin set2bytebreak; continue; end; end else begin set4bytebreak; continue; end; end; if size>=2 then begin if (address mod 2)>0 then begin set1bytebreak; //watch on a byte continue; end else begin set2bytebreak; continue; end; end; if size=1 then set1bytebreak; end; //ct.dr7:=$D0303; if formsettings.cbKdebug.Checked and (debuggerthread=nil) then begin KDebugger.SetBreakpoint(originaladdress, bt_OnReadsAndWrites, originalsize, bo_findcode); end else begin debuggerthread.DRRegs:=ct; debuggerthread.Suspend; for i:=0 to length(debuggerthread.threadlist)-1 do begin suspendthread(debuggerthread.threadlist[i][1]); SetThreadContext(debuggerthread.threadlist[i][1],debuggerthread.DRRegs); resumethread(debuggerthread.threadlist[i][1]); end; debuggerthread.FindWriter2:=true; debuggerthread.Resume; end; end else begin //dont use debug regs foundcodedialog.useexceptions:=true; virtualqueryEx(processhandle,pointer(address),mbi,sizeof(mbi)); debugger.DebuggerThread.findreader.pagebase:=dword(mbi.BaseAddress); debugger.DebuggerThread.findreader.pagesize:=dword(mbi.RegionSize); debugger.DebuggerThread.findreader.Address:=address; debugger.DebuggerThread.findreader.size:=size; DebuggerThread.findreaderset:=true; DebuggerThread.alsowrites:=true; VirtualProtectEx(processhandle,pointer(address),size,PAGE_NOACCESS,debugger.DebuggerThread.findreader.originalprotection); end; foundcodedialog.show; end; procedure TMainform.SetReadBreakpoint(address: dword; size: dword); var mbi: _Memory_Basic_Information; i: integer; tmp:byte; rD:dword; resourcestring strOpcodeRead='The following opcodes read from the selected address'; begin readprocessmemory(processhandle,pointer(address),@tmp,1,rd); if rd<>1 then raise exception.Create(strAddressHasToBeReadable); if foundcodedialog<>nil then raise exception.Create('The debugger is already trying to find out what reads,writes or accesses a certain address. First close the other window'); foundcodedialog:=TFoundcodedialog.create(self); foundcodedialog.Caption:=strOpcodeRead; foundcodedialog.useexceptions:=true; foundcodedialog.btnOK.caption:=strStop; virtualqueryEx(processhandle,pointer(address),mbi,sizeof(mbi)); debugger.DebuggerThread.findreader.pagebase:=dword(mbi.BaseAddress); debugger.DebuggerThread.findreader.pagesize:=dword(mbi.RegionSize); debugger.DebuggerThread.findreader.Address:=address; debugger.DebuggerThread.findreader.size:=size; DebuggerThread.findreaderset:=true; VirtualProtectEx(processhandle,pointer(address),size,PAGE_NOACCESS,debugger.DebuggerThread.findreader.originalprotection); foundcodedialog.show; end; procedure TMainform.SetWriteBreakpoint(address: dword; size: dword); var mbi: _Memory_Basic_Information; i: integer; ct: _context; regsinuse: integer; originaladdress,originalsize: dword; dr: dword; procedure Set4bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0w or debugexact or reg0len4; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1w or debugexact or reg1len4; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2w or debugexact or reg2len4; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3w or debugexact or reg3len4; end; end; inc(address,4); dec(size,4); inc(regsinuse); end; procedure Set2bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0w or debugexact or reg0len2; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1w or debugexact or reg1len2; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2w or debugexact or reg2len2; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3w or debugexact or reg3len2; end; end; inc(address,2); dec(size,2); inc(regsinuse); end; procedure Set1bytebreak; begin case regsinuse of 0: begin ct.dr0:=address; ct.dr7:=ct.dr7 or reg0set or reg0w or debugexact; end; 1: begin ct.dr1:=address; ct.dr7:=ct.Dr7 or reg1set or reg1w or debugexact; end; 2: begin ct.Dr2:=address; ct.dr7:=ct.dr7 or reg2set or reg2w or debugexact; end; 3: begin ct.Dr3:=address; ct.dr7:=ct.dr7 or reg3set or reg3w or debugexact; end; end; inc(address); dec(size); inc(regsinuse); end; var rd: dword; tmp: byte; resourcestring strOpcodeChanged='The following opcodes changed the selected address'; begin //check if you can read address to address+size if not (formsettings.rbDebugRegisters.checked or formsettings.cbKDebug.checked) then begin readprocessmemory(processhandle,pointer(address),@tmp,1,rd); if rd<>1 then raise exception.Create(strAddressHasToBeReadable); end; if foundcodedialog<>nil then raise exception.Create('The debugger is already trying to find out what reads,writes or accesses a certain address. First close the other window'); if (formsettings.cbKdebug.checked) and (debuggerthread=nil) and (not KDebugger.isActive) then KDebugger.startDebugger; foundcodedialog:=TFoundcodedialog.create(self); foundcodedialog.Caption:=strOpcodeChanged; foundcodedialog.btnOK.caption:=strstop; originaladdress:=address; originalsize:=size; zeromemory(@ct,sizeof(ct)); ct.ContextFlags:=CONTEXT_DEBUG_REGISTERS; if formsettings.rbDebugRegisters.checked then begin foundcodedialog.useexceptions:=false; regsinuse:=0; ct.dr7:=0; while (regsinuse<4) and (size>0) do begin if size>=4 then begin if (address mod 4)>0 then begin if (address mod 2)>0 then begin set1bytebreak; //watch on a byte continue; end else begin set2bytebreak; continue; end; end else begin set4bytebreak; continue; end; end; if size>=2 then begin if (address mod 2)>0 then begin set1bytebreak; //watch on a byte continue; end else begin set2bytebreak; continue; end; end; if size=1 then set1bytebreak; end; // ct.dr7:=$D0303; if formsettings.cbKdebug.Checked and (debuggerthread=nil) then begin KDebugger.SetBreakpoint(originaladdress, bt_OnWrites, originalsize, bo_findcode); end else begin debuggerthread.DRRegs:=ct; debuggerthread.Suspend; for i:=0 to length(debuggerthread.threadlist)-1 do begin suspendthread(debuggerthread.threadlist[i][1]); SetThreadContext(debuggerthread.threadlist[i][1],debuggerthread.DRRegs); resumethread(debuggerthread.threadlist[i][1]); end; debuggerthread.FindWriter2:=true; debuggerthread.Resume; end; end else begin foundcodedialog.useexceptions:=true; virtualqueryEx(processhandle,pointer(originaladdress),mbi,sizeof(mbi)); debugger.DebuggerThread.readonly.pagebase:=dword(mbi.BaseAddress); debugger.DebuggerThread.readonly.pagesize:=dword(mbi.RegionSize); debugger.DebuggerThread.readonly.Address:=originaladdress; debugger.DebuggerThread.readonly.size:=originalsize; DebuggerThread.readonlyset:=true; VirtualProtectEx(processhandle,pointer(originaladdress),originalsize,PAGE_EXECUTE_READ,debugger.DebuggerThread.readonly.originalprotection); end; foundcodedialog.show; end; procedure TMainform.Deletegroups(groups: grouptype); var i: integer; begin for i:=0 to numberofrecords-1 do begin if groups[1] and (memrec[i].Group=1) then selected[i]:=true else if groups[2] and (memrec[i].Group=2) then selected[i]:=true else if groups[3] and (memrec[i].Group=3) then selected[i]:=true else if groups[4] and (memrec[i].Group=4) then selected[i]:=true else if groups[5] and (memrec[i].Group=5) then selected[i]:=true else if groups[6] and (memrec[i].Group=6) then selected[i]:=true else selected[i]:=false; end; deleterecords; end; procedure TMainForm.DeleteRecords; var i,j: Integer; begin if editingscript then exit; //don't do it when editing a script i:=0; while inumberofrecords-1 then firstshiftselected:=-1; end; inc(i); end; If lastselected>numberofrecords-1 then lastselected:=numberofrecords-1; if lastselected>-1 then selected[lastselected]:=true; Updatescreen; Updatelist; end; Procedure TMainForm.UpdateScreen; var rec,i,j: Integer; temp:string; col: tcolor; realaddress,realaddress2,count:dword; error: boolean; check: boolean; resourcestring strAllowNegative='Allow negative changes'; strAllowPositive='Allow positive changes'; strNormalFreeze='Don''t allow any change'; begin if numberofrecords>=numberoflines then begin if not scrollbar1.Enabled then scrollbar1.enabled:=true; try //sometimes on resolion changes this causes a problem, so in a try except to try and fix it on error if scrollbar1.max<>numberofrecords-1 then scrollbar1.max:=numberofrecords-1; if scrollbar1.PageSize<>numberoflines-1 then scrollbar1.pagesize:=numberoflines-1; if scrollbar1.LargeChange<>numberoflines-1 then scrollbar1.LargeChange:=numberoflines-1; except try scrollbar1.Position:=0; scrollbar1.max:=numberofrecords-1; scrollbar1.PageSize:=numberoflines-1; scrollbar1.LargeChange:=numberoflines-1; except end; end; end else begin try if scrollbar1.Enabled then scrollbar1.enabled:=false; if scrollbar1.Position<>0 then scrollbar1.position:=0; except end; end; for i:=0 to numberoflines-1 do begin rec:=scrollbar1.Position+i; if rec-1)) and (memrec[rec].VarType in [0,1,2,3,4,6]) then begin case memrec[rec].Frozendirection of 0: begin col:=clBlue; temp:='='; end; 1: begin temp:='-'; col:=clRed; end; 2: begin temp:='+'; col:=clGreen; end; end; if selected[rec] then col:=ClWhite; if freezedirection[i].Font.Color<>col then freezedirection[i].Font.Color:=col; if temp<>freezedirection[i].Caption then begin freezedirection[i].Caption:=temp; if temp='-' then freezedirection[i].Hint:=strAllowNegative;//'Allow negative changes'; if temp='+' then freezedirection[i].Hint:=strAllowPositive;//'Allow positive changes'; if temp='=' then freezedirection[i].Hint:=strNormalFreeze; //'Don''t allow any change'; freezedirection[i].ShowHint:=true; end; freezedirection[i].visible:=true; end else begin freezedirection[i].visible:=false; end; frozenbox[i].checked:=memrec[rec].Frozen; if hotkeys[rec]<>-1 then frozenbox[i].Enabled:=false else frozenbox[i].Enabled:=true; description[i].Caption:=memrec[rec].Description; if memrec[rec].IsPointer then begin error:=false; //find the real address realaddress2:=memrec[rec].pointers[length(memrec[rec].pointers)-1].Address; for j:=length(memrec[rec].pointers)-1 downto 0 do begin check:=(readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count)); if check and (count=4) then realaddress2:=realaddress+memrec[rec].pointers[j].offset else begin error:=true; break; end; end; realaddress:=realaddress2; if not error then address[i].Caption:='P->'+IntToHex(realaddress,8) else address[i].Caption:='P->????????'; end else address[i].caption:=IntTohex(memrec[rec].address,8); // if not frozenbox[i].visible then //if it's not yet visible, make it visible begin frozenbox[i].visible:=true; description[i].visible:=true; if memrec[rec].VarType<>255 then begin address[i].visible:=true; valtype[i].visible:=true; end else begin address[i].visible:=false; valtype[i].visible:=false; // value[i].visible:=false; end; value[i].visible:=true; end; case memrec[rec].vartype of 0 : valtype[i].Caption:=vartype.Items[1]; //byte 1 : valtype[i].Caption:=vartype.Items[2]; 2 : valtype[i].Caption:=vartype.Items[3]; 3 : valtype[i].caption:=vartype.Items[5]; 4 : valtype[i].caption:=vartype.Items[6]; 5 : begin valtype[i].Caption:=vartype.Items[0]+'['+IntToStr(memrec[rec].Bitlength)+']'; address[i].caption:=address[i].caption+'^'+IntToStr(memrec[rec].Bit); end; 6 : valtype[i].caption:=vartype.Items[4]; 7 : begin if memrec[rec].unicode then valtype[i].Caption:='U'+vartype.Items[7]+'['+inttostr(memrec[rec].Bit)+']' else valtype[i].Caption:=vartype.Items[7]+'['+inttostr(memrec[rec].Bit)+']'; end; 8 : valtype[i].Caption:=vartype.Items[8]+'['+inttostr(memrec[rec].Bit)+']'; 255 : valtype[i].Caption:=strAutoAssemble; else valtype[i].caption:=strBUG; end; if selected[rec] then begin if lastselected=rec then begin select[i].Color:=clActiveCaption; select[i].Font.Color:=clActiveCaption; Frozenbox[i].Color:=clActiveCaption; end else begin select[i].Color:=clGradientActiveCaption; select[i].Font.Color:=clGradientActiveCaption; Frozenbox[i].Color:=clGradientActiveCaption; end; description[i].Font.Color:=clHighlightText; address[i].Font.Color:=clHighlightText; valtype[i].Font.Color:=clHighlightText; value[i].Font.Color:=clHighlightText; end else begin case memrec[rec].Group of 0 : begin description[i].Font.Color:=clWindowText; address[i].Font.Color:=clWindowText; valtype[i].Font.Color:=clWindowText; value[i].Font.Color:=clWindowText; end; 1 : begin description[i].Font.Color:=clRed; address[i].Font.Color:=clRed; valtype[i].Font.Color:=clRed; value[i].Font.Color:=clRed; end; 2 : begin description[i].Font.Color:=clBlue; address[i].Font.Color:=clBlue; valtype[i].Font.Color:=clBlue; value[i].Font.Color:=clBlue; end; 3 : begin description[i].Font.Color:=clYellow; address[i].Font.Color:=clYellow; valtype[i].Font.Color:=clYellow; value[i].Font.Color:=clYellow; end; 4 : begin description[i].Font.Color:=clGreen; address[i].Font.Color:=clGreen; valtype[i].Font.Color:=clGreen; value[i].Font.Color:=clGreen; end; 5 : begin description[i].Font.Color:=clPurple; address[i].Font.Color:=clPurple; valtype[i].Font.Color:=clPurple; value[i].Font.Color:=clPurple; end; 6 : begin description[i].Font.Color:=clWhite; address[i].Font.Color:=clWhite; valtype[i].Font.Color:=clWhite; value[i].Font.Color:=clWhite; end; else begin description[i].Font.Color:=clWindowText; address[i].Font.Color:=clWindowText; valtype[i].Font.Color:=clWindowText; value[i].Font.Color:=clWindowText; end; end; select[i].Color:=clBtnFace; select[i].Font.Color:=clBtnFace; Frozenbox[i].Color:=clBtnFace; end; end else begin description[i].Font.Color:=clBtnFace; select[i].Color:=clBtnFace; select[i].Font.Color:=clBtnFace; description[i].Font.Color:=clBtnFace; Frozenbox[i].Color:=clBtnFace; address[i].Font.Color:=clBtnFace; valtype[i].Font.Color:=clBtnFace; value[i].Font.Color:=clBtnFace; if frozenbox[i].visible then begin frozenbox[i].visible:=false; description[i].visible:=false; address[i].visible:=false; valtype[i].visible:=false; value[i].visible:=false; freezedirection[i].Visible:=false; end; end; end; end; function TMainForm.CheckIfSaved: boolean; resourcestring strAskToSave='You haven''t saved your last changes yet. Save Now?'; var help :word; i,j: Integer; begin //result:=true; result:=not editedsincelastsave; if advancedoptions.codelist2.items.Count=oldcodelistcount then begin end else result:=false; if (OldNumberOfRecords=NumberOfRecords) then begin i:=0; while (result) and (imemrec[i].Description then result:=false; if oldmemrec[i].Address<>memrec[i].Address then result:=false; if oldmemrec[i].VarType<>memrec[i].VarType then result:=false; if oldmemrec[i].Bit<>memrec[i].Bit then result:=false; if oldmemrec[i].bitlength<>memrec[i].bitlength then result:=false; if length(oldmemrec[i].pointers)<>length(memrec[i].pointers) then result:=false else begin for j:=0 to length(oldmemrec[i].pointers)-1 do begin if oldmemrec[i].pointers[j].Address<>memrec[i].pointers[j].Address then result:=false; if oldmemrec[i].pointers[j].offset<>memrec[i].pointers[j].Offset then result:=false; end; end; if oldmemrec[i].Group<>memrec[i].Group then result:=false; inc(i); end; end else result:=false; if not (oldcomments=comments.memo1.Text) then result:=false; if itemshavechanged then result:=false; if result=false then begin help:=messagedlg(strAskToSave,mtConfirmation,mbYesNoCancel,0); case help of mrCancel : result:=false; mrYes : begin result:=true; SaveButton.click; end; else result:=true; end; end; end; procedure TMainForm.UpdateScanType; var OldText: String; OldIndex: Integer; hexvis: boolean; floatvis: boolean; oldwidth: integer; i: integer; resourcestring strScantextcaptiontotext='Text:'; strScantextcaptiontoValue='Value:'; strsearchForText='Search for text'; strSearchForArray='Search for this array'; begin OldIndex:=Scantype.itemindex; OldText:=Scantype.text; hexvis:=true; floatvis:=false; ScanType.Items.Clear; ScanText.Caption:=strScantextcaptiontoValue; case varType.ItemIndex of 0 : begin ScanType.Items.Add(strExact); ScanType.DropDownCount:=1; end; 1,2,3,4,5,6,9:begin //byte-word-dword--8bytes-float-double-all if vartype.itemindex in [5,6,9] then begin if oldindex=0 then floatvis:=true; if vartype.itemindex=9 then hexvis:=false; end; ScanType.Items.Add(strExactValue); ScanType.Items.Add(strBiggerThan); ScanType.Items.Add(strsmallerThan); ScanType.Items.Add(strValueBetween); if NextScanbutton.Enabled then begin scantype.Items.Add(strIncreasedValue); Scantype.Items.Add(strIncreasedValueBy); ScanType.Items.Add(strDecreasedValue); ScanType.Items.Add(strDecreasedValueBy); ScanType.Items.add(strChangedValue); ScanType.Items.Add(strUnchangedValue); if (not advanced) and (not cbfasterscan.checked) then begin ScanType.Items.Add(strSameAsFirstScan); Scantype.DropDownCount:=11; end else Scantype.DropDownCount:=10; end else begin ScanType.Items.Add(strUnknownInitialValue); ScanType.DropDownCount:=5; end; end; 7: begin //text ScanText.caption:=strScanTextCaptionToText; ScanType.Items.Add(strSearchForText); //perhaps also a changed value and unchanged value scan ScanType.DropDownCount:=1; hexvis:=false; end; 8: begin //array of bytes ScanText.caption:=vartype.Items[8]; ScanType.Items.Add(strSearchforarray); ScanType.DropDownCount:=1; end; 10: begin //custom //go through the list of custom scan's for i:=0 to length(CustomScanScripts)-1 do scantype.Items.Add(CustomScanScripts[i].name); ScanType.DropDownCount:=length(CustomScanScripts); end; end; if varType.ItemIndex = 10 then //custom scan begin //CreateCustomScanButton: TButton; //EditCustomScanButton: TButton; if CreateCustomScanButton=nil then begin //spawn it CreateCustomScanButton:=TButton.Create(self); with CreateCustomScanButton do begin width:=50; height:=19; left:=ScanType.left+ScanType.Width+3; top:=ScanType.Top+(scantype.Height div 2)-(height div 2); anchors:=[akTop,akRight]; caption:='New'; parent:=self; onclick:=CreateCustomScanButtonClick; end; EditCustomScanButton:=TButton.Create(self); with EditCustomScanButton do begin width:=50; height:=19; left:=CreateCustomScanButton.left+CreateCustomScanButton.Width+3; top:=CreateCustomScanButton.Top; anchors:=[akTop,akRight]; caption:='Edit'; parent:=self; onclick:=EditCustomScanButtonClick; end; end; end else begin if CreateCustomScanButton<>nil then //free it begin freeandnil(CreateCustomScanButton); if EditCustomScanButton<>nil then freeandnil(EditCustomScanButton); end; end; if (oldtext=strUnknownInitialValue) and (NextScanButton.enabled) then scantype.itemindex:=0 else scantype.itemindex:=oldindex; if (scantype.text=strIncreasedValueBy) or (scantype.text=strDecreasedValueBy) then begin if cbpercentage=nil then begin cbpercentage:=tcheckbox.create(self); cbpercentage.Left:=scantype.Left+scantype.Width+5; cbpercentage.Top:=scantype.Top+2; cbpercentage.Caption:='at least xx%'; cbpercentage.Anchors:=[akTop,akRight]; cbpercentage.Width:=80; cbpercentage.Parent:=scantype.Parent; end; end else begin if cbpercentage<>nil then freeandnil(cbpercentage); end; if scantype.Text=strValueBetween then begin if scanvalue2=nil then begin //decrease the width of the scanvalue editbox oldwidth:=scanvalue.width; scanvalue.Width:=(scanvalue.Width div 2)-20; //create a 2nd editbox scanvalue2:=tedit.create(self); //scanvalue2.onkeydown:=scanvalueKeyDown; scanvalue2.OnKeyPress:=ScanvalueoldKeyPress; scanvalue2.PopupMenu:=ccpmenu; scanvalue2.Left:=scanvalue.left+scanvalue.Width+20; scanvalue2.Width:=oldwidth-scanvalue.width-20; scanvalue2.Top:=scanvalue.top; scanvalue2.Parent:=scanvalue.Parent; scanvalue2.Anchors:=scanvalue.Anchors; scanvalue2.TabOrder:=scanvalue.TabOrder+1; scanvalue2.Text:=oldscanvalue2text; scantext2:=tlabel.create(self); scantext2.caption:=scantext.caption; scantext2.Left:=scanvalue2.Left; scantext2.Top:=scantext.top; scantext2.Parent:=scantext.parent; scantext2.Anchors:=scantext.Anchors; andlabel:=tlabel.Create(self); andlabel.Caption:='and'; andlabel.Left:=scanvalue2.Left-20; andlabel.Top:=scanvalue2.Top+2; andlabel.Parent:=scanvalue2.Parent; andlabel.Anchors:=scantext.Anchors; end end else begin if scanvalue2<>nil then begin scanvalue.Width:=scanvalue.width+20+scanvalue2.width; oldscanvalue2text:=scanvalue2.Text; freeandnil(scanvalue2); freeandnil(scantext2); freeandnil(andlabel); end; end; if (scantype.Text=strIncreasedValue) or (scantype.text=strDecreasedValue) or (scantype.Text=strChangedValue) or (scantype.Text=strUnchangedValue) or (scantype.Text=strUnknownInitialValue) or (scantype.Text=strSameAsFirstScan) then begin Scantext.Visible:=false; Scanvalue.visible:=false; HexadecimalCheckbox.visible:=false; end else begin Scantext.Visible:=true; Scanvalue.visible:=true; HexadecimalCheckbox.visible:=hexvis; end; pnlfloat.Visible:=floatvis; end; function TMainform.getStringFromRecord(itemid: Integer):string; var i,j,k: Integer; read1: byte; read2: word; read3: dword; read4: single; read5: double; read6: Int64; read7: pchar; read72: pwidechar; read8: array of byte; read9: pbyte; count: dword; rec: Integer; temp,temp2: string; nrofbytes: integer; realaddress,realaddress2: dword; stopnow: boolean; check: boolean; begin rec:=itemid; if not memrec[rec].frozen then begin if memrec[rec].IsPointer then begin //find the real address realaddress2:=memrec[rec].pointers[length(memrec[rec].pointers)-1].Address; for j:=length(memrec[rec].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[rec].pointers[j].offset else begin result:='??'; exit; end; end; realaddress:=realaddress2; end else realaddress:=memrec[rec].Address; //get the value!!! case memrec[rec].VarType of 0: begin //byte check:=readprocessmemory(processhandle,pointer(realaddress),addr(read1),1,count); if (not check) or (count=0) then result:='??' else begin if memrec[rec].ShowAsHex then result:='0x'+IntToHex(read1,2) else if formsettings.cbShowAsSigned.checked then result:=IntToStr(ShortInt(read1)) else result:=IntToStr(read1); end; end; 1: begin //word check:=readprocessmemory(processhandle,pointer(realaddress),addr(read2),2,count); if (not check) or (count=0) then result:='??' else begin if memrec[rec].ShowAsHex then result:='0x'+IntToHex(read2,4) else if formsettings.cbShowAsSigned.checked then result:=IntToStr(SmallInt(read2)) else result:=IntToStr(read2); end; end; 2: begin //dword read3:=0; check:=readprocessmemory(processhandle,pointer(realaddress),addr(read3),4,count); if (not check) or (count=0) then result:='??' else begin if memrec[rec].ShowAsHex then result:='0x'+IntToHex(read3,8) else if formsettings.cbShowAsSigned.checked then result:=IntToStr(Longint(read3)) else result:=IntToStr(read3); end; end; 3: begin //float check:=readprocessmemory(processhandle,pointer(realaddress),addr(read4),4,count); if (not check) or (count=0) then result:='??' else result:=FloatToStr(read4); end; 4: begin //double check:=readprocessmemory(processhandle,pointer(realaddress),addr(read5),8,count); if (not check) or (count=0) then result:='??' else result:=FloatToStr(read5); end; 5: begin //binary //read the bytes nrofbytes:=1+((memrec[rec].Bit+memrec[rec].bitlength) div 8); setlength(read8,nrofbytes); check:=readprocessmemory(processhandle,pointer(realaddress),addr(read8[0]),nrofbytes,count); if (not check) or (count=0) then result:='??' else begin //convert what i need to a string of bits temp:=''; j:=memrec[rec].Bit; read9:=@read8[0]; for k:=1 to memrec[rec].bitlength do begin temp:=temp+IntToStr(getbit(j,read9^)); inc(j); if j>=8 then begin j:=0; inc(read9); end; end; temp2:=''; for k:=length(temp) downto 1 do temp2:=temp2+temp[k]; if formsettings.cbBinariesAsDecimal.checked then begin try result:=IntToStr(bintoint(temp2)); except result:=strtoolong; end; end else result:=temp2; //and convert them to a decimal value end; end; 6: begin //Int64 check:=readprocessmemory(processhandle,pointer(realaddress),addr(read6),8,count); if (not check) or (count=0) then result:='??' else begin if memrec[rec].ShowAsHex then result:='0x'+IntToHex(read6,16) else result:=IntToStr(read6); end; end; 7: begin //text if memrec[rec].unicode then begin getmem(read72,memrec[rec].Bit*2+2); check:=readprocessmemory(processhandle,pointer(realaddress),read72,memrec[rec].Bit*2,count); if (not check) or (count'' then begin a:=symhandler.getAddressFromName(memrec[i].interpretableaddress,false, haserror); //don't wait for symbols here if not haserror then memrec[i].address:=a; end; if memrec[i].IsPointer and (memrec[i].pointers[length(memrec[i].pointers)-1].interpretableaddress<>'') then begin a:=symhandler.getAddressFromName(memrec[i].pointers[length(memrec[i].pointers)-1].interpretableaddress,false,haserror); if not haserror then memrec[i].pointers[length(memrec[i].pointers)-1].Address:=a; end; end; //showmessage(inttostr(gettickcount-a)); //always 0 ticks... end; procedure TMainForm.UpdateList; var i,j,k: Integer; rec: Integer; count: dword; realaddress,realaddress2: dword; stopnow: boolean; check: boolean; begin // for i:=0 to (numberoflines-1) do begin stopnow:=false; rec:=scrollbar1.Position+i; if (rec)=byte(memrec[i].FrozenValue) then memrec[i].FrozenValue:=write1 else begin write1:=byte(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write1),1,write); end; end; end; end; error:=write<>1; end; 1: begin if memrec[i].Frozendirection=0 then begin write2:=word(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write2),2,write); end else begin readprocessmemory(processhandle,pointer(realaddress),@write2,2,write); if write=2 then if memrec[i].Frozendirection=1 then begin //allow decreased values if hotkeypressed=i then begin write2:=write2-memrec[i].FrozenValue; //decrease with frozenvalue writeprocessmemory(processhandle,pointer(realaddress),addr(write2),2,write); end else begin if write2<=word(memrec[i].FrozenValue) then memrec[i].FrozenValue:=write2 else begin write2:=word(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write2),2,write); end; end; end else begin if hotkeypressed=i then begin write2:=write2+memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write2),2,write); end else begin //allow increased values if write2>=word(memrec[i].FrozenValue) then memrec[i].FrozenValue:=write2 else begin write2:=word(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write2),2,write); end; end; end; end; error:=write<>2; end; 2: begin if memrec[i].Frozendirection=0 then begin write3:=memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write3),4,write); end else begin readprocessmemory(processhandle,pointer(realaddress),@write3,4,write); if write=4 then if memrec[i].Frozendirection=1 then begin if hotkeypressed=i then begin write3:=write3-memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write3),4,write); end else begin //allow decreased values if write3<=dword(memrec[i].FrozenValue) then memrec[i].FrozenValue:=write3 else begin write3:=dword(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write3),4,write); end; end; end else begin //allow increased values if hotkeypressed=i then begin write3:=write3+memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write3),4,write); end else begin if write3>=dword(memrec[i].FrozenValue) then memrec[i].FrozenValue:=write3 else begin write3:=dword(memrec[i].FrozenValue); writeprocessmemory(processhandle,pointer(realaddress),addr(write3),4,write); end; end; end; end; error:=write<>4; end; 3: begin //float if memrec[i].Frozendirection=0 then begin write4:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write4),4,write); end else begin readprocessmemory(processhandle,pointer(realaddress),@write4,4,write); if write=4 then if memrec[i].Frozendirection=1 then begin if hotkeypressed=i then begin write4:=write4-FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write4),4,write); end else begin //allow decreased values if write4<=FrozenFValue[i] then FrozenFValue[i]:=write4 else begin write4:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write4),4,write); end; end; end else begin if hotkeypressed=i then begin write4:=write4+FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write4),4,write); end else begin //allow increased values if write4>=FrozenFValue[i] then FrozenFValue[i]:=write4 else begin write4:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write4),4,write); end; end; end; end; error:=write<>4; end; 4: begin //double if memrec[i].Frozendirection=0 then begin write5:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write5),8,write); end else begin readprocessmemory(processhandle,pointer(realaddress),@write5,8,write); if write=8 then if memrec[i].Frozendirection=1 then begin if hotkeypressed=i then begin write5:=write5-FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write5),8,write); end else begin //allow decreased values if write5<=FrozenFValue[i] then FrozenFValue[i]:=write5 else begin write5:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write5),8,write); error:=write<>8; end; end; end else begin //allow increased values if hotkeypressed=i then begin write5:=write5+FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write5),8,write); end else begin if write5>=FrozenFValue[i] then FrozenFValue[i]:=write5 else begin write5:=FrozenFValue[i]; writeprocessmemory(processhandle,pointer(realaddress),addr(write5),8,write); error:=write<>8; end; end; end; end; error:=write<>8; end; 5: begin //bit (no up or down) nrofbytes:=1+((memrec[i].Bit+memrec[i].bitlength) div 8); setlength(write8,nrofbytes); readprocessmemory(processhandle,pointer(realaddress),addr(write8[0]),nrofbytes,write); j:=memrec[i].Bit; write9:=@write8[0]; for k:=1 to memrec[i].bitlength do begin setbit(j,write9^,StrToInt(frozenstrings[i][k])); inc(j); if j>=8 then begin j:=0; inc(write9); end; end; writeprocessmemory(processhandle,pointer(realaddress),addr(write8[0]),nrofbytes,write); error:=write<>nrofbytes; end; 6: begin //int64 if memrec[i].Frozendirection=0 then begin write6:=memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write6),8,write); end else begin readprocessmemory(processhandle,pointer(realaddress),@write6,8,write); if write=8 then if memrec[i].Frozendirection=1 then begin if hotkeypressed=i then begin write6:=write6-memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write6),8,write); end else begin //allow decreased values if write6<=memrec[i].FrozenValue then memrec[i].FrozenValue:=write6 else begin write6:=memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write6),8,write); end; end; end else begin if hotkeypressed=i then begin write6:=write6-memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write6),8,write); end else begin //allow increased values if write6>=memrec[i].FrozenValue then memrec[i].FrozenValue:=write6 else begin write6:=memrec[i].FrozenValue; writeprocessmemory(processhandle,pointer(realaddress),addr(write6),8,write); end; end; end; end; error:=write<>8; end; 7: begin //text (no up or down) getmem(writes,memrec[i].Bit+1); StrCopy(writes, PChar(frozenstrings[i])); writeprocessmemory(processhandle,pointer(realaddress),writes,memrec[i].bit,write); freemem(writes); //if this was heroes 4 v1.0 I would have to remove all freemem statements ;) error:=write<>memrec[i].bit; end; 8: begin //array of bytes (no up or down) writeprocessmemory(processhandle,pointer(realaddress),@frozenbytes[i][0],memrec[i].bit,write); error:=write<>memrec[i].bit; end; end; if memrec[i].vartype<255 then //restore VirtualProtectEx(Processhandle, pointer(realaddress), 8, originalprotection, originalprotection); if error then begin if not memrec[i].IsPointer then begin memrec[i].Frozen:=false; if (i>=scrollbar1.Position) and (i<=scrollbar1.position+(numberoflines-1)) then updatescreen; end; //else keep on freezng as if nothing happened end; end; end; procedure TMainform.AddAutoAssembleScript(script:string); var error: Integer; Address: Dword; i,j: Integer; bit: Integer; tmp: string; pc: ^char; found: boolean; bitl: integer; begin //first check if this address is already in the list! inc(NumberOfRecords); ReserveMem; memrec[NumberOfRecords-1].Description:='Auto assemble cheat'; memrec[NumberOfRecords-1].Address:=0; memrec[NumberOfRecords-1].VarType:=255; memrec[NumberOfRecords-1].Frozen:=false; memrec[NumberOfRecords-1].FrozenValue:=0; memrec[NumberOfRecords-1].Bit:=0; memrec[NumberOfRecords-1].bitlength:=0; memrec[NumberOfRecords-1].showAsHex:=false; memrec[NumberOfRecords-1].autoassemblescript:=script; hotkeys[NumberOfRecords-1]:=-1; memrec[NumberOfRecords-1].unicode:=false; updatescreen; updatelist; scrollbar1.Position:=scrollbar1.Max-numberoflines+2; end; Procedure TMainForm.AddToRecord(line:Integer); var error: Integer; Address: Dword; i,j: Integer; bit: Integer; tmp: string; pc: ^char; found: boolean; bitl: integer; realvartype: integer; tempvartype: TVariableType; begin //first check if this address is already in the list! realvartype:=getvartype; if realvartype=5 then //binary begin bit:=foundlist.getstartbit(line); bitl:=foundlist.GetVarLength; end else if realvartype=9 then //all begin bit:=0; bitl:=0; tempvartype:=TVariableType(foundlist.getstartbit(line)); case tempvartype of vtByte: realvartype:=0; vtWord: realvartype:=1; vtDWord: realvartype:=2; vtQWord: realvartype:=6; vtSingle: realvartype:=3; vtDouble: realvartype:=4; end; end else if realvartype=10 then //custom begin case scandisplayroutinetype of 0: realvartype:=0; 1: realvartype:=1; 2: realvartype:=2; 3: realvartype:=6; 4: realvartype:=3; 5: realvartype:=4; 6: realvartype:=8; 7,8 : realvartype:=7; else realvartype:=2; end; end else begin bit:=0; bitl:=0; bit:=foundlist.GetVarLength; end; address:=foundlist.GetAddress(line); inc(NumberOfRecords); ReserveMem; memrec[NumberOfRecords-1].Description:=strNoDescription; memrec[NumberOfRecords-1].Address:=address; memrec[NumberOfRecords-1].IsPointer:=false; setlength(memrec[NumberOfRecords-1].pointers,0); if getscantype=string_scan then memrec[NumberOfRecords-1].VarType:=0 else memrec[NumberOfRecords-1].VarType:=realvartype; memrec[NumberOfRecords-1].Frozen:=false; memrec[NumberOfRecords-1].FrozenValue:=0; memrec[NumberOfRecords-1].Bit:=bit; memrec[NumberOfRecords-1].bitlength:=bitl; memrec[NumberOfRecords-1].showAsHex:=hexadecimalcheckbox.checked; hotkeys[NumberOfRecords-1]:=-1; if memrec[NumberOfRecords-1].VarType=7 then //text begin case scandisplayroutinetype of 7: memrec[NumberOfRecords-1].unicode:=false; 8: memrec[NumberOfRecords-1].unicode:=true; else memrec[NumberOfRecords-1].unicode:=cbunicode.Checked; end; end; if foundlist.inmodule(line) then memrec[NumberOfRecords-1].interpretableaddress:=foundlist.GetModuleNamePlusOffset(line) else memrec[NumberOfRecords-1].interpretableaddress:=''; updatescreen; updatelist; scrollbar1.Position:=scrollbar1.Max-numberoflines+2; end; procedure TMainForm.SetExpectedTableName; var fname: string; expectedfilename: string; begin if savedialog1.Filename<>'' then exit; if opendialog1.Filename<>'' then exit; Fname:=copy(processlabel.caption,pos('-',processlabel.caption)+1,length(processLabel.caption)); if FName[length(FName)-3]='.' then //it's a filename expectedFilename:=copy(FName,1,length(FName)-4) else //it's a normal title; expectedFilename:=FName; savedialog1.FileName:=expectedFilename; Opendialog1.FileName:=expectedFilename; end; resourcestring strConfirmProcessTermination='This will close the current process. Are you sure you want to do this?'; strError='Error'; strErrorwhileOpeningProcess='Error while opening this process'; strKeepList='Keep the current address list/code list?'; strInfoAboutTable='Info about this table:'; strPhysicalMemory='Physical Memory'; function TMainform.openprocessPrologue:boolean; begin result:=false; if flashprocessbutton<>nil then begin flashprocessbutton.Terminate; flashprocessbutton:=nil; end; if (debuggerthread<>nil) and (debuggerthread.attached) then begin if @DebugActiveProcessStop=@DebugActiveProcessStopProstitute then begin if messagedlg(strConfirmProcessTermination,mtWarning,[mbYes ,MbNo],0)=mrNo then exit else begin //whipe out the watchlist debuggerthread.debugging:=false; terminateprocess(processhandle,0); end; end; end; canceled:=false; result:=true; end; procedure TMainform.openProcessEpilogue(oldprocessname: string; oldprocess: dword; oldprocesshandle: dword;autoattachopen: boolean=false); var newprocessname: string; i,j: integer; fname,expectedfilename: string; wasActive: boolean; //set to true if the table had AA scripts enabled or the code list had nopped instructions begin newprocessname:=copy(mainform.ProcessLabel.Caption,pos('-',mainform.ProcessLabel.Caption)+1,length(mainform.ProcessLabel.Caption)); if (debuggerthread<>nil) and (debuggerthread.attached) then begin memorybrowser.updateregisterview; AdvancedOptions.UpdateAdvancedOptions; end; symhandler.reinitialize; reinterpretaddresses; if oldprocess=0 then //set disassembler and hexview of membrowser to what the main header says memorybrowser.setcodeanddatabase; { if resu=mryes then begin try cbfasterscan.Checked:=true; foundcount:=0; foundlist.Clear; newscan.Caption:=strFirstScan; Groupbox1.Enabled:=true; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=true; scanvalue.Enabled:=true; newscan.Enabled:=true; nextscanbutton.Enabled:=false; vartype.Enabled:=true; scantype.Enabled:=true; scantext.enabled:=true; label4.enabled:=true; label8.Enabled:=true; HexadecimalCheckbox.Enabled:=true; cbCaseSensitive.Enabled:=true; scanvalue.visible:=true; scantext.Visible:=true; scanvalue.text:=''; Updatescantype; Scantype.ItemIndex:=0; //----------------------- //Get the expectedFilename //----------------------- SetExpectedTableName; except processlabel.Caption:=strError; raise exception.Create(strErrorWhileOpeningProcess); end; exit; end; } if (processhandle=0)then begin if newscan.Caption=strNewScan then newscan.click; //disable everything foundcount:=0; foundlist.Clear; newscan.Caption:=strFirstScan; Groupbox1.Enabled:=false; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=false; scanvalue.Enabled:=false; newscan.Enabled:=false; nextscanbutton.Enabled:=false; vartype.Enabled:=false; scantype.Enabled:=false; scantext.enabled:=false; label4.enabled:=false; label8.Enabled:=false; scanvalue.visible:=false; scantext.Visible:=false; scanvalue.text:=''; HexadecimalCheckbox.Enabled:=false; cbCaseSensitive.Enabled:=false; Updatescantype; Scantype.ItemIndex:=0; if cefuncproc.hypermode<>nil then freeandnil(cefuncproc.hypermode); cbSpeedhack.Enabled:=false; cbUnrandomizer.Enabled:=false; if processid<>$FFFFFFFF then begin processlabel.Caption:=strError; raise exception.Create(strErrorWhileOpeningProcess); end else begin processlabel.Caption:=strPhysicalMemory; end; UpdateScanType; end; if (processID=oldProcess) then exit; //a new process has been selected cbspeedhack.enabled:=true; cbunrandomizer.Enabled:=true; if (numberofrecords>0) or (advancedoptions.codelist2.items.Count>0) then begin if (messagedlg(strKeepList, mtConfirmation, [mbYes, mbNo], 0)=mrNo) then begin ClearList; end else begin //yes, so keep the list //go through the list and chek for auto assemble entries, and check if one is enabled. If so, ask to disable (withotu actually disabling) wasactive:=false; for i:=0 to numberofrecords-1 do if (memrec[i].VarType=255) and (memrec[i].Frozen) then begin wasActive:=true; break; end; if not wasactive then begin for i:=0 to length(AdvancedOptions.code)-1 do if AdvancedOptions.code[i].changed then begin wasActive:=true; break; end; end; if wasactive then begin if (messagedlg('There are one or more auto assembler entries or code changes enabled in this table. Do you want them disabled? (without executing the disable part)', mtConfirmation, [mbYes, mbNo], 0)=mryes) then begin for j:=0 to numberofrecords-1 do if (memrec[j].VarType=255) and (memrec[j].Frozen) then memrec[j].Frozen:=false; for j:=0 to length(AdvancedOptions.code)-1 do AdvancedOptions.code[i].changed:=false; Updatescreen; if AdvancedOptions.Visible then AdvancedOptions.Codelist2.Repaint; end; end; end; end; enablegui(nextscanbutton.enabled); Fname:=copy(processlabel.caption,pos('-',processlabel.caption)+1,length(processLabel.caption)); if FName[length(FName)-3]='.' then //it's a filename expectedFilename:=copy(FName,1,length(FName)-4)+'.ct' else //it's a normal title; expectedFilename:=FName+'.ct'; if not autoattachopen then begin if fileexists(expectedfilename) or fileexists(cheatenginedir+expectedfilename) then begin if messagedlg('Load the associated table? ('+expectedFilename+')',mtConfirmation, [mbyes,mbno],0)=mryes then begin autoopen:=true; if fileexists(expectedfilename) then opendialog1.FileName:=expectedfilename else opendialog1.FileName:=cheatenginedir+expectedfilename; LoadButton.Click; end; end; end; UpdateScanType; end; procedure TMainForm.ShowProcessListButtonClick(Sender: TObject); var oldprocess: Dword; resu: integer; i,j: integer; oldprocesshandle: thandle; oldprocessname: string; modulelist: tstringlist; begin if not openprocessPrologue then exit; oldprocessname:=copy(mainform.ProcessLabel.Caption,pos('-',mainform.ProcessLabel.Caption)+1,length(mainform.ProcessLabel.Caption)); oldprocess:=processID; oldprocesshandle:=processhandle; if Processwindow=nil then ProcessWindow:=TProcessWindow.Create(nil); resu:=ProcessWindow.ShowModal; if resu=mrCancel then exit; openProcessEpilogue(oldprocessname, oldprocess, oldprocesshandle); end; procedure TMainform.aprilfoolsscan; begin if aprilfools then begin if messagedlg('Thank you for trying out Cheat Engine. Because it has expired Cheat Engine will now close. Is that ok with you?',mtInformation,[mbyes,mbno],0)=mryes then begin showmessage('April fools!!!!'); end else begin if messagedlg('WHAT!!! Are you saying you''re going to continue using CE ILLEGALLY??? If you say yes, i''m going to mail the cops to get you and send you to jail!!!',mtwarning,[mbyes,mbno],0)=mryes then showmessage('Hrmpf... Because I''m in a good mood i''ll let you go this time. But don''t do it again you filthy pirate') else showmessage('April fools!!!!'); end; caption:=cenorm; aprilfools:=false; end; end; procedure TMainform.donewscan; var i: integer; begin if SaveFirstScanThread<>nil then //stop saving the results of the fist scan begin SaveFirstScanThread.Terminate; SaveFirstScanThread.WaitFor; freeandnil(SaveFirstScanThread); end; if cbfasterscan.checked then //tell hyperscan it is a new scan begin if (cefuncproc.hypermode<>nil) and (cefuncproc.hypermode.HyperscanWindow<>0) then sendmessage(cefuncproc.hypermode.HyperscanWindow,WM_USER+1,0,0); end; fastscan:=formsettings.cbFastscan.checked; //close files in case of a bug i might have missed... vartype.visible:=true; foundcount:=0; foundlist.Clear; newscan.Caption:=strFirstScan; nextscanbutton.Enabled:=false; vartype.Enabled:=true; scanvalue.visible:=true; scantext.Visible:=true; Updatescantype; Scantype.ItemIndex:=0; //enable the memory scan groupbox Groupbox1.Enabled:=true; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=true; VartypeChange(vartype); foundlist.deleteresults; if scanvalue.Visible and scanvalue.Enabled then begin scanvalue.SetFocus; scanvalue.SelectAll; end end; procedure TMainForm.NewScanClick(Sender: TObject); resourcestring strfillInSomething='Please fill in something!'; strFirstSelectAProcess='First select a process'; var FromAdd,ToAdd:Dword; error: Integer; // Tim,Tim2: TTimeStamp; Vtype,SType: Integer; Processhandle2: Thandle; i,j: integer; value: string; res: word; extra: boolean; a,b: string; winhandle:thandle; winprocess: dword; roundingtype: tfloatscan; value2:string; mi: tmoduleinfo; fr: dword; bytes: tbytes; begin if (not cbfasterscan.checked) then begin button2.click; exit; end; if (cefuncproc.hypermode<>nil) and advancedoptions.Pausebutton.down then raise exception.Create('Please unpause the game first'); res:=mrcancel; VType:=GetVarType; SType:=GetScanType; foundlist.Deinitialize; try if scanvalue2<>nil then value2:=scanvalue2.Text; screen.Cursor:=crhourglass; advanced:=false; undoscan.enabled:=false; lastscantype:=scantype.ItemIndex; case self.roundingtype of rtrounded: roundingtype:=rounded; rtExtremerounded: roundingtype:=extremerounded; rtTruncated: roundingtype:=truncated; end; foundlist.Clear; if not nextscanbutton.Enabled then //it's a first scan begin try if (not cbfasterscan.Checked) and (cbPauseWhileScanning.checked) then begin advancedoptions.Pausebutton.down:=true; advancedoptions.Pausebutton.Click; end; if (scanvalue.visible) and (scanvalue.text='') then raise Exception.Create(strFillInSomething); if (scanvalue2<>nil) and (value2='') then raise exception.Create(strFillInSomething); if processid<>0 then begin FromAdd:=ScanStart; ToAdd:=ScanStop; //-------------------------------------------------- if (SType=Exact_value) or (SType=String_scan) or (SType=BiggerThan) or (SType=SmallerThan) or (Stype=ValueBetween) then begin foundcountlabel.visible:=true; mainform.caption:=CERegionSearch; application.ProcessMessages; foundcountlabel.caption:=''; Processhandle2:=OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessId); try if formsettings.checkThread.checked or cbFasterScan.checked then begin formscanning:=TFormscanning.create(self); formscanning.button:=0; formscanning.scan:=1; formscanning.fromadd:=fromadd; formscanning.toadd:=toadd; formscanning.readonly:=readonly.checked; formscanning.stype:=stype; formscanning.vtype:=vtype; formscanning.fastscan:=fastscan; formscanning.scanvalue:=scanvalue.Text; formscanning.scanvalue2:=value2; formscanning.hexadecimal:=hexadecimalcheckbox.checked; formscanning.unicode:=cbunicode.checked; formscanning.LowMemoryUsage:=formsettings.cbLowMemoryUsage.checked; formscanning.Skip_PAGE_NOCACHE:=Skip_PAGE_NOCACHE; formscanning.ExtremeScan:=cbFasterscan.Checked; formscanning.roundingtype:=roundingtype; res:=formscanning.showmodal; end else begin foundcount:=0; //obsolete: GetMemoryRangesAndScanValue2(fr,FromAdd,ToAdd,readonly.checked,false,SType,vtype,scanvalue.text,value2,roundingtype,hexadecimalcheckbox.checked,progressbar1,fastscan,cbunicode.checked); end; if aprilfools then aprilfoolsscan; if vtype=5 then foundlist3.Columns[0].Width:=90 else foundlist3.Columns[0].Width:=82; symhandler.loadmodulelist; //reload this to be sure lastwashex:=HexadecimalCheckbox.checked; finally screen.Cursor:=crdefault; progressbar1.Position:=0; mainform.Caption:=CEnorm; UpdateFoundlisttimer.Enabled:=true; end; if res=mrcancel then begin screen.Cursor:=crdefault; exit; end; Groupbox1.Enabled:=false; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=false; vartype.Enabled:=false; nextscanbutton.enabled:=true; newscan.Caption:=strNewScan; beep; UpdateScanType; Scantype.ItemIndex:=lastscantype; screen.Cursor:=crdefault; if SaveFirstScanThread<>nil then begin SaveFirstScanThread.Terminate; SaveFirstScanThread.WaitFor; freeandnil(SaveFirstScanThread); end; SaveFirstScanThread:=TSaveFirstScanThread.Create(false); exit; end; //--------------------------------------------------------- mainform.Caption:=CEregion; application.ProcessMessages; try UpdateFoundlisttimer.Enabled:=false; if formsettings.checkThread.checked or cbFasterScan.checked then begin formscanning:=TFormscanning.create(self); formscanning.button:=0; formscanning.scan:=0; formscanning.fromadd:=fromadd; formscanning.toadd:=toadd; formscanning.readonly:=readonly.checked; formscanning.stype:=stype; formscanning.vtype:=vtype; formscanning.scanvalue:=scanvalue.Text; formscanning.scanvalue2:=value2; formscanning.fastscan:=fastscan; formscanning.LowMemoryUsage:=formsettings.cbLowMemoryUsage.checked; formscanning.Skip_PAGE_NOCACHE:=Skip_PAGE_NOCACHE; formscanning.ExtremeScan:=cbFasterscan.Checked; res:=formscanning.showmodal; end else foundcount:=0; //obsolete: GetMemoryRanges2(FromAdd,ToAdd,readonly.checked,progressbar1,vtype,fastscan); if aprilfools then aprilfoolsscan; finally progressbar1.Position:=0; mainform.Caption:=CEnorm; UpdateFoundlisttimer.Enabled:=true; end; if res=mrcancel then begin screen.Cursor:=crdefault; exit; end; application.ProcessMessages; // if Scantype.ItemIndex=String_Scan then foundlabel.caption:=IntToStr(TextSearch(scanvalue.text,foundlist)); //main datafiles have been generated. Now let Next Scan do the remaining work. if not ((Stype=Advanced_scan) or (SType=string_scan)) then NextScanbutton.click else begin Beep; end; nextscanbutton.enabled:=true; newscan.Caption:=strNewScan; vartype.enabled:=false; Groupbox1.Enabled:=false; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=false; scantype.ItemIndex:=lastscantype; //save the results of the fist scan if SaveFirstScanThread<>nil then begin SaveFirstScanThread.Terminate; SaveFirstScanThread.WaitFor; freeandnil(SaveFirstScanThread); end; SaveFirstScanThread:=TSaveFirstScanThread.Create(false); end else showmessage(strFirstSelectaProcess); finally if (not cbfasterscan.Checked) and (cbPauseWhileScanning.checked) then begin advancedoptions.Pausebutton.down:=false; //resume advancedoptions.Pausebutton.Click; end; end; end else //it's a new scan DoNewScan; if stype=string_scan then nextscanbutton.enabled:=false; if (foundcount=0) and (SType<>Advanced_scan) then NextScanButton.enabled:=false; progressbar1.max:=10; progressbar1.Position:=0; UpdateScanType; UpdateScanType; //second time to force the repaint screen.Cursor:=crdefault; finally scanEpilogue(res=mrcancel); end; end; procedure TMainForm.NextScanButtonClick(Sender: TObject); resourcestring strCantdoNextScan='You can''t do a Next Scan with the current selected way of scanning!'; var error: Integer; Vtype,SType: Integer; hexvalue: string; i,j: integer; temp,temp2: dword; a,b:string; FromAdd,ToAdd:Dword; roundingtype:tfloatscan; value2: string; percentage: boolean; mi: tmoduleinfo; res: word; bytes: tbytes; begin if (not cbfasterscan.checked) then begin button4.click; exit; end; if (cefuncproc.hypermode<>nil) and advancedoptions.Pausebutton.down then raise exception.Create('Please unpause the game first'); if SaveFirstScanThread<>nil then begin SaveFirstScanThread.WaitFor; //wait till it's done freeandnil(SaveFirstScanThread); end; if scanvalue2<>nil then value2:=scanvalue2.Text; if cbpercentage<>nil then percentage:=cbpercentage.Checked; VType:=GetVarType; SType:=GetScanType; foundlist.Deinitialize; try screen.Cursor:=crhourglass; if (not cbfasterscan.Checked) and (cbPauseWhileScanning.checked) then begin advancedoptions.Pausebutton.down:=true; advancedoptions.Pausebutton.Click; end; foundcountlabel.visible:=true; VType:=GetVarType; SType:=GetScanType; if rt1.checked then roundingtype:=rounded; if rt2.checked then roundingtype:=extremerounded; if rt3.Checked then roundingtype:=truncated; mainform.caption:=CESearch; application.ProcessMessages; try UpdateFoundlisttimer.Enabled:=false; if not((Stype=Advanced_scan) or (Stype=string_scan)) then begin if vtype=5 then begin bitoffsetchange:=0; //open the memoryfile end check to see if the length of the bits are what they need to be assignfile(Memoryfile,cheatenginedir+'MEMORY.TMP'); reset(memoryfile,1); blockread(memoryfile,temp,4,temp2); setlength(bitscan,temp); blockread(memoryfile,pointer(bitscan)^,temp,temp2); closefile(memoryfile); if rbbit.Checked then if temp<>length(scanvalue.Text) then begin formDifferentBitSize:=tformDifferentBitSize.create(self); formDifferentBitSize.newbit:=scanvalue.Text; formDifferentBitSize.showmodal; bitoffsetchange:=formdifferentbitsize.delta; formdifferentbitsize.free; end; if rbdec.checked then if temp<>length(inttobin(strtoint(scanvalue.Text))) then begin formDifferentBitSize:=tformDifferentBitSize.create(self); formDifferentBitSize.newbit:=inttobin(strtoint(scanvalue.Text)); formDifferentBitSize.showmodal; bitoffsetchange:=formdifferentbitsize.delta; formdifferentbitsize.free; end; if cbfasterscan.checked then hyperscanview.bitoffsetchange:=bitoffsetchange; end; vartype.Enabled:=false; foundlist.Clear; foundcountlabel.caption:=''; if formsettings.checkThread.checked or cbfasterscan.checked then begin val('$'+FromAddress.text,FromAdd,error); val('$'+ToAddress.text,ToAdd,error); formscanning:=TFormscanning.create(self); formscanning.button:=1; formscanning.scan:=2; formscanning.stype:=stype; formscanning.vtype:=vtype; formscanning.fromadd:=fromadd; formscanning.toadd:=toadd; formscanning.fastscan:=fastscan; formscanning.scanvalue:=scanvalue.Text; formscanning.scanvalue2:=value2; formscanning.hexadecimal:=hexadecimalcheckbox.checked; formscanning.unicode:=cbunicode.Checked; formscanning.percentage:=percentage; formscanning.LowMemoryUsage:=formsettings.cbLowMemoryUsage.checked; formscanning.Skip_PAGE_NOCACHE:=Skip_PAGE_NOCACHE; formscanning.ExtremeScan:=cbFasterscan.Checked; formscanning.roundingtype:=roundingtype; res:=formscanning.showmodal; end else foundcount:=0; //obsolete: nextscan2(scanvalue.text,value2,stype,vtype,roundingtype,hexadecimalcheckbox.Checked,progressbar1,fastscan,cbunicode.checked,percentage); foundlist.Clear; Beep; end else showmessage(strCantDoNextScan); finally UpdateFoundlisttimer.Enabled:=true; mainform.caption:=CENorm; progressbar1.max:=10; progressbar1.Position:=0; screen.Cursor:=crdefault; if scanvalue.Enabled then scanvalue.SelectAll; end; finally scanepilogue(res=mrcancel); if (not cbfasterscan.Checked) and (cbPauseWhileScanning.checked) then begin advancedoptions.Pausebutton.down:=false; //resume advancedoptions.Pausebutton.Click; end; UpdateScanType; end; end; procedure TMainForm.btnMemoryViewClick(Sender: TObject); begin memorybrowser.show; end; procedure TMainForm.FormCreate(Sender: TObject); resourcestring strClickToGoHome='Click here to go to the Cheat Engine homepage'; var pid: dword; tokenhandle: thandle; tp:TTokenPrivileges; prev: TTokenPrivileges; ReturnLength: Dword; reg: tregistry; differentWidth: integer; x: array of integer; errormode: dword; begin TVistaAltFix.Create(Self); errormode:=SetErrorMode(0); setErrorMode(errormode or SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX); foundlist:=tfoundlist.create(foundlist3,foundcountlabel); actScriptEngine.ShortCut:=TextToShortCut('Ctrl+Shift+C'); hotkeypressed:=-1; ceclipboardformat:=RegisterClipboardFormat('CE_ENTRY'); HyperscanFileMapping:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,sizeof(tscansettings),'CEHYPERSCANSETTINGS'); if HyperscanFileMapping<>0 then begin HyperscanView:=MapViewOfFile(HyperscanFileMapping,FILE_MAP_ALL_ACCESS,0,0,0); if hyperscanview=nil then closehandle(HyperscanFileMapping); zeromemory(hyperscanview,sizeof(tscansettings)); end; if hyperscanview<>nil then begin hyperscanview.mainformHandle:=handle; hyperscanview.applicantionhandle:=application.Handle; hyperscanview.CheatEngineDir:=CheatEngineDir; hyperscanview.CEProcessID:=GetCurrentProcessId; hyperscanview.CEMainThreadID:=getcurrentthreadid; end; pid:=GetCurrentProcessID; ownprocesshandle:=OpenProcess(PROCESS_ALL_ACCESS,true,pid); tokenhandle:=0; if ownprocesshandle<>0 then begin if OpenProcessToken(ownprocesshandle,TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES ,tokenhandle) then begin if lookupPrivilegeValue(nil, 'SeDebugPrivilege' ,tp.Privileges[0].Luid) then begin tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; tp.PrivilegeCount := 1; // One privilege to set if not AdjustTokenPrivileges(tokenhandle,false,tp,sizeof(tp),@prev,returnlength) then showmessage('Failure setting the debug privilege. Debugging may be limited.'); end; end; end; fcontrol:=tfcontrol.Create(self); with fcontrol do begin parent:=panel1; OnEnter:=FControlEnter; OnExit:=FcontrolExit; OnKeyDown:=FControlKeyDown; OnKeyPress:=FControlKeyPress; PopupMenu:=PopupMenu2; helpcontext:=10; left:=5; top:=57; height:=21; width:=81; taborder:=12; sendtoback; end; tempbitmap:=TBitmap.create; scanvalue.text:=''; windows.OnClick(windows); isbit:=false; debugger.Semaphore:=createsemaphore(nil,1,1,nil); panel3.DoubleBuffered:=true; old8087CW:=Get8087CW; Set8087CW($133f); application.OnException:=exceptionhandler; debugproc:=false; //get current screen resolution (when switching back for debug) originalwidth:=screen.Width; originalheight:=screen.Height; Memimage:=TMemorystream.Create; FirstShiftSelected:=-1; oldwidth:=screen.width; oldheight:=screen.height; oldnumberofrecords:=0; ProcessHandler.ProcessHandle:=0; logo.Hint:=strClickToGoHome; logo.ShowHint:=true; numberoflines:=7; setlength(frozenbox,7); frozenbox[0]:=checkbox1; frozenbox[1]:=checkbox2; frozenbox[2]:=checkbox3; frozenbox[3]:=checkbox4; frozenbox[4]:=checkbox5; frozenbox[5]:=checkbox6; frozenbox[6]:=checkbox7; setlength(description,7); description[0]:=label28; description[1]:=label9; description[2]:=label17; description[3]:=label19; description[4]:=label33; description[5]:=label32; description[6]:=label31; setlength(address,7); address[0]:=label23; address[1]:=label10; address[2]:=label20; address[3]:=label21; address[4]:=label34; address[5]:=label35; address[6]:=label36; setlength(valtype,7); valtype[0]:=label18; valtype[1]:=label11; valtype[2]:=label22; valtype[3]:=label24; valtype[4]:=label40; valtype[5]:=label39; valtype[6]:=label37; setlength(value,7); value[0]:=label13; value[1]:=label14; value[2]:=label25; value[3]:=label26; value[4]:=label41; value[5]:=label42; value[6]:=label43; setlength(select,7); select[0]:=label12; select[1]:=label3; select[2]:=label16; select[3]:=label15; select[4]:=label27; select[5]:=label29; select[6]:=label30; setlength(freezedirection,7); freezedirection[0]:=label44; freezedirection[1]:=label45; freezedirection[2]:=label46; freezedirection[3]:=label47; freezedirection[4]:=label48; freezedirection[5]:=label49; freezedirection[6]:=label50; updatescreen; newaddress:=0; VarType.ItemIndex:=3; oldvartype:=3; UpdateScantype; ScanType.ItemIndex:=0; newscan.caption:=strFirstScan; Updatelist; scrollbox1.DoubleBuffered:=true; //remove flickering headercontrol1.DoubleBuffered:=true; hookedin:=false; //allignment fixes for some window style's that mess up with thick borders (like vista) differentWidth:=logopanel.left-(clientwidth-logopanel.width); button1.Left:=clientwidth-button1.width; commentbutton.left:=clientwidth-commentbutton.width; logopanel.left:=clientwidth-logopanel.width; speedbutton4.Left:=clientwidth-speedbutton4.width; progressbar1.Width:=progressbar1.width-differentwidth; undoscan.left:=undoscan.left-differentwidth; //create object for the auto attach list autoattachlist:=tstringlist.create; autoattachlist.CaseSensitive:=false; //set it up as not case sensitive randomize; pluginhandler:=TPluginhandler.create; {$ifdef ceasinjectabledll} //panel7.Visible:=false; speedbutton1.enabled:=false; processid:=getcurrentprocessid; processhandle:=getcurrentprocess; enableGui; processlabel.Caption:=Inttohex(processid,8)+' : '+'Current process'; {$endif} setlength(x,7); if loadformposition(self,x) then begin headercontrol1.Sections[0].Width:=x[0]; headercontrol1.Sections[1].Width:=x[1]; headercontrol1.Sections[2].Width:=x[2]; headercontrol1.Sections[3].Width:=x[3]; headercontrol1.Sections[4].Width:=x[4]; panel5.height:=x[5]; foundlist3.columns[0].width:=x[6]; end; oldhandle:=mainform.handle; OnChangedHandle:=ChangedHandle; symhandler.loadCommonModuleList; end; procedure TMainForm.ChangedHandle(Sender: TObject); begin memscan.setScanDoneCallback(mainform.handle,wm_scandone); //reset the hotkeys hotkeyTargetWindowHandleChanged(oldhandle,mainform.handle); oldhandle:=mainform.handle; end; procedure TMainForm.AddressKeyPress(Sender: TObject; var Key: Char); begin hexadecimal(key); end; procedure TMainForm.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=(source is TListbox); end; procedure TMainForm.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); begin speedbutton3.click; end; procedure TMainForm.FoundListDblClick(Sender: TObject); begin if foundList3.SelCount>0 then AddToRecord(FoundList3.ItemIndex); FControl.SetFocus; end; procedure TMainForm.Browsethismemoryarrea1Click(Sender: TObject); var a,b: dword; s: string; begin if (foundlist3.ItemIndex<>-1) then begin MemoryBrowser.memoryaddress:=foundlist.GetAddress(foundlist3.itemindex,b,s); memorybrowser.show; end; end; procedure TMainForm.UpdateTimerTimer(Sender: TObject); begin updatetimer.Enabled:=false; inc(reinterpretcheck); if reinterpretcheck mod 15=0 then reinterpretaddresses; UpdateList; updatetimer.Enabled:=true; end; procedure TMainForm.FreezeTimerTimer(Sender: TObject); begin freezetimer.enabled:=false; FreezeThem; freezetimer.enabled:=true; end; procedure TMainForm.ScrollBar1Change(Sender: TObject); begin updatescreen; updatelist; end; procedure TMainForm.Label28Click(Sender: TObject); var newdesc: string; resourcestring strChangeDescription1='Description'; strChangeDescription2='Change the description to:'; begin if lastselected<>scrollbar1.position+(sender as TLabel).tag then exit; newdesc:=InputBox(strChangeDescription1,strChangeDescription2,memrec[scrollbar1.position+(sender as TLabel).tag].Description); if newdesc='' then newdesc:=strNoDescription; memrec[scrollbar1.position+(sender as TLabel).tag].Description:=newdesc; updatescreen; end; procedure TMainForm.AddressClick(Sender: TObject); var adr: String; newadr: dword; error: Integer; bit: Byte; begin // if memrec[scrollbar1.position+(sender as TLabel).tag].Frozen then // raise Exception.Create('You first have to unfreeze this address before you can change it'); formaddresschange:=TFormaddresschange.Create(self); formaddresschange.index:=scrollbar1.position+(sender as TLabel).tag; formaddresschange.index2:=(sender as TLabel).tag; formaddresschange.showmodal; //address popup updatescreen; updatelist; end; procedure TMainForm.TypeClick(Sender: TObject); var i,j: Integer; oldType: Integer; begin OldType:=memrec[scrollbar1.position+(sender as TLabel).tag].VarType; // if memrec[scrollbar1.position+(sender as TLabel).tag].Frozen then // Raise Exception.Create('You can''t change the type of an frozen value. First unfreeze it!'); TypeForm.NrOfRecord:=scrollbar1.position+(sender as TLabel).tag; If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=0 then TypeForm.VarType.itemindex:=1 else //byte If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=1 then TypeForm.VarType.itemindex:=2 else //word If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=2 then TypeForm.VarType.itemindex:=3 else //dword If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=3 then TypeForm.VarType.itemindex:=5 else //float If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=4 then TypeForm.VarType.itemindex:=6 else //double If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=5 then begin TypeForm.VarType.itemindex:=0; //bit TypeForm.Edit2.text:=IntToStr(memrec[scrollbar1.position+(sender as TLabel).tag].bitlength); end else If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=6 then TypeForm.VarType.itemindex:=4 else //int64 If memrec[scrollbar1.position+(sender as TLabel).tag].VarType=7 then begin TypeForm.VarType.itemindex:=7; typeform.cbunicode.checked:=memrec[scrollbar1.position+(sender as TLabel).tag].unicode; TypeForm.Edit1.text:=IntToStr(memrec[scrollbar1.position+(sender as TLabel).tag].bit); end else if memrec[scrollbar1.position+(sender as TLabel).Tag].VarType=8 then Typeform.VarType.ItemIndex:=8; case memrec[scrollbar1.position+(sender as TLabel).tag].Bit of 0 : TypeForm.RadioButton1.checked:=true; 1 : TypeForm.RadioButton2.checked:=true; 2 : TypeForm.RadioButton3.checked:=true; 3 : TypeForm.RadioButton4.checked:=true; 4 : TypeForm.RadioButton5.checked:=true; 5 : TypeForm.RadioButton6.checked:=true; 6 : TypeForm.RadioButton7.checked:=true; 7 : TypeForm.RadioButton8.checked:=true; end; if TypeForm.Showmodal=mrNo then exit; j:=memrec[scrollbar1.position+(sender as TLabel).tag].VarType; for i:=0 to numberofrecords-1 do begin if (selected[i]) then begin if memrec[i].vartype<>255 then memrec[i].VarType:=j; memrec[i].Frozen:=false; end; end; updatescreen; updatelist; end; //vars for changevalue var differentsizesanswer:boolean; terminatewith0answer:boolean; askfordifferentsizesonce:boolean; asked:boolean; procedure TMainform.ChangeValue(Itemnr: integer; NewValue:String); var newvalue1: Byte; oldvalue1: byte; newvalue2: word; newvalue3: dword; newvalue4: Single; newvalue5: Double; newvalue6: Int64; newvalueSt: String; newvaluest2: widestring; newvalue8: TBytes; newbytes: array of byte; text: pchar; addzero: boolean; write: dword; error,i,j,k,l: Integer; bl:integer; original: dword; thistype: integer; nrselected: integer; realaddress,realaddress2,count:dword; check: boolean; resourcestring strNotTheSameSize1='The text you entered isn''t the same size as the original. Continue?'; strNotTheSameSize2='Not the same size!'; strAdd0='Do you want to add a ''0''-terminator at the end?'; strNotAValidNotation='This is not a valid notation'; strNotSameAmmountofBytes='The number of bytes you typed is not the same as the previous ammount. Continue?'; strNotAValidBinaryNotation=' is not a valid binary notation!'; begin thistype:=memrec[itemnr].VarType; newvaluest:=newvalue; error:=0; if memrec[itemnr].IsPointer then begin //find the real address realaddress2:=memrec[itemnr].pointers[length(memrec[itemnr].pointers)-1].Address; for j:=length(memrec[itemnr].pointers)-1 downto 0 do begin check:=(realaddress2<($7fffffff-4)) and readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[itemnr].pointers[j].offset else begin beep; exit; end; end; realaddress:=realaddress2; end else realaddress:=memrec[itemnr].Address; case thistype of 0,1,2,6: begin val(newvaluest,newvalue6,error); if error=0 then begin newvalue1:=byte(newvalue6); newvalue2:=word(newvalue6); newvalue3:=dword(newvalue6); end; end; 3,4: begin val(newvaluest,newvalue5,error); if error<>0 then begin if newvaluest[error]=',' then newvaluest[error]:='.' else if newvaluest[error]='.' then newvaluest[error]:=','; error:=0; val(newvaluest,newvalue5,error); end; newvalue4:=newvalue5; end; 5: begin if formsettings.cbBinariesAsDecimal.checked then begin try newvalue6:=StrToInt(newvaluest); newvaluest:=inttobin(newvalue6); except error:=1; end; end; end; 7: begin addzero:=false; if length(newvaluest)<>memrec[itemnr].Bit then begin if askfordifferentsizesonce and (not asked) then begin asked:=true; differentsizesanswer:=false; if messagebox(mainform.handle,pchar(strNotTheSameSize1),pchar(strNotTheSameSize2),MB_YESNO or MB_ICONWARNING)=IDNO then exit; differentsizesanswer:=true; //continue //no way back memrec[itemnr].OldValue:=getStringFromRecord(itemnr); addzero:=(messagebox(mainform.handle,pchar(strAdd0),pchar(CEnorm),MB_YESNO or MB_ICONQUESTION) = IDYES); terminatewith0answer:=addzero; memrec[itemnr].Bit:=length(newvaluest); end; if differentsizesanswer then begin //continue addzero:=terminatewith0answer; memrec[itemnr].OldValue:=getStringFromRecord(itemnr); memrec[itemnr].Bit:=length(newvaluest); end; end; newvalue1:=0; newvalue2:=0; if memrec[itemnr].unicode then begin newvaluest2:=newvaluest; VirtualProtectEx(processhandle, pointer(realaddress),1,PAGE_EXECUTE_READWRITE,original); writeprocessmemory(processhandle,pointer(realaddress),@newvaluest2[1],length(newvaluest2)*2,write); if addzero then writeprocessmemory(processhandle,pointer(realaddress+length(newvaluest)*2),addr(newvalue2),2,write); VirtualProtectEx(processhandle, pointer(realaddress),1,original,write); frozenstrings[itemnr]:=newvaluest; freemem(text); end else begin getmem(text,length(newvaluest)); StrCopy(text, PChar(newvaluest)); VirtualProtectEx(processhandle, pointer(realaddress),1,PAGE_EXECUTE_READWRITE,original); writeprocessmemory(processhandle,pointer(realaddress),text,length(newvaluest),write); if addzero then writeprocessmemory(processhandle,pointer(realaddress+length(newvaluest)),addr(newvalue1),1,write); VirtualProtectEx(processhandle, pointer(realaddress),1,original,write); frozenstrings[itemnr]:=newvaluest; freemem(text); end; exit; end; 8: begin for i:=1 to length(newvaluest) do case newvaluest[i] of '0'..'9' : ; 'a'..'f' : ; 'A'..'F' : ; ' ','-' : ; else raise exception.create(strNotAValidNotation); end; ConvertStringToBytes(newvaluest,true,newvalue8); if length(newvalue8)<>memrec[itemnr].Bit then if messagebox(mainform.handle,pchar(strNotSameAmmountOfBytes),pchar(StrNotTheSameSize2),MB_YESNO or MB_ICONWARNING)=IDNO then exit; memrec[itemnr].OldValue:=getStringFromRecord(itemnr); memrec[itemnr].Bit:=length(newvalue8); setlength(frozenbytes[itemnr],length(newvalue8)); for i:=0 to length(newvalue8)-1 do frozenbytes[itemnr][i]:=newvalue8[i]; RewriteData(processhandle,realaddress,@frozenbytes[itemnr][0],length(newvalue8)); setlength(newvalue8,0); exit; end; end; if error>0 then raise Exception.Create(strNotAValidNotation); memrec[itemnr].OldValue:=getStringFromRecord(itemnr); i:=itemnr; VirtualProtectEx(processhandle, pointer(realaddress),1,PAGE_EXECUTE_READWRITE,original); case memrec[i].VarType of 0: //byte begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue1),1,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then memrec[i].FrozenValue:=newvalue1; end; 1: //word begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue2),2,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then memrec[i].FrozenValue:=newvalue2; end; 2: //dword begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue3),4,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then memrec[i].FrozenValue:=newvalue3; end; 3: //single begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue4),4,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then FrozenFValue[i]:=newvalue4 end; 4: //double begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue5),8,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then FrozenFValue[i]:=newvalue5 end; 5: //binary begin bl:=1+((memrec[i].bit+length(newvaluest)-1) div 8); setlength(newbytes,bl); ReadProcessMemory(processhandle,pointer(realaddress),@newbytes[0],bl,write); j:=0; k:=memrec[i].bit; for l:=length(newvaluest) downto 1 do begin case newvaluest[l] of '0' : setbit(k,newbytes[j],0); '1' : setbit(k,newbytes[j],1); '*','?': ; else raise exception.Create(newvaluest+strNotAValidBinaryNotation); end; inc(k); if k>=8 then begin inc(j); k:=0; end; end; writeprocessmemory(processhandle,pointer(realaddress),@newbytes[0],bl,write); frozenstrings[i]:=newvaluest; setlength(newbytes,0); end; 6: //Int64 begin writeprocessmemory(processhandle,pointer(realaddress),addr(newvalue6),8,write); if (hotkeys[i]=-1) or (memrec[i].Frozendirection=0) then memrec[i].FrozenValue:=newvalue6; end; end; //set old security back VirtualProtectEx(processhandle, pointer(realaddress),1,original,write); updatelist; end; procedure TMainForm.ValueClick(Sender: TObject); var newvalue1: Byte; oldvalue1: byte; newvalue2: word; newvalue3: dword; newvalue4: Single; newvalue5: Double; newvalue6: Int64; newvalueSt: String; newvalue8: TBytes; newbytes: array of byte; text: pchar; addzero: boolean; write: dword; error,i,j,k,l: Integer; bl:integer; original: dword; thistype: integer; nrselected: integer; realaddress,realaddress2,count:dword; stringsize: integer; resourcestring strValue='Value'; strChange1Value='Change this value to:'; strChangeMoreValues='Change these values to:'; begin differentsizesanswer:=false; terminatewith0answer:=false; askfordifferentsizesonce:=false; asked:=false; if scrollbar1.position+(sender as TLabel).tag>=NumberOfRecords then exit; if memrec[scrollbar1.position+(sender as TLabel).tag].VarType=255 then begin //auto assembler script Changescript1.Click; exit; end; if (value[(sender as TLabel).tag].Caption='??') or (value[(sender as TLabel).tag].Caption='NAN') or (value[(sender as TLabel).tag].Caption='INF') then begin beep; exit; end; nrselected:=0; thistype:=memrec[scrollbar1.position+(sender as TLabel).tag].VarType; stringsize:=memrec[scrollbar1.position+(sender as TLabel).tag].Bit; askfordifferentsizesonce:=true; for i:=0 to numberofrecords-1 do begin if selected[i] then begin if stringsize<>memrec[i].Bit then askfordifferentsizesonce:=false; inc(nrselected); if memrec[i].VarType<>thistype then begin //check for compatibility if ((thistype in [0,1,2,6]) and not (memrec[i].VarType in [0,1,2,6])) or ((thistype in [3,4]) and not (memrec[i].VarType in [3,4])) or (thistype=5) or (thistype=7) or (thistype=8) then begin beep; //stupid lame beepsound exit; end; end; end; end; newvaluest:=value[(sender as TLabel).tag].Caption; if thistype in [7,8] then begin if not InputQuery(strValue,strChange1Value,newvaluest) then exit; end else begin if nrselected>1 then begin if not InputQuery(strValue,strchangeMoreValues,newvaluest) then exit; end else begin if not InputQuery(strValue,strChange1Value,newvaluest) then exit; end; end; for i:=0 to numberofrecords-1 do begin if selected[i] then ChangeValue(i,newvaluest); end; updatelist; end; procedure TMainForm.Browsethismemoryregion1Click(Sender: TObject); var address: dword; realaddress,realaddress2: dword; j: integer; check: boolean; count: dword; begin try if memrec[lastselected].IsPointer then begin realaddress2:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; for j:=length(memrec[lastselected].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[lastselected].pointers[j].offset else raise exception.Create('The pointer can''t be completly read'); end; address:=realaddress2; end else address:=memrec[lastselected].address; except address:=memrec[lastselected].address; end; MemoryBrowser.memoryaddress:=address; memorybrowser.show; end; procedure TMainForm.Label24ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin beep; end; procedure TMainForm.Deletethisrecord1Click(Sender: TObject); var i,j: Integer; comfirm: Word; deletegroup: grouptype; IsGroup: boolean; multiplegroups: boolean; resourcestring strDelete1Address='Delete this address?'; strDeleteMultipleAddresses='Delete these addresses?'; strDelete1Group='Also delete the group this address is a member of?'; strDeleteMoreGroups='Also delete the groups of the addresses you selected?'; begin //delete selectedrecord isgroup:=false; multiplegroups:=false; for i:=1 to 6 do deletegroup[i]:=false; i:=0; j:=0; while (i0 then begin if isgroup and (deletegroup[memrec[i].Group]) then multiplegroups:=true; deletegroup[memrec[i].Group]:=true; isgroup:=true; end; end; inc(i); end; comfirm:=MrNo; if j>1 then comfirm:=Messagedlg(strDeleteMultipleAddresses, mtWarning, [mbYes, mbNo], 0); if j=1 then comfirm:=Messagedlg(strDelete1Address, mtWarning, [mbYes, mbNo], 0); if j=0 then exit; if comfirm=mrNo then exit; if isgroup and not multiplegroups then comfirm:=Messagedlg(strDelete1group, mtConfirmation, [mbYes, mbNo], 0); if isgroup and multiplegroups then comfirm:=Messagedlg(strDeleteMoreGroups, mtConfirmation, [mbYes, mbNo], 0); deleterecords; if comfirm=mrYes then deletegroups(deletegroup); end; procedure TMainForm.SortByFrozenButtonClick(Sender: TObject); var temprec: memoryrecord; tempFvalue: double; tempstring: string; i,j: Integer; lastfrozen: Integer; TempSelected: boolean; temphotkey: integer; tempbytes: array of byte; begin //sort memrec by frozen i:=0; lastfrozen:=-1; while (imryes then exit else firstispointer:=true; if selectedi>1 then begin //see if there are (other) pointers selected for i:=0 to numberofrecords-1 do if (i<>lastselected) and (selected[i]) and (memrec[i].IsPointer) then begin if firstispointer then re:=strMorePointers else re:=strMorePointers2; if messagedlg(re,mtConfirmation,[mbyes,mbno],0)=mrno then dontdopointers:=true; break; end; end else begin //all addresses for i:=0 to numberofrecords-1 do if (i<>lastselected) and (memrec[i].IsPointer) then begin if firstispointer then re:=strMorePointers else re:=strMorePointers2; if messagedlg(re,mtConfirmation,[mbyes,mbno],0)=mrno then dontdopointers:=true; break; end; end; newaddress:=memrec[lastselected].address; if (foundlist3.SelCount>0) then newaddress:=foundlist.GetAddress(foundlist3.ItemIndex); changeoffset:=TChangeOffset.create(self); if memrec[lastselected].IsPointer then changeoffset.FromAddress:=memrec[i].pointers[length(memrec[i].pointers)-1].Address else changeoffset.FromAddress:=memrec[lastselected].address; changeoffset.toAddress:=NewAddress; if changeoffset.showmodal=mrCancel then exit; if changeoffset.error>0 then raise exception.Create(strNotAValidValue); calculate:=changeoffset.offset; for i:=0 to Numberofrecords-1 do if ((selectedi>1) and selected[i]) or (selectedi=1) then begin if (memrec[i].interpretableaddress<>'') and (not memrec[i].IsPointer) then begin //check if it's a normal address or a interpretable address val('$'+memrec[i].interpretableaddress,j,err); if err>0 then begin if res=-1 then begin res:=messagedlg('The record with description '''+memrec[i].Description+''' has as interpretable address '''+memrec[i].interpretableaddress+'''. The recalculation will change it to '+symhandler.getNameFromAddress(memrec[i].Address+calculate,true,true)+'. Do you want to edit it to the new address?',mtconfirmation,[mbyes,mbno,mbNoToAll,mbYesToAll,mbCancel],0); if res=mrcancel then exit; end; ok:=(res=mryes) or (res=mrYesToAll); if (res=mryes) or (res=mrno) then res:=-1; //reset end else ok:=true; end else ok:=true; if ok then begin inc(memrec[i].Address,calculate); if memrec[i].interpretableaddress<>'' then memrec[i].interpretableaddress:=symhandler.getNameFromAddress(memrec[i].Address,true,true); if memrec[i].IsPointer then begin if not dontdopointers then begin if memrec[i].pointers[length(memrec[i].pointers)-1].Interpretableaddress<>'' then begin val('$'+memrec[i].pointers[length(memrec[i].pointers)-1].Interpretableaddress,j,err); if err>0 then begin if res=-1 then begin res:=messagedlg('The record with description '''+memrec[i].Description+''' has as interpretable base pointer:'''+memrec[i].pointers[length(memrec[i].pointers)-1].Interpretableaddress+'''. The recalculation will make it '+symhandler.getNameFromAddress((memrec[i].pointers[length(memrec[i].pointers)-1].Address+calculate),true,true)+'. Do you want to edit it to the new address?',mtconfirmation,[mbyes,mbno,mbNoToAll,mbYesToAll,mbCancel],0); if res=mrcancel then exit; end; ok:=(res=mryes) or (res=mrYesToAll); if (res=mryes) or (res=mrno) then res:=-1; //reset end else ok:=true; end; if ok then begin inc(memrec[i].pointers[length(memrec[i].pointers)-1].Address,calculate); if memrec[i].pointers[length(memrec[i].pointers)-1].Interpretableaddress<>'' then memrec[i].pointers[length(memrec[i].pointers)-1].Interpretableaddress:=symhandler.getNameFromAddress(memrec[i].pointers[length(memrec[i].pointers)-1].Address,true,true); end; end; end; end; end; updatescreen; end; procedure TMainForm.Button1Click(Sender: TObject); begin if addform=nil then addform:=Taddform.create(self); addform.showmodal end; procedure TMainForm.ScanTypeChange(Sender: TObject); begin updatescantype; end; procedure TMainForm.VarTypeChange(Sender: TObject); var a: int64; pa: ^int64; pb: ^dword; b: double; c: Integer; d: single; i: integer; hexvis: boolean; decbitvis: boolean; hexleft: integer; hextext: string; hexwidth: integer; casevis: boolean; oldscantype: integer; error: integer; temp:string; newvartype: integer; unicodevis: boolean; tc:tbitmap; begin newvartype:=vartype.ItemIndex; dontconvert:=true; hexvis:=true; unicodevis:=false; hexleft:=rbbit.Left; hexwidth:=50; hextext:='Hex'; casevis:=false; decbitvis:=false; //convertroutine: case oldvartype of 0: //it was a bit begin case newvartype of 1,2,3,4,5,6: begin //convert it to a normal value if rbbit.checked then begin //convert it to a decimal value rbdec.Checked:=true; rbdec.OnClick(rbdec); end; end; 7: ; //just leave it 8: //array of byte begin //first convert it to a array of byte if rbbit.checked then begin //convert it to a decimal value rbdec.Checked:=true; rbdec.OnClick(rbdec); end; //now convert it to a array of byte try a:=strtoint(scanvalue.text); scanvalue.text:=vartobytes(@a,8); except scanvalue.text:=''; end; end; end; end; 1,2,3,4,5,6,9: begin //it was one of the normal values hexstateForIntTypes:=hexadecimalcheckbox.Checked; case newvartype of 0: //it gets converted to a binary begin //set if oldvartype in [1,2,3,4] then begin try if hexadecimalcheckbox.Checked then a:=strtoint('$'+scanvalue.text) else a:=strtoint(scanvalue.text); scanvalue.Text:=inttostr(a); except scanvalue.text:=''; end; end else if oldvartype=5 then begin try d:=strtofloat(scanvalue.Text); pb:=@d; scanvalue.Text:=inttostr(pb^); except scanvalue.text:=''; end; end else if oldvartype=6 then begin try b:=strtofloat(scanvalue.Text); pa:=@b; scanvalue.Text:=inttostr(pa^); except scanvalue.text:=''; end; end; isbit:=false; rbdec.checked:=true; rbdec.OnClick(rbdec); end; 1,2,3,4: begin //converted to a normal type if oldvartype in [5,6] then begin try scanvalue.text:=inttostr(trunc(strtofloat(scanvalue.text))); except scanvalue.Text:=''; end; end; end; 5,6: ; //converted to a float, leave it the same 7: ;//converted to a string , leave it 8: //converted to a array of byte begin if oldvartype in [1,2,3,4] then begin //now convert it to a array of byte if oldvartype in [1,2,3,4] then begin try a:=strtoint(scanvalue.text); scanvalue.text:=vartobytes(@a,8); except scanvalue.text:=''; end; end else if oldvartype=5 then begin try d:=strtofloat(scanvalue.Text); scanvalue.Text:=vartobytes(@d,4); except scanvalue.text:=''; end; end else if oldvartype=6 then begin try b:=strtofloat(scanvalue.Text); scanvalue.Text:=vartobytes(@b,8); except scanvalue.text:=''; end; end; end; end; end; end; 7: //it was text begin case newvartype of 0: //it becomes a binary begin //convert the text to to a decimal value if possible try a:=strtoint(scanvalue.text); scanvalue.Text:=inttostr(a); except scanvalue.text:=''; end; end; 1,2,3,4: begin //convert it to a decimal value //allow all characters from '0' to '9' and break if it doesn't val(scanvalue.text,a,i); scanvalue.Text:=inttostr(a); end; 5,6: begin //convert the string to a float //same as dec, but allow . and , and E and - val(scanvalue.text,b,i); scanvalue.Text:=format('%.2f',[b]); end; 8: begin //convert the string to a array of bytes temp:=''; for i:=1 to length(scanvalue.text) do temp:=temp+inttohex(ord(scanvalue.Text[i]),2)+' '; scanvalue.text:=copy(temp,1,length(temp)-1); end; end; end; 8: //it was a array of bytes begin case newvartype of 0: //it becomes a binary begin //convert it to a decimal value rbdec.checked:=true; isbit:=false; scanvalue.text:=IntToStr(ByteStringToInt(scanvalue.Text,HexadecimalCheckbox.checked)); end; 1,2,3,4: //it becomes a normal decimal value begin scanvalue.text:=IntToStr(ByteStringToInt(scanvalue.Text,HexadecimalCheckbox.checked)); end; 5: //it becomes a float/single begin scanvalue.Text:=floattostr(bytestringtosingle(scanvalue.text,hexadecimalcheckbox.checked)); end; 6: //it becomes a double begin scanvalue.Text:=floattostr(bytestringtodouble(scanvalue.text,hexadecimalcheckbox.checked)); end; 7: //convert it to a string begin scanvalue.text:=bytestringtotext(scanvalue.text,hexadecimalcheckbox.checked); end; end; end; end; oldvartype:=vartype.itemindex; if not (oldscantype in [smallerthan,biggerthan,valueBetween,exact_value,Advanced_Scan]) then scantype.itemindex:=0; case newvartype of 0: begin //binary rbdec.checked:=true; hexadecimalcheckbox.Checked:=false; HexadecimalCheckbox.visible:=false; decbitvis:=true; Scantype.itemindex:=0; end; 1,2,3,4,9,10: begin casevis:=false; if newvartype in [9,10] then hexvis:=false else hexvis:=true; scanvalue.MaxLength:=0; hexadecimalcheckbox.enabled:=newscan.enabled; hexadecimalcheckbox.Checked:=hexstateForIntTypes; end; 5: begin //float; casevis:=false; hexadecimalcheckbox.Checked:=false; HexadecimalCheckbox.enabled:=false; scanvalue.MaxLength:=0; end; 6: begin //double hexvis:=false; temp:=scanvalue.text; hexadecimalcheckbox.Checked:=false; HexadecimalCheckbox.enabled:=false; scanvalue.MaxLength:=0; end; 7: begin //text scantype.itemindex:=0; casevis:=true; cbCasesensitive.Checked:=true; cbCasesensitive.ShowHint:=false; unicodevis:=true; hexadecimalcheckbox.enabled:=newscan.enabled; hexadecimalcheckbox.checked:=cbCaseSensitive.checked; hexvis:=false; hextext:='Unicode'; hexleft:=170; hexwidth:=61; end; 8: begin //array of byte scantype.itemindex:=0; scanvalue.MaxLength:=0; hexadecimalcheckbox.enableD:=newscan.enabled; hexadecimalcheckbox.Checked:=true; end; end; hexadecimalcheckbox.Caption:=hextext; tc:=tbitmap.Create; tc.canvas.Font:=hexadecimalcheckbox.Font; hexwidth:=tc.canvas.TextWidth(hextext)+22; tc.free; hexadecimalcheckbox.width:=hexwidth; hexadecimalcheckbox.left:=scanvalue.Left-hexwidth; HexadecimalCheckbox.visible:=hexvis; rbdec.visible:=decbitvis; rbbit.Visible:=decbitvis; cbunicode.Visible:=unicodevis; cbCaseSensitive.visible:=casevis; cbfastscan.Enabled:=(vartype.ItemIndex in [2..6]) and newscan.enabled; UpdateScanType; dontconvert:=false; //set the old vartype oldvartype:=vartype.itemindex; for i:=0 to panel5.ControlCount-1 do begin panel5.Controls[i].Refresh; panel5.Controls[i].Repaint; panel5.Controls[i].Invalidate; end; end; procedure TMainForm.LogoClick(Sender: TObject); begin if messagedlg('Do you want to go to the Cheat Engine website?',mtconfirmation,[mbyes,mbno],0)=mryes then ShellExecute(0, pchar('open'),pchar('http://www.cheatengine.org/?referedby=CE56'), pchar(''),pchar(''), SW_MAXIMIZE ); end; procedure TMainForm.WindowsClick(Sender: TObject); begin FromAddress.text:='00000000'; ToAddress.text:='7FFFFFFF'; end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose:=CheckIfSaved; end; procedure TMainForm.SpeedButton2Click(Sender: TObject); resourcestring strdeleteall='Are you sure you want to delete all addresses?'; var i: integer; begin if editingscript then exit; //don't do it when editing a script if numberofrecords>0 then begin if messagedlg(strdeleteall,mtWarning,[mbYes,mbNo],0)=mrNo then exit; numberofRecords:=0; for i:=0 to numberofrecords-1 do begin if hotkeys[i]<>-1 then unregisterhotkey(handle,hotkeys[i]); hotkeys[i]:=-1; hotkeystrings[i]:=''; end; updatelist; updatescreen; end; reservemem; end; procedure TMainForm.SpeedButton3Click(Sender: TObject); resourcestring stralreadyin='This address is already in the list'; stralreadyinlistmultiple='One or more addresses where already in the list'; var i: Integer; morein: boolean; begin morein:=false; for i:=0 to foundlist3.Items.Count-1 do try if foundlist3.Items[i].Selected then AddToRecord(i); except if foundlist3.SelCount=1 then raise exception.Create(stralreadyin) else morein:=true; end; if morein then showmessage(stralreadyinlistmultiple); FControl.SetFocus; end; procedure TMainForm.Selectallitems1Click(Sender: TObject); var i: Integer; begin foundlist3.SelectAll; end; procedure TMainForm.Label37Click(Sender: TObject); begin beep; end; procedure TMainForm.Freezealladdresses2Click(Sender: TObject); { scan each item in memrec, if it's not frozen freeze it by getting the current value of the address and putting it in the right value type Then set frozen to true and update the visible list} var i,j,k: Integer; db: Byte; dw: Word; dd: Dword; a: Single; b: double; dI64: int64; temps: pchar; multiple,check: Boolean; error: dword; controle:string; temp: string; read8: array of byte; read9: pbyte; realaddress,realaddress2,count:dword; begin if memrec[lastselected].vartype=255 then begin enableautoassemblecheat(lastselected); updatelist; updatescreen; exit; end; j:=0; i:=0; while (j<2) and (i1); for i:=0 to numberofrecords-1 do begin if not memrec[i].Frozen then begin if memrec[i].IsPointer then begin //find the real address realaddress2:=memrec[i].pointers[length(memrec[i].pointers)-1].Address; for j:=length(memrec[i].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[i].pointers[j].offset; end; realaddress:=realaddress2; end else realaddress:=memrec[i].Address; memrec[i].Frozendirection:=0; // if (not multiple) or (multiple and selected[i]) then case memrec[i].VarType of 0 : begin //byte readprocessmemory(processhandle,pointer(realaddress),addr(db),1,error); if error=1 then begin memrec[i].FrozenValue:=db; memrec[i].Frozen:=true; end; end; 1 : begin //word readprocessmemory(processhandle,pointer(realaddress),addr(dw),2,error); if error=2 then begin memrec[i].FrozenValue:=dw; memrec[i].Frozen:=true; end; end; 2 : begin //dword readprocessmemory(processhandle,pointer(realaddress),addr(dd),4,error); if error=4 then begin memrec[i].FrozenValue:=dd; memrec[i].Frozen:=true; end; end; 3 : begin readprocessmemory(processhandle,pointer(realaddress),addr(a),4,error); if error=4 then begin controle:=FloatToStr(a); if system.pos('NAT',controle)>0 then exit; if system.pos('INF',controle)>0 then exit; frozenfvalue[i]:=a; memrec[i].Frozen:=true; end; end; 4 : begin readprocessmemory(processhandle,pointer(realaddress),addr(b),8,error); if error=8 then begin controle:=FloatToStr(b); if system.pos('NAT',controle)>0 then exit; if system.pos('INF',controle)>0 then exit; frozenfvalue[i]:=b; memrec[i].Frozen:=true; end; end; 5 : begin //bit k:=1+((memrec[i].Bit+memrec[i].bitlength) div 8); setlength(read8,k); readprocessmemory(processhandle,pointer(realaddress),addr(read8[0]),k,error); if error=k then begin //find out the current bit combination (use frozenstrings to store the value) //convert what i need to a string of bits temp:=''; j:=memrec[i].Bit; read9:=@read8[0]; for k:=1 to memrec[i].bitlength do begin temp:=temp+IntToStr(getbit(j,read9^)); inc(j); if j>=8 then begin j:=0; inc(read9); end; end; //the tempstring now contaisn the bits (bit0 is first char...) frozenstrings[i]:=temp; memrec[i].Frozen:=true; end; end; 6 : begin //int64 readprocessmemory(processhandle,pointer(realaddress),addr(dI64),8,error); if error=8 then begin memrec[i].FrozenValue:=di64; memrec[i].Frozen:=true; end; end; 7 : begin //text getmem(temps,memrec[i].bit+1); readprocessmemory(processhandle,pointer(realaddress),temps,memrec[i].Bit,error); if error=memrec[i].bit then begin temps[memrec[i].bit]:=#0; FrozenStrings[i]:=temps; memrec[i].Frozen:=true; end; freemem(temps); end; 8 : begin //array of byte setlength(FrozenBytes[i],memrec[i].bit); readprocessmemory(processhandle,pointer(realaddress),FrozenBytes[i],memrec[i].Bit,error); if error=memrec[i].bit then memrec[i].Frozen:=true; end; {255 : begin enableautoassemblecheat(i); end; } end; end; end; updatelist; updatescreen; end; procedure TMainForm.SlectItem(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var sel: Integer; i: Integer; begin FControl.SetFocus; //only react to one click // if sender=Label38 then exit; sel:=0; if sender is TLabel then begin sel:=(Sender as TLabel).Tag+scrollbar1.Position; if sel>numberofrecords-1 then begin if not ((ssSHift in Shift) or (ssCtrl in Shift) or (ssRight in Shift)) then begin for i:=0 to numberofrecords-1 do begin selected[i]:=false; end; updatescreen; end; exit; end; end; if sender is TCheckBox then sel:=(Sender as TCheckBox).Tag+scrollbar1.Position; if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssLeft in Shift then begin if not (ssShift in Shift) and not (ssCtrl in Shift) then begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; if (sel>=numberofrecords) then begin updatelist; updatescreen; exit; end; if ssShift in shift then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; if FirstShiftSelected=numberofrecords) then begin updatelist; updatescreen; exit; end; if not selected[sel] then //clear all other selected items except this one begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; selected[sel]:=true; end; lastselected:=sel; updatelist; Updatescreen; end; procedure TMainForm.PopupMenu2Popup(Sender: TObject); resourcestring strsethotkey='Set a hotkey'; strshowasdecimal='Show as decimal value'; strshowashex='Show as hexadecimal value'; strFreezeAddressInList='Freeze the address in this list'; strFreezeAllAddresses='Freeze all addresses in this list'; strUnfreezeAllAddresses='Unfreeze all addresses in this list'; strUnfreezeAddressInList='Unfreeze the address in this list'; strDeleteAddress='Delete this address'; strDeleteTheseAddresses='Delete these addresses'; strRecalculateAddress='Recalculate address'; strRecalculateSelectedAddresses='Recalculate selected addresses'; strRecalculateAllAddresses='Recalculate all addresses'; strRemoveFromGroup='Remove from group '; strChangeScript='Change script'; strEnableCheat='Enable cheat'; strDisableCheat='Disable cheat'; strForceRecheck='Force recheck symbols'; var i: Integer; selectedi: Integer; number: Integer; clip: TClipboard; inclipboard: boolean; temp: pchar; s: string; begin sethotkey1.Caption:=strsethotkey; number:=0; i:=0; selectedi:=0; while (selectedi<2) and (i-1) and (lastselected-1 then sethotkey1.Caption:='Remove the hotkey (currently:'+hotkeystrings[lastselected]+')'; if memrec[lastselected].VarType in [0,1,2,6] then Showashexadecimal1.Visible:=true; if memrec[lastselected].ShowAsHex then Showashexadecimal1.Caption:=strshowasdecimal else Showashexadecimal1.Caption:=strshowashex; change1.Visible:=(memrec[lastselected].VarType<>255) and (selectedi>0); end else begin Showashexadecimal1.Visible:=false; change1.Visible:=false; end; inclipboard:=false; s:=clipboard.AsText; if length(s)>1 then if s[1]='<' then inclipboard:=true; Forcerechecksymbols1.visible:=numberofrecords>0; Pointerscanforthisaddress1.Visible:=(numberofrecords>0) and (selectedi>=1); if (numberofrecords=0) then //it's a empty list begin DeleteThisRecord1.visible:=false; BrowseThisMemoryRegion1.visible:=false; ShowAsHexadecimal1.Visible:=false; SetHotkey1.Visible:=false; FreezeallAddresses2.visible:=false; UnfreezeAllAddresses1.visible:=false; n5.visible:=false; Setbreakpoint1.visible:=false; Findoutwhataccessesthisaddress1.Visible:=false; sep1.Visible:=false; CalculateNewValuePart21.visible:=false; n4.visible:=false; cut1.Enabled:=false; copy1.Enabled:=false; paste1.Enabled:=inclipboard; groupoption1.Visible:=false; end; if (selectedi=0) and (numberofrecords=1) then //nothing selected, but there is 1 address begin DeleteThisRecord1.Visible:=false; Browsethismemoryregion1.visible:=false; ShowAsHexadecimal1.Visible:=false; SetHotkey1.Visible:=false; FreezeAllAddresses2.Caption:=strfreezeaddressinlist; UnfreezeAllAddresses1.Caption:=strunfreezeaddressinlist; if memrec[0].Frozen then begin UnfreezeAllAddresses1.visible:=true; FreezeAllAddresses2.visible:=false; end else begin UnfreezeAllAddresses1.visible:=false; FreezeAllAddresses2.visible:=true; end; n5.visible:=false; Setbreakpoint1.visible:=false; Findoutwhataccessesthisaddress1.Visible:=false; sep1.Visible:=false; CalculateNewValuePart21.Visible:=false; n4.Visible:=true; cut1.Enabled:=false; copy1.Enabled:=false; paste1.enabled:=inclipboard; N1.Visible:=false; groupoption1.visible:=false; end; if (selectedi=1) and (numberofrecords=1) then //1 selected and 1 record begin DeleteThisRecord1.Visible:=true; DeleteThisRecord1.Caption:=strdeleteaddress; Browsethismemoryregion1.Visible:=true; ShowAsHexadecimal1.Visible:=true; SetHotkey1.Visible:=true; FreezeAllAddresses2.Caption:=strfreezeaddressinlist; UnfreezeAllAddresses1.Caption:=strunfreezeaddressinlist; if memrec[0].Frozen then begin UnfreezeAllAddresses1.visible:=true; FreezeAllAddresses2.visible:=false; end else begin UnfreezeAllAddresses1.visible:=false; FreezeAllAddresses2.visible:=true; end; n5.visible:=formsettings.cbShowAdvanced.Checked; Setbreakpoint1.visible:=formsettings.cbShowAdvanced.Checked; // Findoutwhatreadsfromthisaddress1.visible:=formsettings.cbShowAdvanced.Checked; Findoutwhataccessesthisaddress1.Visible:=formsettings.cbShowAdvanced.Checked; sep1.Visible:=true; CalculateNewValuePart21.Caption:=strRecalculateAddress; CalculateNewValuePart21.Visible:=true; // CalculateNewValuePart21.Enabled:=(foundlist2.ItemIndex<>-1); N4.visible:=true; cut1.enabled:=true; copy1.enabled:=true; paste1.Enabled:=true; n1.visible:=true; groupoption1.visible:=true; Settonogroup1.Caption:=strRemoveFromGroup+IntToStr(memrec[lastselected].Group); end; if (selectedi=0) and (numberofrecords>1) then //nothing selected but there are more records begin DeleteThisRecord1.Visible:=false; Browsethismemoryregion1.Visible:=false; SetHotkey1.Visible:=false; FreezeAllAddresses2.Caption:=strFreezeAllAddresses; UnfreezeAllAddresses1.Caption:=strUnfreezeAllAddresses; for i:=0 to numberofrecords-1 do if memrec[i].Frozen then inc(number); if number=0 then //there is no frozen value so unfreeze is impossible begin UnfreezeAllAddresses1.visible:=false; FreezeAllAddresses2.visible:=true; end; if number=numberofrecords then //all addresses have been frozen begin UnfreezeAllAddresses1.visible:=true; FreezeAllAddresses2.visible:=false; end; if (number>0) and (number1) then begin DeleteThisRecord1.Visible:=true; DeleteThisRecord1.Caption:=strDeleteAddress; Browsethismemoryregion1.Visible:=true; ShowAsHexadecimal1.Visible:=true; SetHotkey1.Visible:=true; FreezeAllAddresses2.Caption:=strfreezealladdresses; unFreezeallAddresses1.Caption:=strUnfreezeAllAddresses; for i:=0 to numberofrecords-1 do if memrec[i].Frozen then inc(number); if number=0 then //there is no frozen value so unfreeze is impossible begin UnfreezeAllAddresses1.visible:=false; FreezeAllAddresses2.visible:=true; end; if number=numberofrecords then //all addresses have been frozen begin UnfreezeAllAddresses1.visible:=true; FreezeAllAddresses2.visible:=false; end; if (number>0) and (number-1); n4.visible:=true; cut1.enabled:=true; copy1.Enabled:=true; paste1.Enabled:=inclipboard; N1.visible:=true; groupoption1.visible:=true; Settonogroup1.Caption:=strremovefromgroup+IntToStr(memrec[lastselected].Group); end; if (selectedi>1) and (numberofrecords>1) then begin DeleteThisRecord1.Visible:=true; DeleteThisRecord1.Enabled:=true; DeleteThisRecord1.Caption:=strdeleteaddress; Browsethismemoryregion1.Visible:=true; ShowAsHexadecimal1.Visible:=true; SetHotkey1.Visible:=true; FreezeAllAddresses2.Caption:=strfreezealladdresses; Unfreezealladdresses1.Caption:=strunfreezealladdresses; for i:=0 to numberofrecords-1 do if memrec[i].Frozen then inc(number); if number=0 then //there is no frozen value so unfreeze is impossible begin UnfreezeAllAddresses1.visible:=false; FreezeAllAddresses2.visible:=true; end; if number=numberofrecords then //all addresses have been frozen begin UnfreezeAllAddresses1.visible:=true; FreezeAllAddresses2.visible:=false; end; if (number>0) and (number-1); N4.Visible:=true; cut1.enabled:=true; copy1.enabled:=true; paste1.enabled:=inclipboard; N1.visible:=true; groupoption1.visible:=true; Setbreakpoint1.Visible:=true; Settonogroup1.Caption:=strRemoveFromGroup; end; address1.enabled:=selectedi=1; ype1.Enabled:=selectedi>0; if (lastselected<>-1) and (numberofrecords>0) and (memrec[lastselected].VarType=255) then begin Browsethismemoryregion1.visible:=false; Showashexadecimal1.Visible:=false; SetHotkey1.Visible:=true; sethotkey1.Enabled:=true; changescript1.Visible:=true; UnfreezeAllAddresses1.caption:=strdisablecheat; FreezeAllAddresses2.caption:=strenablecheat; n5.visible:=false; Findoutwhataccessesthisaddress1.visible:=false; Setbreakpoint1.visible:=false; sep1.visible:=false; Calculatenewvaluepart21.visible:=false; N4.visible:=true; n1.Visible:=false; end else changescript1.Visible:=false; end; procedure TMainForm.CheckBox2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var error: dword; a: single; b: double; controle: String; i,j,k,sel: Integer; db: Byte; dw: Word; dd: dword; di64: Int64; read8: array of byte; read9: pbyte; freeze,check: boolean; freezegroup: array [1..6] of boolean; temps: pchar; temp: string; realaddress,realaddress2,count: dword; begin FControl.SetFocus; for i:=1 to 6 do freezegroup[i]:=false; if ssRight in Shift then begin if not selected[(sender as TCheckBox).Tag+scrollbar1.Position] then //clear all other selected items except this one begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; end; if not((ssShift in Shift) or (ssCtrl in Shift)) then begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; sel:=(sender as TCheckBox).Tag+scrollbar1.Position; if ssShift in shift then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; if FirstShiftSelected0) and (selected[i]) then freezegroup[memrec[i].Group]:=true; //freezegroup can also be used to unfreeze end; for i:=0 to numberofrecords-1 do begin if freeze then //freeze all selected items begin if memrec[i].IsPointer then begin //find the real address realaddress2:=memrec[i].pointers[length(memrec[i].pointers)-1].Address; for j:=length(memrec[i].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[i].pointers[j].offset; end; realaddress:=realaddress2; end else realaddress:=memrec[i].Address; if (selected[i] and not memrec[i].Frozen) or ((memrec[i].group>0) and freezegroup[(memrec[i].Group)]) then //if it's selected and not yet frozen freeze it. begin //freeze that address memrec[i].Frozendirection:=0; case memrec[i].VarType of 0 : begin //byte readprocessmemory(processhandle,pointer(realaddress),addr(db),1,error); if error=1 then begin memrec[i].FrozenValue:=db; memrec[i].Frozen:=true; end; end; 1 : begin //word readprocessmemory(processhandle,pointer(realaddress),addr(dw),2,error); if error=2 then begin memrec[i].FrozenValue:=dw; memrec[i].Frozen:=true; end; end; 2 : begin //dword readprocessmemory(processhandle,pointer(realaddress),addr(dd),4,error); if error=4 then begin memrec[i].FrozenValue:=dd; memrec[i].Frozen:=true; end; end; 3 : begin readprocessmemory(processhandle,pointer(realaddress),addr(a),4,error); if error=4 then begin controle:=FloatToStr(a); if system.pos('NAT',controle)>0 then exit; if system.pos('INF',controle)>0 then exit; frozenfvalue[i]:=a; memrec[i].Frozen:=true; end; end; 4 : begin readprocessmemory(processhandle,pointer(realaddress),addr(b),8,error); if error=8 then begin controle:=FloatToStr(b); if system.pos('NAT',controle)>0 then exit; if system.pos('INF',controle)>0 then exit; frozenfvalue[i]:=b; memrec[i].Frozen:=true; end; end; 5 : begin //binary k:=1+((memrec[i].Bit+memrec[i].bitlength) div 8); setlength(read8,k); readprocessmemory(processhandle,pointer(realaddress),addr(read8[0]),k,error); if error=k then begin //find out the current bit combination (use frozenstrings to store the value) //convert what i need to a string of bits temp:=''; j:=memrec[i].Bit; read9:=@read8[0]; for k:=1 to memrec[i].bitlength do begin temp:=temp+IntToStr(getbit(j,read9^)); inc(j); if j>=8 then begin j:=0; inc(read9); end; end; //the tempstring now contaisn the bits (bit0 is first char...) frozenstrings[i]:=temp; memrec[i].Frozen:=true; end; end; 6 : begin //int64 readprocessmemory(processhandle,pointer(realaddress),addr(dI64),8,error); if error=8 then begin memrec[i].FrozenValue:=di64; memrec[i].Frozen:=true; end; end; 7 : begin //text getmem(temps,memrec[i].bit+1); readprocessmemory(processhandle,pointer(realaddress),temps,memrec[i].Bit,error); if error=memrec[i].bit then begin temps[memrec[i].bit]:=#0; FrozenStrings[i]:=temps; memrec[i].Frozen:=true; end; freemem(temps); end; 8 : begin //array of byte setlength(FrozenBytes[i],memrec[i].bit); readprocessmemory(processhandle,pointer(realaddress),FrozenBytes[i],memrec[i].Bit,error); if error=memrec[i].bit then memrec[i].Frozen:=true; end; 255 : enableautoassemblecheat(i); //auto assemble script end; end; end else begin {freeze is false, so UNFREEZE all selected items and groups} if selected[i] then begin if memrec[i].VarType=255 then disableautoassemblecheat(i) else memrec[i].frozen:=false; end; if (memrec[i].group>0) and (freezegroup[memrec[i].group]) then begin if memrec[i].VarType=255 then disableautoassemblecheat(i) else memrec[i].frozen:=false; end; end; end; sethotkey1.Enabled:=memrec[lastselected].VarType<>255; UpdateScreen; end; procedure TMainForm.CheckBox1Click(Sender: TObject); begin UpdateScreen; end; procedure TMainForm.Unfreezealladdresses1Click(Sender: TObject); var i: Integer; begin if memrec[lastselected].vartype=255 then begin disableautoassemblecheat(lastselected); exit; end; for i:=0 to numberofrecords-1 do begin if memrec[i].VarType=255 then disableautoassemblecheat(i) else memrec[i].Frozen:=false; end; updatelist; updatescreen; end; procedure TMainForm.PopupMenu1Popup(Sender: TObject); begin Browsethismemoryregioninthedisassembler1.Enabled:=Foundlist3.SelCount>=1; if foundlist3.Items.Count=0 then begin Removeselectedaddresses1.enabled:=false; Browsethismemoryarrea1.enabled:=false; Selectallitems1.enabled:=false; end else begin Removeselectedaddresses1.enabled:=true; Browsethismemoryarrea1.enabled:=True; Selectallitems1.enabled:=foundlist3.Items.Count<5000; end; if Foundlist3.SelCount>1 then Removeselectedaddresses1.caption:='Remove selected addresses' else Removeselectedaddresses1.caption:='Remove selected address'; if Foundlist3.selcount=0 then begin Removeselectedaddresses1.enabled:=false; Browsethismemoryarrea1.enabled:=false; end else begin Removeselectedaddresses1.enabled:=true; Browsethismemoryarrea1.enabled:=true; end; Removeselectedaddresses1.Visible:=not (GetVarType in [5,8]); end; procedure TMainForm.Removeselectedaddresses1Click(Sender: TObject); var address: Dword; e,i,j: Integer; bit: Byte; selected: array of integer; begin if SaveFirstScanThread<>nil then begin SaveFirstScanThread.WaitFor; //wait till it's done freeandnil(SaveFirstScanThread); end; if foundlist3.selcount=1 then //use itemindex (faster) begin foundlist.deleteaddress(foundlist3.itemindex); end else if foundlist3.selcount>1 then begin if foundlist3.items.count>100000 then if messagedlg('This list is huge and deleting multiple items will require CE to traverse the whole list and can take a while. Are you sure?',mtconfirmation,[mbyes,mbno],0)<>mryes then exit; screen.Cursor:=crhourglass; MainForm.Caption:=CEWait; Mainform.Refresh; foundlist3.Items.BeginUpdate; try j:=0; setlength(selected, foundlist3.selcount); for i:=0 to foundlist3.items.count-1 do begin if foundlist3.items[i].Selected then begin selected[j]:=i; inc(j); end; end; for i:=length(selected)-1 downto 0 do foundlist.deleteaddress(selected[i]); finally Mainform.caption:=CENorm; screen.Cursor:=crDefault; foundlist3.Items.EndUpdate; end; end; foundlist.deinitialize; foundlist.initialize(getvartype); end; procedure TMainForm.FControlKeyPress(Sender: TObject; var Key: Char); begin key:=chr(0); end; procedure TMainForm.FControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i,j,k: Integer; comfirm: Dword; doit,check: Boolean; freeze: Boolean; db: Byte; dw: Word; dd: dword; di64: Int64; a: single; b: double; error: Dword; temps: pchar; read8: array of byte; read9: pbyte; temp: string; controle: String; select: Integer; realaddress,realaddress2,count:dword; procedure FreezeOrUnfreezeSelected; var i,j,k: integer; begin if lastselected>=numberofrecords then exit; freeze:=not memrec[lastselected].frozen; for i:=0 to numberofrecords-1 do begin if memrec[i].ispointer then begin //find the real address realaddress2:=memrec[i].pointers[length(memrec[i].pointers)-1].address; for j:=length(memrec[i].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[i].pointers[j].offset; end; realaddress:=realaddress2; end else realaddress:=memrec[i].address; if (hotkeys[i]=-1) and (selected[i]) then begin if not freeze then begin if memrec[i].VarType=255 then disableautoassemblecheat(i) else memrec[i].frozen:=false; end else begin //freeze memrec[i].frozendirection:=0; case memrec[i].vartype of 0 : begin //byte readprocessmemory(processhandle,pointer(realaddress),addr(db),1,error); if error=1 then begin memrec[i].frozenvalue:=db; memrec[i].frozen:=true; end; end; 1 : begin //word readprocessmemory(processhandle,pointer(realaddress),addr(dw),2,error); if error=2 then begin memrec[i].frozenvalue:=dw; memrec[i].frozen:=true; end; end; 2 : begin //dword readprocessmemory(processhandle,pointer(realaddress),addr(dd),4,error); if error=4 then begin memrec[i].frozenvalue:=dd; memrec[i].frozen:=true; end; end; 3 : begin readprocessmemory(processhandle,pointer(realaddress),addr(a),4,error); if error=4 then begin controle:=floattostr(a); if system.pos('nat',controle)>0 then exit; if system.pos('inf',controle)>0 then exit; frozenfvalue[i]:=a; memrec[i].frozen:=true; end; end; 4 : begin readprocessmemory(processhandle,pointer(realaddress),addr(b),8,error); if error=8 then begin controle:=floattostr(a); if system.pos('nat',controle)>0 then exit; if system.pos('inf',controle)>0 then exit; frozenfvalue[i]:=b; memrec[i].frozen:=true; end; end; 5 : begin //bit k:=1+((memrec[i].bit+memrec[i].bitlength) div 8); setlength(read8,k); readprocessmemory(processhandle,pointer(realaddress),addr(read8[0]),k,error); if error=k then begin //find out the current bit combination (use frozenstrings to store the value) //convert what i need to a string of bits temp:=''; j:=memrec[i].bit; read9:=@read8[0]; for k:=1 to memrec[i].bitlength do begin temp:=temp+inttostr(getbit(j,read9^)); inc(j); if j>=8 then begin j:=0; inc(read9); end; end; //the tempstring now contaisn the bits (bit0 is first char...) frozenstrings[i]:=temp; memrec[i].frozen:=true; end; end; 6 : begin //int64 readprocessmemory(processhandle,pointer(realaddress),addr(di64),8,error); if error=8 then begin memrec[i].frozenvalue:=di64; memrec[i].frozen:=true; end; end; 7 : begin //text getmem(temps,memrec[i].bit+1); readprocessmemory(processhandle,pointer(realaddress),temps,memrec[i].bit,error); if error=memrec[i].bit then begin temps[memrec[i].Bit]:=#0; frozenstrings[i]:=temps; memrec[i].frozen:=true; end; freemem(temps); end; 8 : begin //text setlength(frozenbytes[i],memrec[i].bit); readprocessmemory(processhandle,pointer(realaddress),frozenbytes[i],memrec[i].bit,error); if error=memrec[i].bit then memrec[i].frozen:=true; end; 255 : begin enableautoassemblecheat(i); end; end; end; end; end; updatescreen; updatelist; end; var tempmemrec: memoryrecord; tempfvalue: double; tempstring: string; TempSelected: boolean; temphotkey: integer; tempbytes: array of byte; sel1,sel2: integer; nrselected: integer; begin if ((key=ord('S')) and (ssctrl in shift)) then begin if editingscript then exit; //swap nrselected:=0; for i:=0 to NumberOfRecords-1 do begin if selected[i] then begin inc(nrselected); if nrselected=1 then sel1:=i; if nrselected=2 then sel2:=i; if nrselected=3 then begin beep; exit; end; end; end; if nrselected<>2 then begin beep; exit; end; tempmemrec:=memrec[sel1]; memrec[sel1]:=memrec[sel2]; memrec[sel2]:=tempmemrec; tempfvalue:=FrozenFvalue[sel2]; FrozenFvalue[sel2]:=FrozenFvalue[sel1]; FrozenFvalue[sel1]:=tempFvalue; tempstring:=FrozenStrings[sel2]; Frozenstrings[sel2]:=frozenstrings[sel1]; frozenstrings[sel1]:=tempstring; temphotkey:=hotkeys[sel2]; hotkeys[sel2]:=hotkeys[sel1]; hotkeys[sel1]:=temphotkey; setlength(tempbytes,length(frozenbytes[sel2])); for j:=0 to length(tempbytes)-1 do tempbytes[j]:=frozenbytes[sel2][j]; setlength(Frozenbytes[sel2],length(frozenbytes[sel1])); for j:=0 to length(Frozenbytes[sel2])-1 do Frozenbytes[sel2][j]:=FrozenBytes[sel1][j]; setlength(frozenbytes[sel1],length(tempbytes)); for j:=0 to length(Tempbytes)-1 do Frozenbytes[sel1][j]:=Tempbytes[j]; updatescreen; updatelist; exit; end; if ((key=ord('E')) and (ssCtrl in Shift) and not (ssAlt in Shift)) then begin edit; exit; end; if ((key=ord('C')) and (ssCtrl in Shift) and not (ssAlt in Shift)) then begin copyselectedrecords; exit; end; if ((key=ord('V')) and (ssCtrl in Shift) and not (ssAlt in Shift)) then begin Paste(formsettings.cbsimplecopypaste.checked); exit; end; if ((key=ord('X')) and (ssCtrl in Shift) and not (ssAlt in Shift)) then begin copyselectedrecords; deleterecords; exit; end; if ((key=ord('Z')) and (ssCtrl in Shift) and not (ssAlt in Shift)) then begin //toggle the selected items for i:=0 to numberofrecords-1 do if selected[i] and (memrec[i].OldValue<>'') then ChangeValue(i,memrec[i].OldValue); exit; end; if ((key=ord('A')) and (ssctrl in Shift) and not (ssalt in Shift)) then begin //select all for i:=0 to numberofrecords-1 do selected[i]:=true; updatescreen; end; case key of ord('A')..ord('Z'),ord('0')..ord('9'): begin if not (ssCtrl in Shift) then begin select:=-1; for i:=lastselected+1 to numberofrecords-1 do begin if (length(memrec[i].description[1])>0) and (uppercase(memrec[i].description[1])=uppercase(chr(key))) then begin select:=i; break; end; end; if select=-1 then exit; if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssShift in Shift then //ctrl does nothing begin if lastselectedscrollbar1.position+(numberoflines-1) then scrollbar1.Position:=lastselected-(numberoflines-1); Updatescreen; end; end; VK_RETURN:begin if (lastselected>=0) and (lastselected0 then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; Lastselected:=0; if FirstShiftSelected0 then begin for i:=0 to numberofRecords-1 do selected[i]:=false; Lastselected:=0; selected[lastselected]:=true; scrollbar1.Position:=0; end; end; Updatescreen; end; VK_END: begin // if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssShift in Shift then //ctrl does nothing begin if lastselectedscrollbar1.position+(numberoflines-1) then scrollbar1.Position:=lastselected-(numberoflines-1); Updatescreen; end; VK_UP: begin if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssShift in Shift then //ctrl does nothing begin if lastselected>0 then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; Lastselected:=lastselected-1; if FirstShiftSelected0 then begin for i:=0 to numberofRecords-1 do selected[i]:=false; Lastselected:=lastselected-1; selected[lastselected]:=true; end; end; if lastselected>scrollbar1.position+(numberoflines-1) then scrollbar1.Position:=lastselected-(numberoflines-1); if lastselected=scrollbar1.position+(numberoflines-1) then begin //if it it more then 2/3th visible select it, else increase the scroller //every line is 16 pixels if (panel3.height mod 16)<10 then scrollbar1.Position:=lastselected-(numberoflines-2) else scrollbar1.Position:=lastselected-(numberoflines-1); end; Updatescreen; end; vk_prior: begin //page up if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssShift in Shift then //ctrl does nothing begin if lastselected>0 then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; if LastSelected>(numberoflines-1) then Lastselected:=lastselected-numberoflines else LastSelected:=0; if FirstShiftSelected0 then begin for i:=0 to numberofRecords-1 do selected[i]:=false; if lastselected>(numberoflines-1) then Lastselected:=lastselected-numberoflines else LastSelected:=0; selected[lastselected]:=true; end; end; if lastselectedscrollbar1.position+(numberoflines-1) then scrollbar1.Position:=lastselected-(numberoflines-1); Updatescreen; end; vk_next: begin //page down if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssShift in Shift then //ctrl does nothing begin if lastselectedNumberOfRecords-1 then Lastselected:=Numberofrecords-1 else LastSelected:=Lastselected+(numberoflines-1); selected[LastSelected]:=true; end; end; if lastselectedscrollbar1.position+(numberoflines-1) then scrollbar1.Position:=lastselected-(numberoflines-1); Updatescreen; end; vk_delete: begin if editingscript then exit; Deletethisrecord1.Click; end; vk_space: begin //(un)freeze all selected addresses //according to the lastselected one, AND if shift/ctrl is presses FreezeOrUnfreezeSelected; end; vk_add: begin if [ssctrl] = shift then begin //move selected records one pos down if (lastselected<>-1) and (lastselected-1) and (lastselectednil then begin foundcodedialog.btnOK.Click; //first or 2nd click if foundcodedialog<>nil then foundcodedialog.btnOK.Click; //2nd click end; //undo unrandomize if unrandomize<>nil then freeandnil(unrandomize); numberofrecords:=0; reservemem; cbSpeedhack.Checked:=false; cbFasterscan.Checked:=false; if flashprocessbutton<>nil then flashprocessbutton.Terminate; { if debuggerthread2<>nil then freeandnil(debuggerthread2); } try if @DebugActiveProcessStop<>@DebugActiveProcessStopProstitute then begin //detach the debugger hide; crashcounter:=0; if advancedoptions.Pausebutton.Down then begin advancedoptions.Pausebutton.Down:=false; advancedoptions.Pausebutton.Click; end; if debuggerthread<>nil then debuggerthread.Terminate; while (debuggerthread<>nil) and (debuggerthread.attached) and (crashcounter<10) do begin inc(crashcounter); sleep(1000); end; end; except // end; if frmProcessWatcher<>nil then begin frmProcessWatcher.Free; frmProcessWatcher:=nil; end; try tempbitmap.free; shutdown; closehandle(debugger.semaphore); unregisterhotkey(handle,0); for i:=0 to numberofrecords-1 do if hotkeys[i]<>-1 then unregisterhotkey(handle,hotkeys[i]); except // end; if advancedoptions.Pausebutton.Down then begin with advancedoptions do begin pausebutton.down:=not pausebutton.down; pausebutton.Click; end; end; if length(windowlist)>0 then begin toggleWindow; setforegroundwindow(lastforeground); setactivewindow(lastactive); end; autoattachlist.free; if speedhack<>nil then speedhack.free; // EExternalException end; procedure TMainForm.CommentButtonClick(Sender: TObject); begin comments.Show; end; procedure TMainForm.CommentButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if comments.Memo1.Lines.Count=0 then begin Commentbutton.Hint:='No Comments'; exit; end; Commentbutton.Hint:=copy(comments.Memo1.Text,1,20); if length(comments.Memo1.Text)>20 then Commentbutton.Hint:=Commentbutton.Hint+'...'; end; procedure TMainForm.SettogroupXClick(Sender: TObject); var groupnr: Integer; i: Integer; begin //set all selected items to group (Sender as TmenuItem).tag GroupNr:=(Sender as TMenuItem).Tag; for i:=0 to numberofrecords-1 do if selected[i] then memrec[i].group:=Groupnr; updatescreen; end; procedure TMainForm.Settonogroup1Click(Sender: TObject); begin memrec[lastselected].Group:=0; end; procedure TMainForm.SetPrioritys1Click(Sender: TObject); begin formsettings.showmodal; end; procedure TMainForm.copySelectedRecords; var clip: TClipboard; textform: string; i,j: Integer; nrselected: integer; ms: tmemorystream; identifier: string; x: dword; hentries: thandle; targetbuffer: pointer; doc: TXMLDocument; CheatTable: IXMLNode; Entries: IXMLNode; begin if editingscript then exit; //don't do it when editing a script doc:=TXMLDocument.Create(application); try doc.Options:=doc.Options+[doNodeAutoIndent]; doc.Active:=true; CheatTable:=doc.AddChild('CheatTable'); Entries:=CheatTable.AddChild('CheatEntries'); for i:=0 to numberofrecords-1 do if selected[i] then SaveCTEntryToXMLNode(i,entries); Clipboard.SetTextBuf(pchar(doc.XML.Text)); finally doc.free; end; { if openclipboard(handle) then begin emptyclipboard; //fill the memorystream with the required data ms:=tmemorystream.Create; try ms.WriteBuffer('CETables',8); x:=copypasteversion; ms.WriteBuffer(x,sizeof(x)); nrselected:=0; for i:=0 to numberofrecords-1 do if selected[i] then inc(nrselected); ms.WriteBuffer(nrselected,sizeof(nrselected)); for i:=0 to numberofrecords-1 do begin if selected[i] then begin //description x:=length(memrec[i].description); ms.WriteBuffer(x,sizeof(x)); ms.WriteBuffer(memrec[i].description[1],x); //address ms.WriteBuffer(memrec[i].address,sizeof(memrec[i].address)); //interpretable address x:=length(memrec[i].interpretableaddress); ms.writebuffer(x,sizeof(x)); ms.writebuffer(memrec[i].interpretableaddress[1],x); //vartype ms.WriteBuffer(memrec[i].VarType,sizeof(memrec[i].VarType)); //unicode ms.WriteBuffer(memrec[i].unicode,sizeof(memrec[i].unicode)); //IsPointer ms.writebuffer(memrec[i].IsPointer,sizeof(memrec[i].IsPointer)); //pointers x:=length(memrec[i].pointers); ms.WriteBuffer(x,sizeof(x)); for j:=0 to x-1 do begin //address ms.writebuffer(memrec[i].pointers[j].Address,sizeof(memrec[i].pointers[j].Address)); //offset ms.writebuffer(memrec[i].pointers[j].offset,sizeof(memrec[i].pointers[j].offset)); //interpretable address x:=length(memrec[i].pointers[j].Interpretableaddress); ms.writebuffer(x,sizeof(x)); ms.writebuffer(memrec[i].pointers[j].interpretableaddress[1],x); end; //bit ms.WriteBuffer(memrec[i].Bit,sizeof(memrec[i].bit)); //bitlength ms.writebuffer(memrec[i].bitlength,sizeof(memrec[i].bitlength)); //skip frozen (always false) //showashex ms.writebuffer(memrec[i].ShowAsHex,sizeof(memrec[i].ShowAsHex)); //autoassemble script x:=length(memrec[i].autoassemblescript); ms.writebuffer(x,sizeof(x)); ms.writebuffer(memrec[i].autoassemblescript[1],x); end; end; //the stream has been filled, now globalalloc with ms.size as size hentries := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE,ms.Size); targetbuffer:=globallock(hentries); copymemory(targetbuffer,ms.Memory,ms.size); globalunlock(hentries); SetclipboardData(ceclipboardformat,hentries); finally ms.free; closeclipboard; end; end; } end; function TMainform.paste(simplecopypaste: boolean): integer; { this routine will paste a entry from the cplipboard into the addresslist of CE If simplecopypaste is false frmPasteTableentry is shown to let the user change some stuff before adding the new entry returns the entry number of the new addresses (first one) } var clip: TClipboard; textform,y: string; textform2: Pchar; i,j,k,l: Integer; last: Integer; temprec: array of memoryRecord; first:boolean; lines:array of string; linenr: integer; temp: dword; records: integer; stringnr: integer; texthandle: thandle; textformpos: integer; ms: tmemorystream; hentries: thandle; sourcebuffer: pointer; p: pchar; x: dword; replace_find: string; replace_with: string; changeoffsetstring: string; changeoffset: dword; doc: TXMLDocument; CheatTable: IXMLNode; entries: IXMLNode; CheatEntry: IXMLNode; buf: string; begin if editingscript then exit; //don't do it when editing a script k:=0; ms:=tmemorystream.Create; doc:=TXMLDocument.Create(application); try try buf:=clipboard.AsText; ms.WriteBuffer(buf[1],length(buf)); doc.LoadFromStream(ms); doc.Active; CheatTable:=doc.ChildNodes.FindNode('CheatTable'); if cheattable<>nil then begin Entries:=cheattable.ChildNodes.FindNode('CheatEntries'); if entries<>nil then begin k:=entries.ChildNodes.Count; setlength(temprec, k); if k>0 then begin //valid table frmPasteTableentry:=TfrmPasteTableentry.create(self); try if not simplecopypaste then if frmpastetableentry.showmodal=mrcancel then exit; replace_find:=frmpastetableentry.edtFind.text; replace_with:=frmpastetableentry.edtReplace.text; changeoffsetstring:='$'+stringreplace(frmpastetableentry.edtOffset.Text,'-','-$',[rfReplaceAll]); changeoffsetstring:=stringreplace(changeoffsetstring,'$-','-',[rfReplaceAll]); try changeoffset:=strtoint(changeoffsetstring); except changeoffset:=0; end; finally freeandnil(frmPasteTableentry); end; for i:=0 to k-1 do begin CheatEntry:=entries.ChildNodes[i]; temprec[i]:=GetmemrecFromXMLNode(CheatEntry); if not simplecopypaste then begin if replace_find<>'' then temprec[i].Description:=stringreplace(temprec[i].Description,replace_find,replace_with,[rfReplaceAll,rfIgnoreCase]); temprec[i].Address:=temprec[i].address+changeoffset; if temprec[i].interpretableaddress<>'' then begin try x:=symhandler.getAddressFromName(temprec[i].interpretableaddress); x:=x+changeoffset; temprec[i].interpretableaddress:=symhandler.getNameFromAddress(x,true,true) except temprec[i].interpretableaddress:=inttohex(temprec[i].Address,8); end; end; end; end; end; end; end; inc(NumberOfRecords,k); ReserveMem; finally doc.free; ms.free; end; except exit; end; result:=lastselected+1; for i:=numberofrecords-k-1 downto lastselected+1 do begin memrec[i+k]:=memrec[i]; selected[i+k]:=selected[i]; frozenfvalue[i+k]:=frozenfvalue[i]; frozenstrings[i+k]:=frozenstrings[i]; frozenbytes[i+k]:=frozenbytes[i]; hotkeystrings[i+k]:=hotkeystrings[i]; hotkeys[i+k]:=hotkeys[i]; end; if numberofrecords-k=0 then for i:=0 to k-1 do begin memrec[i]:=temprec[i]; hotkeys[i]:=-1; selected[i]:=false; end else for i:=lastselected+1 to lastselected+k do begin memrec[i]:=temprec[i-lastselected-1]; hotkeys[i]:=-1; selected[i]:=false; end; mainform.UpdateScreen; mainform.Updatelist; end; procedure TMainForm.Copy1Click(Sender: TObject); begin copyselectedrecords; end; procedure TMainForm.Cut1Click(Sender: TObject); begin copyselectedrecords; deleterecords; updatescreen; updatelist; end; procedure TMainForm.Paste1Click(Sender: TObject); begin Paste(formsettings.cbsimplecopypaste.checked); updatescreen; updatelist; end; procedure TMainForm.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; begin if not ((ssSHift in Shift) or (ssCtrl in Shift)) then begin for i:=0 to numberofrecords-1 do begin selected[i]:=false; end; updatescreen; end; end; procedure TMainForm.Sortaddressesbygroup1Click(Sender: TObject); var temprec: memoryrecord; i,j: Integer; smallest: Integer; TempSelected: boolean; TempFvalue: double; TempString: string; begin //sort memrec by frozen for i:=0 to numberofrecords-1 do begin smallest:=i; for j:=i to numberofrecords-1 do //find here the smallest if memrec[j].groupdescriptionleft then description[i].Left:=descriptionleft; if description[i].Width<>descriptionwidth then description[i].Width:=descriptionwidth; if address[i].Left<>addressleft then address[i].Left:=addressleft; if address[i].Width<>addresswidth then address[i].Width:=addresswidth; if valtype[i].Left<>typeleft then ValType[i].Left:=typeleft; if ValType[i].Width<>Typewidth then ValType[i].Width:=Typewidth; if value[i].Left<>valueleft then Value[i].Left:=valueleft; if value[i].Width<>valuewidth then value[i].Width:=valuewidth; // freezedirection[i].Left:=frozenoffset+2; end; numberoflines:=(panel3.height div 16) +1; if length(select) < numberoflines then begin //make new lines setlength(frozenbox,numberoflines); setlength(description,numberoflines); setlength(address,numberoflines); setlength(ValType,numberoflines); setlength(Value,numberoflines); setlength(Select,numberoflines); setlength(freezedirection,numberoflines); for i:=previouscount to numberoflines-1 do begin //checkbox select[i]:=Tlabel.Create(self); select[i].AutoSize:=false; select[i].Color:=select[0].Color; select[i].Top:=i*16; select[i].Left:=0; select[i].Width:=panel3.Width; select[i].Height:=16; select[i].Anchors:=[akLeft,akTop,akRight]; select[i].Caption:=select[0].Caption; select[i].Transparent:=false; select[i].Visible:=true; select[i].tag:=i; select[i].SendToBack; select[i].Font:=select[0].Font; select[i].ParentColor:=false; select[i].ParentFont:=false; select[i].OnDragDrop:=Panel1DragDrop; select[i].OnDragOver:=panel1DragOver; select[i].OnMouseDown:=SlectItem; //damn spell error select[i].PopupMenu:=Popupmenu2; select[i].Parent:=panel3; frozenbox[i]:=tcheckbox.Create(self); frozenbox[i].Caption:=''; frozenbox[i].Top:=i*16; frozenbox[i].Left:=frozenleft+22; frozenbox[i].Width:=17; frozenbox[i].Visible:=false; frozenbox[i].Tag:=i; frozenbox[i].Cursor:=crHandPoint; frozenbox[i].OnClick:=CheckBox1Click; frozenbox[i].OnDragDrop:=Panel1DragDrop; frozenbox[i].OnDragOver:=Panel1DragOver; frozenbox[i].OnMouseDown:=CheckBox2MouseDown; frozenbox[i].PopupMenu:=Popupmenu2; frozenbox[i].Parent:=panel3; description[i]:=Tlabel.Create(self); description[i].Font:=description[0].Font; description[i].Caption:='You shouldn''t be able to see this'; description[i].Top:=i*16; description[i].Left:=descriptionleft; description[i].Visible:=false; description[i].Tag:=i; description[i].transparent:=true; description[i].Cursor:=crHandPoint; description[i].OnDblClick:=Label28Click; description[i].OnDragDrop:=Panel1DragDrop; description[i].OnDragOver:=panel1DragOver; description[i].OnMouseDown:=Slectitem; description[i].PopupMenu:=popupmenu2; description[i].Parent:=panel3; address[i]:=Tlabel.Create(self); address[i].Top:=i*16; address[i].Left:=addressleft; address[i].Visible:=false; address[i].Tag:=i; address[i].Transparent:=true; address[i].Cursor:=crHandPoint; address[i].OnDblClick:=Addressclick; address[i].OnDragDrop:=Panel1DragDrop; address[i].OnDragOver:=panel1DragOver; address[i].OnMouseDown:=Slectitem; address[i].PopupMenu:=popupmenu2; address[i].Parent:=panel3; ValType[i]:=Tlabel.Create(self); ValType[i].Top:=i*16; ValType[i].Left:=typeleft; valtype[i].Width:=typewidth; ValType[i].Visible:=false; valtype[i].Tag:=i; valtype[i].Transparent:=true; valtype[i].Cursor:=crHandPoint; valtype[i].OnDblClick:=TypeClick; valtype[i].OnDragDrop:=Panel1DragDrop; valtype[i].OnDragOver:=panel1DragOver; valtype[i].OnMouseDown:=Slectitem; valtype[i].PopupMenu:=popupmenu2; ValType[i].Parent:=panel3; Value[i]:=Tlabel.Create(self); Value[i].Top:=i*16; Value[i].Left:=valueleft; value[i].Width:=valuewidth; Value[i].Visible:=false; value[i].Tag:=i; value[i].Transparent:=true; value[i].Cursor:=crHandPoint; value[i].OnDblClick:=valueclick; value[i].OnDragDrop:=Panel1DragDrop; value[i].OnDragOver:=panel1DragOver; value[i].OnMouseDown:=Slectitem; value[i].PopupMenu:=popupmenu2; Value[i].Parent:=panel3; freezedirection[i]:=TLabel.create(self); freezedirection[i].Caption:=''; freezedirection[i].Font.Color:=clRed; freezedirection[i].Font.Style:=[fsBold]; freezedirection[i].Font.Size:=12; freezedirection[i].Top:=-3+i*16; freezedirection[i].Left:=frozenleft+7; freezedirection[i].Visible:=false; freezedirection[i].ParentColor:=false; freezedirection[i].Tag:=i; freezedirection[i].Transparent:=true; freezedirection[i].OnMouseDown:=directionclick; freezedirection[i].OnDragDrop:=Panel1DragDrop; freezedirection[i].OnDragOver:=panel1DragOver; freezedirection[i].PopupMenu:=popupmenu2; freezedirection[i].Cursor:=crHandPoint; freezedirection[i].Parent:=panel3; end; end; updatescreen; end; procedure TMainForm.Panel1Resize(Sender: TObject); begin resizescreen; end; procedure TMainForm.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin //bugfix? (I cant find a property in the scrollbar to do this correctly!) // if scrollpos>numberofrecords-(numberoflines-1) then scrollpos:=numberofrecords-(numberoflines-1); end; procedure TMainForm.advancedbuttonClick(Sender: TObject); begin advancedoptions.Show; end; procedure TMainForm.HexadecimalCheckboxClick(Sender: TObject); var x: int64; i: integer; begin if dontconvert then exit; { if VarType.Text='Byte' then getVarType:=0 else if VarType.Text='2 Bytes' then getVarType:=1 else if VarType.Text='4 Bytes' then getVarType:=2 else if VarType.Text='8 Bytes' then getvarType:=6 else if Vartype.Text='Float' then getVarType:=3 else if Vartype.Text='Double' then getVarType:=4 else if VarType.Text='Bit' then getVarType:=5 else if vartype.Text='Text'then getVarType:=7 else if vartype.Text='Array of Bytes' then getVarType:=8 else} if HexadecimalCheckbox.Checked then begin //convert what is in scanvalue to hexadecimal notation val(scanvalue.Text,x,i); case GetVarType of 0: scanvalue.text:=IntToHex(byte(x),2); 1: scanvalue.Text:=inttohex(word(x),4); 2: scanvalue.Text:=inttohex(dword(x),8); 6: scanvalue.Text:=inttohex(int64(x),16); end; end else begin //convert to decimal noatation case GetVarType of 0,1,2,6: begin if length(scanvalue.Text)>0 then begin if scanvalue.Text[1]='-' then val('-$'+copy(scanvalue.Text,2,length(scanvalue.text)),x,i) else val('$'+scanvalue.Text,x,i); scanvalue.Text:=inttostr(x); end; end; end; end; end; procedure TMainForm.SetHotkey1Click(Sender: TObject); var db: Byte; dw: Word; dd: dword; di64: Int64; a: single; b: double; error: Dword; controle: string; temps: pchar; i,j,k: integer; read8: array of byte; read9: pbyte; temp: string; realaddress,realaddress2,count:dword; check: boolean; hotkeyvalue: string; hotkeydirection: integer; begin HotKeyForm.recnr:=lastselected; if hotkeys[lastselected]<>-1 then //remove this hotkey begin memrec[lastselected].Frozendirection:=0; unregisterhotkey(handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; updatescreen; exit; end; if memrec[lastselected].IsPointer then begin //find the real address realaddress2:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; for j:=length(memrec[lastselected].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[lastselected].pointers[j].offset; end; realaddress:=realaddress2; end else realaddress:=memrec[lastselected].Address; hotKeyForm.hotkeyvalue:=value[lastselected-scrollbar1.position].Caption; if memrec[lastselected].VarType=255 then hotkeyform.autoassemble:=true else hotkeyform.autoassemble:=false; error:=0; if HotKeyForm.showModal=mrok then begin memrec[lastselected].Frozen:=false; //hotkeyform2 memrec[lastselected].Frozendirection:=hotkeyform.freezedirection; case memrec[lastselected].VarType of 0: begin //byte readprocessmemory(processhandle,pointer(realaddress),addr(db),1,error); if error=1 then begin db:=strtoint(hotkeyform.hotkeyvalue); memrec[lastselected].FrozenValue:=db; end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 1: begin //word readprocessmemory(processhandle,pointer(realaddress),addr(dw),2,error); if error=2 then begin dw:=strtoint(hotkeyform.hotkeyvalue); memrec[lastselected].FrozenValue:=dw end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 2: begin //dword readprocessmemory(processhandle,pointer(realaddress),addr(dd),4,error); if error=4 then begin dd:=strtoint(hotkeyform.hotkeyvalue); memrec[lastselected].FrozenValue:=dd end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 3: begin readprocessmemory(processhandle,pointer(realaddress),addr(a),4,error); if error=4 then begin controle:=FloatToStr(a); if (system.pos('NAT',controle)>0) or (system.pos('INF',controle)>0) then begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; a:=strtofloat(hotkeyform.hotkeyvalue); frozenfvalue[lastselected]:=a; end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 4: begin readprocessmemory(processhandle,pointer(realaddress),addr(b),8,error); if error=8 then begin controle:=FloatToStr(b); if (system.pos('NAT',controle)>0) or (system.pos('INF',controle)>0) then begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; b:=strtofloat(hotkeyform.hotkeyvalue); frozenfvalue[lastselected]:=b; end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 5: begin //binary k:=1+((memrec[i].Bit+memrec[i].bitlength) div 8); setlength(read8,k); readprocessmemory(processhandle,pointer(realaddress),addr(read8[0]),k,error); if error=k then begin //find out the current bit combination (use frozenstrings to store the value) //convert what i need to a string of bits temp:=''; j:=memrec[i].Bit; read9:=@read8[0]; for k:=1 to memrec[lastselected].bitlength do begin temp:=temp+IntToStr(getbit(j,read9^)); inc(j); if j>=8 then begin j:=0; inc(read9); end; end; //the tempstring now contaisn the bits (bit0 is first char...) frozenstrings[lastselected]:=temp; memrec[lastselected].Frozen:=true; end; end; 6: begin //int64 readprocessmemory(processhandle,pointer(realaddress),addr(dI64),8,error); if error=8 then begin di64:=strtoint64(hotkeyform.hotkeyvalue); memrec[lastselected].FrozenValue:=di64 end else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; 7: begin //text getmem(temps,memrec[lastselected].bit); readprocessmemory(processhandle,pointer(realaddress),temps,memrec[lastselected].Bit,error); if error=memrec[lastselected].bit then FrozenStrings[lastselected]:=temps else begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; freemem(temps); end; 8: begin //array of byte setlength(FrozenBytes[lastselected],memrec[lastselected].bit); readprocessmemory(processhandle,pointer(realaddress),FrozenBytes[lastselected],memrec[lastselected].Bit,error); if error<>memrec[lastselected].bit then begin unregisterhotkey(Handle,hotkeys[lastselected]); hotkeys[lastselected]:=-1; end; end; end; updatescreen; end; end; procedure TMainForm.Findoutwhatreadsfromthisaddress1obsoleteClick(Sender: TObject); var address: dword; realaddress,realaddress2,count: dword; j: integer; res:word; check: boolean; begin exit; { if not startdebuggerifneeded then exit; if debuggerthread.userisdebugging then raise exception.create('You can''t use this function while you are debugging the application yourself. (Close the memory view window)'); address:=memrec[lastselected].Address; if memrec[lastselected].IsPointer then begin address:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; with TformPointerOrPointee.create(self) do begin res:=showmodal; if res=mrno then begin //find what writes to the address pointer at by this pointer realaddress2:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; for j:=length(memrec[lastselected].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[lastselected].pointers[j].offset; end; address:=realaddress2; end else if res=mryes then address:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address else exit; end; end; if memrec[lastselected].VarType=0 then SetReadBreakpoint(address,1); //byte if memrec[lastselected].VarType=1 then SetReadBreakpoint(address,2); //word if memrec[lastselected].VarType=2 then SetReadBreakpoint(address,4); //dword if memrec[lastselected].VarType=3 then SetReadBreakpoint(address,4); //single if memrec[lastselected].VarType=4 then SetReadBreakpoint(address,8); //double if memrec[lastselected].VarType=5 then SetReadBreakpoint(address,1+(memrec[lastselected].Bit+memrec[lastselected].bitlength) div 8); //bit(will be handled as a byte) if memrec[lastselected].VarType=6 then SetReadBreakpoint(address,8); //8-bytes (qword) if memrec[lastselected].VarType=7 then SetReadBreakpoint(address,memrec[lastselected].Bit); //length of the text if memrec[lastselected].VarType=8 then SetReadBreakpoint(address,memrec[lastselected].Bit); //length of the array } end; procedure TMainForm.UndoScanClick(Sender: TObject); var i,j: integer; error: integer; a,b: string; resourcestring strconfirmUndo='Do you really want to go back to the results of the previous scan?'; begin if messagedlg(strConfirmUndo,mtConfirmation ,[mbyes,mbno],0)=mryes then begin foundlist.Deinitialize; undolastscan(GetVarType,hexadecimalcheckbox.checked); foundcount:=foundlist.Initialize(getvartype); undoscan.Enabled:=false; end; end; procedure TMainform.adjustbringtofronttext; var hotkey:string; reg : TRegistry; resourcestring strHideForeground='will hide the foreground window'; strHideAll='will hide all windows'; strUnHideForeground='will bring the foreground window back'; strUnhideAll='will bring all windows back'; begin if formsettings.cbHideAllWindows.Checked then begin if allwindowsareback then begin if onlyfront then fronttext:=strHideForeground else fronttext:=strHideAll; end else begin if onlyfront then fronttext:=strUnhideForeground else fronttext:=strUnhideAll; end; // end else fronttext:='brings Cheat Engine to front'; try hotkey:=''; reg:=TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('\Software\Cheat Engine',false) then hotkey:=reg.ReadString('BringToFrontHotkey'); except end; finally reg.Free; end; if hotkey='' then label7.caption:=''; // fronthotkey:=hotkey; end; procedure TMainForm.FormShow(Sender: TObject); resourcestring strhappybirthday='Let''s sing Happy Birthday for Dark Byte today!'; strXMess='Have fun'; strNewyear='And what are your good intentions for this year? ;-)'; strfuture='Wow,I never imagined people would use Cheat Engine up to today'; var reg: tregistry; modifier: dword; key: dword; hotkey: string; year,month,day: word; temp:string; i: integer; outputfile: textfile; go:boolean; loadt: boolean; firsttime: boolean; x: array of integer; begin Set8087CW($133f); loadt:=false; edit2.Text:=format('%.1f',[1.0]); reg:=Tregistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if not Reg.OpenKey('\Software\Cheat Engine',false) then begin if Reg.OpenKey('\Software\Cheat Engine',true) then begin //write some default data into the register reg.WriteBool('Undo',true); reg.writeBool('Advanced',true); reg.writeBool('SeperateThread',true); reg.writebool('Use Hyperscan if posible',false); reg.WriteInteger('ScanThreadpriority',formsettings.combothreadpriority.itemindex); end; end; except end; if reg.ValueExists('First Time User') then firsttime:=reg.ReadBool('First Time User') else firsttime:=true; if firsttime then begin reg.WriteBool('First Time User',false); if messagedlg('Do you want to try out the tutorial?',mtconfirmation,[mbyes,mbno],0)=mryes then shellexecute(0,'open','Tutorial.exe','','',sw_show); end; // animatewindow(mainform.Handle,10000,AW_CENTER); //mainform.repaint; fronttext:='brings Cheat engine to front'; if dontrunshow then exit; panel7.DoubleBuffered:=true; flashprocessbutton:=tflash.create(false); dontrunshow:=true; decodedate(now,year,month,day); if (month=7) and (day=1) then showmessage(strhappybirthday); if (month=12) and ((day=25) or (day=26)) then Showmessage(strXmess); if (month=1) and (day=1) then showmessage(strnewyear ); if (month=1) and (day=1) and (year>=2010) then showmessage(strFuture); if (month=4) and (day=1) then aprilfools:=true; if aprilfools=true then Messagedlg('Your license to use Cheat Engine has expired. You can buy a license to use cheat engine for 1 month for $200, 6 months for only $1000 and for 1 year for only $1800.'+' If you don''t renew your license Cheat Engine will be severely limited in it''s abilities. (e.g: Next scan has been disabled)',mtwarning,[mbok],0); LoadSettingsFromRegistry; //Load the table if one was suplied overridedebug:=false; if paramcount>=1 then begin loadt:=true; if uppercase(paramstr(1))='-O' then begin OverrideDebug:=true; loadt:=false; end; if paramcount>1 then begin //extra param temp:=paramstr(2); if length(temp)>4 then if temp[1]+temp[2]+temp[3]='/o=' then begin //output to: temp:=copy(temp,4,length(temp)-3); assignfile(outputfile, temp); rewrite(outputfile); for i:=0 to numberofrecords-1 do writeln(outputfile,memrec[i].description+' '+IntToHex(memrec[i].Address,8)); closefile(outputfile); showmessage(temp+' has been created'); end; end; end else begin end; if loadt then begin LoadTable(paramstr(1),false); updatescreen; updatelist; end; if GetSystemType<3 then //not a supported os for hardware breakpoints with formsettings do begin rdWriteExceptions.Checked:=true; rbDebugRegisters.Enabled:=false; label6.Enabled:=false; label7.Enabled:=false; rbDebugAsBreakpoint.Enabled:=false; rbInt3AsBreakpoint.Checked:=true; end; if (GetSystemType<4) {or (is64bitos)} then //not nt or later begin with formsettings do begin cbKernelQueryMemoryRegion.enabled:=false; cbKernelReadWriteProcessMemory.enabled:=false; cbKernelOpenProcess.enabled:=false; cbProcessWatcher.Enabled:=false; cbKDebug.enabled:=false; cbGlobalDebug.enabled:=false; TauntOldOsUser.Visible:=true; label25.Enabled:=false; end; end; vartypechange(vartype); adjustbringtofronttext; if aprilfools then caption:=cenorm+' EXPIRED!'; if autoattachtimer.enabled then autoattachcheck; //SMenu:=GetSystemMenu(handle,false); //don't put this in oncreate, just don't if memscan=nil then memscan:=tmemscan.create(progressbar1); memscan.setScanDoneCallback(mainform.handle,wm_scandone); FileAccessTest; end; procedure TMainForm.rbBitClick(Sender: TObject); begin if not isbit then begin isbit:=true; //convert the value to a binary value try if scanvalue.text='' then scanvalue.text:='0' else scanvalue.text:=inttobin(strtoint(scanvalue.Text)); if scanvalue.text='' then scanvalue.text:='0'; except // end; end; end; procedure TMainForm.rbDecClick(Sender: TObject); begin if isbit then begin isbit:=false; //convert the binary text to a decimal representation scanvalue.Text:=IntToStr(BinToInt(scanvalue.Text)); end; end; procedure TMainForm.Cut2Click(Sender: TObject); begin if scanvalue.SelLength>0 then scanvalue.CutToClipboard; end; procedure TMainForm.Copy2Click(Sender: TObject); begin if scanvalue.SelLength>0 then scanvalue.CopyToClipboard; end; procedure TMainForm.Paste2Click(Sender: TObject); var cb: TClipboard; text: string; i: integer; allow: boolean; begin cb:=tclipboard.Create; if cb.HasFormat(CF_TEXT) then begin if scanvalue.Focused then scanvalue.PasteFromClipboard; if (scanvalue2<>nil) and (scanvalue2.Focused) then scanvalue2.PasteFromClipboard; end; cb.free; end; procedure TMainform.checkpaste; var cb: TClipboard; text: string; i: integer; allow: boolean; begin cb:=tclipboard.Create; Paste2.enabled:=cb.HasFormat(CF_TEXT); cb.free; end; procedure TMainForm.ccpmenuPopup(Sender: TObject); begin checkpaste; end; procedure TMainForm.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin if newsize<305 then begin newsize:=305; accept:=false; end; end; procedure TMainForm.Splitter1Moved(Sender: TObject); begin panel5.Repaint; end; procedure TMainForm.SettingsClick(Sender: TObject); var tlhlp: thandle; m:tagMODULEENTRY32; mbi: _MEMORY_BASIC_INFORMATION; x:dword; i:integer; Savedata: tfilestream; ntdll,kernel32,user32:thandle; oldmodulelist:pointer; begin suspendhotkeyhandler; oldmodulelist:=modulelist; if formsettings.ShowModal<>mrok then begin resumehotkeyhandler; LoadSettingsFromRegistry; exit; end; resumehotkeyhandler; //set the memorybrowser settings if they changed if formsettings.cbShowDisassembler.checked then begin memorybrowser.splitter1.Visible:=true; memorybrowser.panel1.Visible:=true; end else begin // panel1.Visible:=false; memorybrowser.Panel1.Visible:=false; memorybrowser.splitter1.Visible:=false; end; if formsettings.cbKernelQueryMemoryRegion.checked then UseDBKQueryMemoryRegion else DontUseDBKQueryMemoryRegion; if formsettings.cbKernelReadWriteProcessMemory.checked then UseDBKReadWriteMemory else DontUseDBKReadWriteMemory; if formsettings.cbKernelOpenProcess.Checked then UseDBKOpenProcess else DontUseDBKOpenProcess; adjustbringtofronttext; end; procedure TMainForm.cbCaseSensitiveClick(Sender: TObject); begin HexadecimalCheckbox.checked:=cbcasesensitive.Checked; end; procedure TMainForm.LogoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbright then about1.click; end; var strt: integer=0; procedure TMainForm.directionclick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var sel: Integer; i: Integer; begin FControl.SetFocus; sel:=0; if sender is TLabel then begin sel:=(Sender as TLabel).Tag+scrollbar1.Position; if sel>numberofrecords-1 then begin if not ((ssSHift in Shift) or (ssCtrl in Shift) or (ssRight in Shift)) then begin for i:=0 to numberofrecords-1 do begin selected[i]:=false; end; updatescreen; end; exit; end; if memrec[sel].Frozen then inc(memrec[sel].Frozendirection); if memrec[sel].Frozendirection=3 then memrec[sel].Frozendirection:=0; end; if not ((ssShift) in (Shift)) then FirstShiftSelected:=-1; if ssLeft in Shift then begin if not (ssShift in Shift) and not (ssCtrl in Shift) then begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; if (sel>=numberofrecords) then begin updatelist; updatescreen; exit; end; if ssShift in shift then begin if FirstShiftSelected=-1 then FirstShiftSelected:=lastselected; //select everything from FirstShiftSelected to sel for i:=0 to numberofrecords-1 do selected[i]:=false; if FirstShiftSelected=numberofrecords) then begin updatelist; updatescreen; exit; end; if not selected[sel] then //clear all other selected items except this one begin for i:=0 to numberofrecords-1 do selected[i]:=false; end; selected[sel]:=true; end; lastselected:=sel; updatelist; Updatescreen; end; procedure TMainForm.btnShowRegionsClick(Sender: TObject); begin formmemoryregions:=tformmemoryregions.Create(self); formmemoryregions.showmodal; end; procedure TMainForm.Findoutwhataccessesthisaddress1Click(Sender: TObject); var address: dword; realaddress,realaddress2,count: dword; j: integer; res: word; check: boolean; begin if (not formsettings.cbKdebug.checked) then begin if (not startdebuggerifneeded) then exit; //if debuggerthread.userisdebugging then raise exception.create('You can''t use this function while you are debugging the application yourself. (Close the memory view window)'); end; address:=memrec[lastselected].Address; if memrec[lastselected].IsPointer then begin address:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; with TformPointerOrPointee.create(self) do begin button1.Caption:='Find out what accesses this pointer'; button2.Caption:='Find what accesses the address pointed at by this pointer'; res:=showmodal; if res=mrno then begin //find what writes to the address pointer at by this pointer realaddress2:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; for j:=length(memrec[lastselected].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[lastselected].pointers[j].offset else raise exception.Create('The pointer can''t be completly read'); end; address:=realaddress2; end else if res=mryes then address:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address else exit; end; end; if memrec[lastselected].VarType=0 then SetReadWriteBreakpoint(address,1); //byte if memrec[lastselected].VarType=1 then SetReadWriteBreakpoint(address,2); //word if memrec[lastselected].VarType=2 then SetReadWriteBreakpoint(address,4); //dword if memrec[lastselected].VarType=3 then SetReadWriteBreakpoint(address,4); //single if memrec[lastselected].VarType=4 then SetReadWriteBreakpoint(address,8); //double if memrec[lastselected].VarType=5 then SetReadWriteBreakpoint(address,1+(memrec[lastselected].Bit+memrec[lastselected].bitlength) div 8); //bit(will be handled as a byte) if memrec[lastselected].VarType=6 then SetReadWriteBreakpoint(address,8); //8-bytes (qword) if memrec[lastselected].VarType=7 then SetReadWriteBreakpoint(address,memrec[lastselected].Bit); //length of the text if memrec[lastselected].VarType=8 then SetReadWriteBreakpoint(address,memrec[lastselected].Bit); //length of the array end; procedure TMainForm.OpenProcesslist1Click(Sender: TObject); begin speedbutton1.Click; end; procedure TMainForm.CloseCheatEngine1Click(Sender: TObject); begin close; end; procedure TMainForm.Showashexadecimal1Click(Sender: TObject); var i: integer; begin for i:=0 to numberofrecords-1 do if selected[i] then memrec[i].ShowAsHex:=not memrec[lastselected].ShowAsHex; updatelist; end; procedure TMainForm.OpenMemorybrowser1Click(Sender: TObject); begin btnMemoryView.click; end; procedure TMainForm.cbFastScanClick(Sender: TObject); var i: integer; begin if cbfasterscan.Checked then begin //hyperscan does not support this type i:=vartype.Items.IndexOf('All (Byte to Double)'); if i>=0 then vartype.Items.Delete(i); i:=vartype.Items.IndexOf('Custom'); if i>=0 then vartype.Items.Delete(i); end else begin i:=vartype.Items.IndexOf('All (Byte to Double)'); if i=-1 then //it isn't in the list (anymore) vartype.Items.add('All (Byte to Double)'); //add it back i:=vartype.Items.IndexOf('Custom'); if i=-1 then vartype.Items.add('Custom'); end; if (sender=cbspeedhack) then begin if GetSystemType<4 then raise exception.Create(strNeedNewerWindowsVersion); end; if cbfasterscan.Checked or cbSpeedhack.Checked then begin if cefuncproc.hypermode=nil then begin try cefuncproc.hypermode:=THypermode.create; except cefuncproc.hypermode:=nil; end; end; end else if cefuncproc.hypermode<>nil then begin freeandnil(cefuncproc.hypermode); end; label51.visible:=cbspeedhack.checked; edit1.visible:=cbspeedhack.checked; label52.visible:=cbspeedhack.checked; edit2.visible:=cbspeedhack.checked; btnSetSpeedhack.visible:=cbspeedhack.checked; if cefuncproc.hypermode=nil then begin cbFasterscan.checked:=false; if formsettings.cbOldSpeedhack.checked then cbSpeedhack.Checked:=false; exit; end else cefuncproc.hypermode.WaitFor; if cefuncproc.hypermode=nil then exit; //self destruct if formsettings.cbOldSpeedhack.checked then begin if (cefuncproc.hypermode.speedhackenabled) and (not cbspeedhack.checked) then cefuncproc.hypermode.DisableSpeedhack; if (cefuncproc.hypermode.hyperscanwindow<>0) and (cbSpeedhack.checked) and (sender=cbSpeedhack) then begin if sendmessage(cefuncproc.hypermode.hyperscanwindow,wm_user+4,0,0)=$11223344 then begin cbspeedhack.Enabled:=true; cbunrandomizer.Enabled:=true; label52.Enabled:=true; label51.Enabled:=true; edit2.Enabled:=true; edit1.Enabled:=true; btnsetspeedhack.Enabled:=true; cefuncproc.hypermode.speedhackenabled:=true; btnSetSpeedhack.Click; end; end; end; end; procedure TMainForm.rbAllMemoryClick(Sender: TObject); begin FromAddress.text:='00000000'; ToAddress.text:='FFFFFFFF'; end; procedure TMainForm.cbPauseWhileScanningClick(Sender: TObject); resourcestring strdontbother='Don''t even bother. Cheat Engine uses the main thread to receive messages when the scan is done, freeze it and CE will crash!'; strneeddebugger='To use this option the debugger must be attached to the game'; begin if (cbPauseWhileScanning.checked) and (processid=getcurrentprocessid) then begin cbPauseWhileScanning.Checked:=false; messagedlg(strdontbother,mtError,[mbok],0); end; if (cbPauseWhileScanning.checked) and (not startdebuggerifneeded) then begin cbPauseWhileScanning.Checked:=false; messagedlg(strneeddebugger,mtInformation,[mbok],0); end; end; procedure TMainForm.btnSetSpeedhackClick(Sender: TObject); resourcestring strfailuretosetspeed='Failure to set the speed'; strIncorrectspeed='The speed value is incorrect'; strCantSetSpeed='I can''t set this speed. (must be bigger than 0)'; strHyperscanFailed='The hyperthread failed to respond with the right answer'; var x: dword; speedf: single; speed: dword absolute speedf; sleeptime: integer; speedtext: string; i: integer; begin if formsettings.cbOldSpeedhack.checked=false then begin editSH2.text:=edit2.Text; btnSetSpeedhack2.click; exit; end; try speedtext:=edit2.Text; speedf:=strtofloat(speedtext); except try if pos(',',speedtext)<>0 then begin //replace the , with a . i:=pos(',',speedtext); while i<>0 do begin speedtext[i]:='.'; i:=pos(',',speedtext); end; end else begin //replace the . with a , i:=pos('.',speedtext); while i<>0 do begin speedtext[i]:=','; i:=pos('.',speedtext); end; end; speedf:=strtofloat(speedtext); except raise exception.Create(strincorrectspeed); end; end; sleeptime:=strtoint(edit1.text); if speedf<=0 then raise exception.Create(strcantsetspeed); if speedf*sleeptime<1 then begin try sleeptime:=trunc(roundto(1/speedf,-1)); if sleeptime=0 then sleeptime:=1; edit1.Text:=IntToStr(sleeptime); except exception.Create(strfailuretosetspeed); end; end; x:=sendmessage(cefuncproc.hypermode.hyperscanwindow,wm_user+6,sleeptime,speed); if x<>12345 then raise exception.Create(strHyperscanfailed); end; procedure TMainform.disableHypermode; var i: integer; begin if cefuncproc.hypermode<>nil then begin cefuncproc.hypermode.WaitFor; if cefuncproc.hypermode.speedhackenabled then cefuncproc.hypermode.disablespeedhack; freeandnil(cefuncproc.hypermode); end; end; procedure TMainForm.enableHypermode; resourcestring strHyperscanfailed='Hypermode didn''t respond'; strhookfailed='I can''t set the hook required to get into the process. Check if there isn''t any anti-cheat protection running.'; var CEScanProcAddress:pointer; winhandle,possiblewinhandle: thandle; winprocess: dword; winthreadid: dword; x: ^byte; i,j: integer; s: string; begin if cefuncproc.hypermode<>nil then exit; cefuncproc.hypermode:=thypermode.create; end; procedure TMainForm.Description1Click(Sender: TObject); begin description[lastselected-scrollbar1.position].OnDblClick(value[lastselected-scrollbar1.position]); end; procedure TMainForm.Address1Click(Sender: TObject); begin address[lastselected-scrollbar1.position].OnDblClick(value[lastselected-scrollbar1.position]); end; procedure TMainForm.ype1Click(Sender: TObject); begin valtype[lastselected-scrollbar1.position].OnDblClick(value[lastselected-scrollbar1.position]) end; procedure TMainForm.Value1Click(Sender: TObject); begin value[lastselected-scrollbar1.position].OnDblClick(value[lastselected-scrollbar1.position]) end; procedure TMainForm.ProcessLabelDblClick(Sender: TObject); var peprocesS: dword; needed:dword; x: dword; processInfo:TProcessBasicInformation; buf:pchar; begin if formsettings.cbKernelOpenProcess.Checked then begin if processid=0 then exit; if not IsValidHandle(processhandle) then if messagedlg('The process isn''t fully opened. Indicating a invalid ProcessID. You still want to find out the EPROCESS? (BSOD is possible)',mtwarning,[mbyes,mbno],0)<>mryes then exit; peprocess:=GetPEProcess(processid); showmessage('PEProcess='+IntToHex(peprocess,8)); memorybrowser.memoryaddress:=peprocess; end; end; procedure TMainForm.ProcessLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (button = mbright) and (darkbytekernel<>0) and IsValidHandle(processhandle) then tfrmProcessInfo.Create(self).Show; end; procedure TMainForm.cbUnrandomizerClick(Sender: TObject); begin if cbunrandomizer.checked then begin if(messagedlg('This will scan for and change some routines that are commonly used to'+' generate a random value so they always return the same. Please be aware that there is a chance it overwrites the wrong routines causing the program to crash, or that the program uses an unknown random generator. Continue?',mtwarning,[mbyes,mbno],0)=mryes) then begin unrandomize:=tunrandomize.create(true); with unrandomize do begin progressbar:=tprogressbar.create(self); progressbar.left:=twincontrol(sender).Left; progressbar.top:=twincontrol(sender).top; progressbar.Width:=twincontrol(sender).width; progressbar.height:=twincontrol(sender).height; progressbar.parent:=self; cbunrandomizer.enabled:=false; resume; end; end else cbUnrandomizer.Checked:=false; end else begin if unrandomize<>nil then freeandnil(unrandomize); end; end; procedure TMainForm.cbUnrandomizerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if cbunrandomizer.Checked and (button=mbright) then begin //show unrandimized addresses unrandomize.showaddresses; end; end; procedure TMainForm.disableautoassemblecheat(i: integer); var code: tstringlist; begin code:=tstringlist.Create; code.Text:=memrec[i].autoassemblescript; try memrec[i].Frozen:=not autoassemble(code,false,false,false,false,memrec[i].allocs); if memrec[i].Frozen then //failed, lets say if reloading the symbols can help begin symhandler.reinitialize; memrec[i].Frozen:=not autoassemble(code,false,false,false,false,memrec[i].allocs); end; except end; code.free; end; procedure TMainForm.enableautoassemblecheat(i: integer); var code: tstringlist; begin code:=tstringlist.Create; code.Text:=memrec[i].autoassemblescript; try setlength(memrec[i].allocs,1); memrec[i].Frozen:=autoassemble(code,false,true,false,false,memrec[i].allocs); if not memrec[i].frozen then begin symhandler.reinitialize; memrec[i].Frozen:=autoassemble(code,false,true,false,false,memrec[i].allocs); end; except end; code.free; end; procedure TMainForm.addaddress(description: string; address:dword; const offsets: array of dword; offsetcount: integer; ispointer: boolean; vartype: integer; length: integer; startbit:integer; unicode,showashex: boolean); var i: integer; begin if offsetcount=0 then ispointer:=false; //safeguard inc(NumberOfRecords); reserveMem; memrec[numberofrecords-1].Description:=description; memrec[numberofrecords-1].Address:=address; memrec[NumberOfRecords-1].VarType:=vartype; memrec[numberofrecords-1].unicode:=unicode; memrec[numberofrecords-1].IsPointer:=ispointer; memrec[numberofrecords-1].Bit:=startbit; //startbit is also used for size for strings memrec[numberofrecords-1].bitlength:=length; memrec[numberofrecords-1].showashex:=showashex; if ispointer then begin setlength(memrec[numberofrecords-1].pointers,offsetcount); for i:=0 to offsetcount-1 do begin memrec[numberofrecords-1].pointers[i].Address:=address; memrec[numberofrecords-1].pointers[i].offset:=offsets[i]; end; end; memrec[NumberOfRecords-1].Frozen:=false; memrec[NumberOfRecords-1].FrozenValue:=0; FrozenFvalue[NumberOfRecords-1]:=0; FrozenStrings[NumberOfRecords-1]:=''; Hotkeystrings[NumberOfRecords-1]:=''; Hotkeys[NumberOfRecords-1]:=-1; UpdateScreen; updatelist; end; procedure TMainForm.addaddress(description: string; address:dword; const offsets: array of dword; offsetcount: integer; ispointer: boolean; vartype: integer; length: integer; startbit:integer; unicode: boolean); begin addaddress(description,address,offsets,offsetcount,ispointer,vartype,length,startbit,unicode,false); end; procedure TMainForm.Foundlist3CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); begin if foundlist.inmodule(item.index) then foundlist3.Canvas.Font.Color:=clgreen; end; procedure TMainForm.actOpenExecute(Sender: TObject); var merge: boolean; app: word; Extension: string; resourcestring strUnknownExtension='Unknown extension'; begin if editingscript then raise exception.create('First close your script edit window before opening a new table'); merge:=false; if not autoopen then if CheckIfSaved=false then exit; OpenDialog1.InitialDir:=cheatenginedir; if autoopen or Opendialog1.Execute then begin autoopen:=false; Extension:=uppercase(extractfileext(opendialog1.filename)); if (Extension<>'.XML') and (Extension<>'.PTR') and (Extension<>'.AMT') and (Extension<>'.GH') and (Extension<>'.CET') and (Extension<>'.CT2') and (Extension<>'.CT3') and (Extension<>'.CT') and (Extension<>'.EXE') then raise exception.create(strUnknownExtension); if ((numberofrecords>0) or (advancedoptions.numberofcodes>0)) and (Extension<>'.EXE') then app:=messagedlg('You wish to merge the current table with this table?',mtConfirmation,mbYesNoCancel,0); case app of mrCancel: exit; mrYes: merge:=true; mrNo: merge:=false; end; LoadTable(Opendialog1.filename,merge); reinterpretaddresses; end; if advancedoptions.codelist2.items.Count>0 then begin advancedoptions.Position:=podesigned; advancedoptions.Left:=mainform.left-advancedoptions.Width; advancedoptions.Top:=mainform.Top+mainform.Height-advancedoptions.Height; if (advancedoptions.Left<0) or (advancedoptions.Top+advancedoptions.Height>screen.height) then begin advancedoptions.left:=0; advancedoptions.Top:=screen.Height-advancedoptions.Height; end; advancedoptions.show; end; Updatescreen; updatelist; end; procedure TMainForm.actSaveExecute(Sender: TObject); begin if (savedialog1.FileName='') and (opendialog1.filename<>'') then begin //set the filename the table was opened with to the filename you save as default to //and dont forget to change the extension to .CT savedialog1.FileName:=ChangeFileExt(opendialog1.FileName,''); end; SaveDialog1.InitialDir:=cheatenginedir; if Savedialog1.Execute then savetable(savedialog1.FileName); end; procedure TMainForm.actAutoAssembleExecute(Sender: TObject); begin tfrmautoinject.create(self).show; end; procedure TMainform.changeScriptCallback(script: string; changed: boolean); { Gets called when a edit script is done } begin if editingscript then begin editingscript:=false; if changed then begin memrec[editedscript].autoassemblescript:=script; itemshavechanged:=true; end; end else raise exception.Create('Unexpected scriptchange'); end; procedure TMainForm.Changescript1Click(Sender: TObject); var x: TFrmAutoInject; y: array of integer; begin if editingscript then raise exception.Create('First finish editing the other script'); if lastselected<>-1 then begin x:=tfrmautoinject.Create(self); with x do begin name:='AAEditScript'; new1.Enabled:=false; editscript:=true; editscript2:=true; callbackroutine:=changeScriptCallback; mainform.editingscript:=true; mainform.editedscript:=lastselected; assemblescreen.Text:=memrec[lastselected].autoassemblescript; { if showmodal=mrok then begin if assemblescreen.text<>memrec[lastselected].autoassemblescript then editedsincelastsave:=true; memrec[lastselected].autoassemblescript:=assemblescreen.text; free; //needed for editscript end; } formstyle:=fsStayOnTop; loadformposition(x,y); show; end; end; end; procedure TMainForm.Forcerechecksymbols1Click(Sender: TObject); begin symhandler.reinitialize; symhandler.waitforsymbolsloaded; reinterpretaddresses; updatescreen; end; procedure TMainForm.Label5Click(Sender: TObject); begin { SetProcessAffinityMask(getcurrentprocess,1); sleep(500); dbktest; SetProcessAffinityMask(getcurrentprocess,2); sleep(500); dbktest; SetProcessAffinityMask(getcurrentprocess,3); } end; procedure TMainform.edit; var frmPasteTableentry: TfrmPasteTableentry; replace_find: string; replace_with: string; changeoffsetstring: string; changeoffset,x: dword; i,j: integer; hasselected: boolean; begin if NumberOfRecords=0 then exit; frmPasteTableentry:=TfrmPasteTableentry.create(self); try frmPasteTableentry.caption:='Edit addresses'; frmPasteTableentry.Button1.Caption:='Edit'; if frmpastetableentry.showmodal=mrcancel then exit; replace_find:=frmpastetableentry.edtFind.text; replace_with:=frmpastetableentry.edtReplace.text; changeoffsetstring:='$'+stringreplace(frmpastetableentry.edtOffset.Text,'-','-$',[rfReplaceAll]); changeoffsetstring:=stringreplace(changeoffsetstring,'$-','-',[rfReplaceAll]); try changeoffset:=strtoint(changeoffsetstring); except changeoffset:=0; end; finally frmPasteTableentry.free; end; hasselected:=false; for i:=0 to numberofrecords-1 do begin if Selected[i] then begin hasselected:=true; break; end; end; for i:=0 to numberofrecords-1 do begin if (hasselected and selected[i]) or (not hasselected) then begin memrec[i].Description:=StringReplace(memrec[i].Description,replace_find,replace_with,[rfReplaceAll,rfIgnoreCase]); memrec[i].Address:=memrec[i].Address+changeoffset; if memrec[i].interpretableaddress<>'' then begin try x:=symhandler.getAddressFromName(memrec[i].interpretableaddress); x:=x+changeoffset; memrec[i].interpretableaddress:=symhandler.getNameFromAddress(x,true,true) except memrec[i].interpretableaddress:=inttohex(memrec[i].Address,8); end; end; for j:=0 to length(memrec[i].pointers)-1 do begin //address memrec[i].pointers[j].Address:=memrec[i].pointers[j].Address+changeoffset; if memrec[i].pointers[j].interpretableaddress<>'' then begin try x:=symhandler.getAddressFromName(memrec[i].pointers[j].interpretableaddress); x:=x+changeoffset; memrec[i].pointers[j].interpretableaddress:=symhandler.getNameFromAddress(x,true,true) except memrec[i].pointers[j].interpretableaddress:=inttohex(memrec[i].Address,8); end; end; end; end; end; updatescreen; Updatelist; end; procedure TMainForm.Smarteditaddresses1Click(Sender: TObject); begin edit; end; procedure TMainForm.Pointerscanforthisaddress1Click(Sender: TObject); var res: integer; realaddress2,realaddress,address,count: dword; j: integer; check: boolean; i: integer; findpointeroffsets: boolean; frmPointerScanner: TfrmPointerScanner; begin findpointeroffsets:=false; try if memrec[lastselected].IsPointer then begin if MessageDlg('This is already a pointer. Do you want to find another pointer that fits with these offsets?',mtInformation, [mbyes,mbno], 0)=mryes then findpointeroffsets:=true; realaddress2:=memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Address; for j:=length(memrec[lastselected].pointers)-1 downto 0 do begin check:=readprocessmemory(processhandle,pointer(realaddress2),@realaddress,4,count); if check and (count=4) then realaddress2:=realaddress+memrec[lastselected].pointers[j].offset else raise exception.Create('The pointer can''t be completly read'); end; address:=realaddress2; end else address:=memrec[lastselected].address; except address:=memrec[lastselected].address; end; res:=mryes; // with tfrmInjectedpointerscanornot.create(self) do // begin // res:=showmodal; // free; // end; if res=mrcancel then exit; if res=mryes then begin //default frmPointerScanner:=tfrmpointerscanner.create(self); frmPointerScanner.show; if frmpointerscannersettings=nil then frmpointerscannersettings:=tfrmpointerscannersettings.create(self); frmpointerscannersettings.edtAddress.text:=inttohex(address,8); if findpointeroffsets then begin //create and fill in the offset list frmpointerscannersettings.cbMustEndWithSpecificOffset.checked:=true; TOffsetEntry(frmpointerscannersettings.offsetlist[0]).offset:=memrec[lastselected].pointers[0].offset; for i:=1 to length(memrec[lastselected].pointers)-1 do begin frmpointerscannersettings.btnAddOffset.Click; TOffsetEntry(frmpointerscannersettings.offsetlist[i]).offset:=memrec[lastselected].pointers[i].offset; end; end; frmPointerScanner.Method3Fastspeedandaveragememoryusage1.Click; end else if res=mrno then begin //injected scan injectpointerscan(address); end; end; procedure testx(arg1:pointer; arg2:pointer; arg3:pointer); stdcall; begin asm pushad pushad popad popad end; end; procedure TMainForm.Label53Click(Sender: TObject); var x: integer; begin asm mov ax,$40 mov es,ax end; showmessage(inttohex(x,8)); end; procedure TMainForm.pointerscanner_addaddress(var Message: TMessage); var p: thandle; sourcebuffer: pointer; ms: tmemorystream; x: dword; address: dword; offsets: array of cardinal; i: integer; cds: PCOPYDATASTRUCT; st: pchar; s: string; begin cds:=pointeR(message.LParam); if cds=nil then exit; try if cds.dwData=$ce then begin ms:=tmemorystream.Create; try getmem(sourcebuffer,cds.cbData); copymemory(sourcebuffer,cds.lpData,cds.cbData); ms.writebuffer(sourcebuffer^,cds.cbData); freemem(sourcebuffer); ms.Position:=0; ms.ReadBuffer(x,sizeof(x)); getmem(st,x+1); ms.readbuffer(st^,x); st[x]:=#0; s:=st; freemem(st); address:=symhandler.getAddressFromName(s); setlength(offsets,0); while ms.Position0,2,0,0,false,false); if memrec[numberofrecords-1].IsPointer then //yes, but check anyhow begin memrec[numberofrecords-1].pointers[length(memrec[numberofrecords-1].pointers)-1].Interpretableaddress:=s; end; finally ms.Free; end; end; except end; end; procedure TMainForm.Label57Click(Sender: TObject); {var i: dword; } begin { i:=newkernelhandler.dbvm_version; showmessage('dbvm version='+inttohex(i,8)); } end; procedure TMainform.OnToolsClick(sender: TObject); begin shellexecute(0,'open',pchar(formsettings.lvTools.Items[TMenuItem(sender).Tag].SubItems[0]),'','',SW_SHOW); end; Procedure TMainForm.plugintype5click(sender:tobject); var x: TPluginfunctionType5; begin x:=TPluginfunctionType5(tmenuitem(sender).Tag); if x<>nil then x.callback(); end; Procedure TMainForm.plugintype0click(sender:tobject); var selectedrecord: PPlugin0_SelectedRecord; var x: TPluginfunctionType0; interpretableaddress: string[255]; description: string[255]; i: integer; offsets: PDwordArray; a,b,c,d,e,f,g,h,j: dword; begin interpretableaddress:=' '; description:=' '; if (lastselected<>-1) and (lastselectednil then begin interpretableaddress[length(interpretableaddress)+1]:=#0; description[length(description)+1]:=#0; if x.callback(selectedrecord) then begin if selectedrecord<>nil then begin interpretableaddress[255]:=#0; description[255]:=#0; pbyte(@interpretableaddress[0])^:=StrLen(@interpretableaddress[1]); pbyte(@description[0])^:=StrLen(@description[1]); if memrec[lastselected].IsPointer then memrec[lastselected].pointers[length(memrec[lastselected].pointers)-1].Interpretableaddress:=interpretableaddress else memrec[lastselected].interpretableaddress:=interpretableaddress; memrec[lastselected].Description:=description; memrec[lastselected].VarType:=selectedrecord.valuetype; //load back and free memory freemem(offsets); //using my own var instead the user is lame enough to mess up the pointer reinterpretaddresses; end; end; //showmessage(inttohex(dword(@x.callback),8)); end; end; //------------------foundlist------------------ procedure TMainForm.Foundlist3Data(Sender: TObject; Item: TListItem); var extra: dword; value: string; address: string; valuetype: TVariableType; begin //put in data try address:=inttohex(foundlist.GetAddress(item.Index,extra,value),8); if foundlist.vartype = 5 then //binary begin address:=address+'^'+inttostr(extra); end else if foundlist.vartype = 9 then //all begin valuetype:=TVariableType(extra); //here valuetype is stored using the new method case valuetype of vtByte: address:=address+':1'; vtWord: address:=address+':2'; vtDword: address:=address+':4'; vtQword: address:=address+':8'; vtSingle: address:=address+':s'; vtDouble: address:=address+':d'; end; end else //normal address:=inttohex(foundlist.GetAddress(item.Index,extra,value),8); item.Caption:=address; item.subitems.add(value); except showmessage(inttostr(item.index)); end; end; procedure TMainForm.UpdateFoundlisttimerTimer(Sender: TObject); begin foundlist.RefetchValueList; end; procedure TMainForm.Foundlist3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if ((key=ord('A')) and (ssctrl in Shift) and not (ssalt in Shift)) then begin //select all if foundlist3.Items.Count<5000 then foundlist3.SelectAll; end; end; procedure TMainForm.mode16Click(Sender: TObject); begin { disassembler.mode16:=mode16.checked; } end; var raaa: packed record eip: dword; segment: word; end; var c: tcontext; procedure TMainForm.Label59Click(Sender: TObject); begin end; { var usedkernelbase: dword=0; usedkernelstring: string; function FindUsedKernel: string; //Will return the string of the currently used kernelfile var need: dword; x: PPointerArray; count: integer; drivername: pchar; i: integer; begin if usedkernelbase=0 then begin EnumDevicedrivers(nil,0,need); getmem(x,need); try if enumDevicedrivers(@x[0],need,need) then begin count:=need div 8; getmem(drivername,200); try for i:=0 to count-1 do begin GetDevicedriverBaseName(x[i],drivername,200); if usedkernelbase=0 then //not found so keep looking begin if pos('krnl',drivername)>0 then //first one to encounter is it. (and can't pick the first one sicne thats ntdll.dll) begin usedkernelbase:=dword(x[i]); usedkernelstring:=drivername; result:=drivername; break; end; end; end; finally freemem(drivername); end; end; finally freemem(x); end; end else result:=usedkernelstring; end; } { type Ttestfunc=function(a: dword): boolean; stdcall; } function x(a: dword):BOOL; stdcall; begin result:=(a<100); end; { var v1: real48; v2: Single; v3: double; v4: Extended; v5: Comp; v6: Currency; } var xxxb: integer; procedure xxxa; stdcall; asm pushad mov [xxxb],eax popad end; procedure ChangeIcon(hModule: HModule; restype: pchar; resname: pchar; lparam: thandle); stdcall; var iconRSRC: HRSRC; iconG: HGLOBAL; resSize: integer; p: pointer; begin iconRSRC:=FindResource(hModule,resName,resType); resSize:=SizeofResource(hModule,iconRSRC); iconG:=LoadResource(hModule,iconRSRC); p:=LockResource(iconG); // nvoke UpdateResource,hUpdate,lpszType,lpszName,ecx,pData,nSizeOfRes //;invoke FreeResource,hResLoaded //mov eax,TRUE UpdateResource(lParam,restype, resName, 1030,p,resSize); end; var abc: TReversePointerListHandler; procedure TMainForm.Browsethismemoryregioninthedisassembler1Click( Sender: TObject); var a,b: dword; s: string; begin if (foundlist3.ItemIndex<>-1) then begin memorybrowser.disassemblerview.SelectedAddress:=foundlist.GetAddress(foundlist3.itemindex,b,s); memorybrowser.show; end; end; procedure TMainform.autoattachcheck; var pl: TStringlist; i,j,k: integer; newPID: dword; pli: PProcessListInfo; begin //in case there is no processwatcher this timer will be used to enumare the processlist every 2 seconds if (not formsettings.cbAlwaysAutoAttach.checked) and ((processhandle<>0) or (processid<>0)) then exit; pl:=tstringlist.Create; getprocesslist(pl); try for i:=0 to autoattachlist.Count-1 do begin for j:=0 to pl.Count-1 do //can't do indexof begin if pos(uppercase(autoattachlist.Strings[i]),uppercase(pl.strings[j]))=10 then begin //the process is found val('$'+pl.strings[j],newPID,k); if processid=newPID then exit; //already attached to this one ProcessHandler.processid:=newPID; unpause; DetachIfPossible; MainForm.ProcessLabel.caption:=pl.strings[j]; Open_Process; enablegui(false); openProcessEpilogue('',0,0,true); symhandler.reinitialize; reinterpretaddresses; end; end; end; // pl.IndexOf(autoattachlist.items[i]); finally for i:=0 to pl.count-1 do if pl.Objects[i]<>nil then begin pli:=pointer(pl.Objects[i]); if pli.processIcon>0 then DestroyIcon(pli.processIcon); freemem(pli); end; pl.free; end; end; procedure TMainForm.AutoAttachTimerTimer(Sender: TObject); begin autoattachcheck; end; procedure TMainForm.Button2Click(Sender: TObject); var svalue2: string; percentage: boolean; begin foundlist.Deinitialize; //unlock file handles if cbpercentage<>nil then percentage:=cbpercentage.checked else percentage:=false; if button2.tag=0 then begin progressbar1.min:=0; progressbar1.max:=1000; progressbar1.position:=0; if scanvalue2<>nil then svalue2:=scanvalue2.Text else svalue2:=''; lastscantype:=scantype.ItemIndex; if cbPauseWhileScanning.checked then begin advancedoptions.Pausebutton.down:=true; advancedoptions.Pausebutton.Click; end; memscan.firstscan(GetScanType2, getVarType2, roundingtype, scanvalue.text, svalue2, scanStart, scanStop, fastscan, scanreadonly, HexadecimalCheckbox.checked, rbdec.checked, cbunicode.checked, cbCaseSensitive.checked, percentage, SelectedCustomScanData, SelectedCustomScanType); DisableGui; SpawnCancelButton; end else if button2.tag=2 then begin //newscan button2.Tag:=0; donewscan; memscan.newscan; //cleanup memory and terminate all background threads end; end; procedure TMainForm.ScanDone(var message: TMessage); var i: integer; canceled: boolean; begin i:=0; canceled:=false; button2.Tag:=2; button2.Caption:='Scan'; button4.tag:=0; progressbar1.Position:=0; SetProgressState(tbpsNone); foundcount:=memscan.GetFoundCount; if message.wparam>0 then begin messagedlg('Scan error:'+memscan.GetErrorString, mtError,[mbok],0); end; { else} // showmessage('SCAN SUCCES. time='+inttostr(after-before)); enablegui(memscan.LastScanType=stNextScan); destroyCancelButton; foundlist.Initialize(getvartype,i,hexadecimalcheckbox.checked,formsettings.cbShowAsSigned.Checked,formsettings.cbBinariesAsDecimal.Checked,cbunicode.checked); if memscan.lastscantype=stFirstScan then begin //firstscan Epilogue Groupbox1.Enabled:=false; for i:=0 to groupbox1.ControlCount-1 do groupbox1.Controls[i].Enabled:=false; vartype.Enabled:=false; nextscanbutton.enabled:=true; newscan.Caption:=strNewScan; end; beep; //let the blind user know the scan has finished (See, I'm thinking about the visually impeared users...) progressbar1.Position:=0; UpdateFoundlisttimer.Enabled:=true; Scantype.ItemIndex:=lastscantype; UpdateScanType; scanepilogue(canceled); end; procedure Tmainform.CancelbuttonClick(sender: TObject); begin if cancelbutton.tag=0 then begin cancelbutton.Caption:='Terminating scan...'; cancelbutton.Enabled:=false; cancelbutton.Tag:=1; //force termination cancelbutton.Hint:='This button will force cancel a scan. Expect memory leaks'; cancelbutton.ParentShowHint:=false; cancelbutton.ShowHint:=true; memscan.terminatescan(false); cancelbuttonenabler.Enabled:=false; cancelbuttonenabler.interval:=8000; //8 seconds cancelbuttonenabler.tag:=1; cancelbuttonenabler.enabled:=true; end else begin //force it. It took too long memscan.TerminateScan(true); end; end; procedure Tmainform.CancelbuttonenablerInterval(sender: TObject); begin if cancelbutton<>nil then cancelbutton.enabled:=true; if cancelbutton.Tag=1 then cancelbutton.Caption:='Force termination'; TTimer(sender).Enabled:=false; end; procedure TMainForm.Button4Click(Sender: TObject); var svalue2: string; estimateddiskspaceneeded: Uint64; diskspacefree, totaldiskspace: int64; totaldiskspacefree: LARGE_INTEGER; percentage: boolean; begin if cbpercentage<>nil then percentage:=cbpercentage.checked else percentage:=false; estimateddiskspaceneeded:=foundcount*8*3; GetDiskFreeSpaceEx(pchar(cheatenginedir), diskspacefree, totaldiskspace,@totaldiskspacefree); if estimateddiskspaceneeded>diskspacefree then if MessageDlg('You are low on diskspace on the folder where the scanresults are stored. Scanning might fail. Are you sure you want to continue?',mtwarning,[mbyes,mbno],0)<>mryes then exit; foundlist.Deinitialize; //unlock file handles if cbPauseWhileScanning.checked then begin advancedoptions.Pausebutton.down:=true; advancedoptions.Pausebutton.Click; end; progressbar1.min:=0; progressbar1.max:=1000; progressbar1.position:=0; if scanvalue2<>nil then svalue2:=scanvalue2.Text else svalue2:=''; lastscantype:=scantype.ItemIndex; memscan.nextscan(GetScanType2, roundingtype, scanvalue.text, svalue2, scanStart, scanStop, fastscan, scanreadonly, HexadecimalCheckbox.checked, rbdec.checked, cbunicode.checked, cbCaseSensitive.checked, percentage, SelectedCustomScanData, SelectedCustomScanType); DisableGui; SpawnCancelButton; end; procedure TMainform.scanepilogue(canceled: boolean); var vtype: integer; i: integer; bytes: tbytes; begin vtype:=getvartype; if not canceled then begin case vtype of 5: i:=memscan.getbinarysize; 7: i:=length(scanvalue.Text); 8: //array of byte begin setlength(bytes,0); try ConvertStringToBytes(scanvalue.Text,hexadecimalcheckbox.checked,bytes ); i:=length(bytes); except i:=1; end; setlength(bytes,0); end; 10: i:=memscan.Getcustomvariablesize; end; foundlist.Initialize(vtype,i,hexadecimalcheckbox.checked,formsettings.cbShowAsSigned.Checked,formsettings.cbBinariesAsDecimal.Checked,cbunicode.checked); end else foundlist.Initialize(vtype); //failed scan, just reopen the addressfile try if scanvalue.Visible and scanvalue.Enabled then begin scanvalue.SetFocus; scanvalue.SelectAll; end else if not canceled then begin NextScanButton.SetFocus; end; except end; if cbPauseWhileScanning.checked then begin advancedoptions.Pausebutton.down:=false; //resume advancedoptions.Pausebutton.Click; end; end; //-----------------custom scan-----------------// resourcestring strCustomScanConfig='Custom scan config'; procedure TMainform.EditCustomScanButtonClick(sender: TObject); var autoinjectform: TFrmAutoInject; scandata: tstringlist; scriptname: string; begin scandata:=SelectedCustomScanData; if scandata=nil then exit; autoinjectform:=TFrmAutoInject.Create(self); try with autoinjectform do begin caption:=caption+' '+strCustomScanConfig; assemblescreen.Text:=scandata.text; new1.Enabled:=false; editscript:=true; injectintomyself:=true; if showmodal=mrok then begin scriptname:=customscanscripts[scantype.itemindex].name; if not inputquery(strCustomScanConfig,'The script seems to be valid. What is the name of this script?',scriptname) then exit; scandata.Text:=assemblescreen.Text; customscanscripts[scantype.itemindex].name:=scriptname; end; end; finally autoinjectform.free; end; end; procedure TMainform.CreateCustomScanButtonClick(sender: TObject); { Open a autoassembler window and fill it in. Give hints that people can use loadlibratry and functions from dll's } var scriptname: string; i: integer; begin with tfrmautoinject.Create(self) do begin try caption:=caption+' '+strCustomScanConfig; with assemblescreen.lines do begin add('[enable]'); add('{do not change the allocnames of the following code, you are free to add new allocs though'); add('of course then don''t forget to dealloc them at [disable] as well}'); add('alloc(checkroutine,2048)'); add('alloc(prologue,2048)'); add('alloc(epilogue,2048)'); add('alloc(fastscanstepsize,4)'); add('alloc(variablesize,4)'); add('alloc(firstscan,4)'); add('alloc(scantext,4) //will get the pointer to the given string'); add('alloc(scanvalue,8) //will get the value of the input string converted to an 8-byte value'); add('alloc(singlescanvalue,4) //will get the float type of the input'); add('alloc(doublescanvalue,8) //will get the double type of the input'); add(''); add('variablesize:'); add('dd 4 //defines how many bytes get saved for each found result'); add(''); add('fastscanstepsize:'); add('dd 1 //defines the stepsize when using fastscan (1=no difference)'); add(''); add('firstscan:'); add('dd 0 //set to 1 if you want the old value to be that of the first scan'); add(''); add('/* routines: '); add('Hint: You can write these routines in any language you like and export them as dll''s. '); add('Then use loadlibraty and call exportfunction to use them*/'); add(''); add('checkroutine:'); add('/*'); add('edx=pointer to new value'); add('ecx=pointer to old value'); add('*/'); add(''); add('//example of 4-byte "exact value" scan for the value 100:'); add('mov eax,[edx] //eax gets the new value'); add('cmp eax,#100 //compare eax with #100, # tells the assembler to read it as a decimal instead of hex'); add('setz al //sets al to 1 if match, 0 if false (upper bits of eax are ignored)'); add('ret'); add(''); add('prologue:'); add('//You can put some code here that gets executed BEFORE the scan starts'); add('ret'); add(''); add('epilogue:'); add('//You can put some code here that gets executed AFTER the scan finishes'); add('ret'); add(''); add('scandisplayroutinetype:'); add('/*'); add('displayroutinetype is a ''special'' globally registered symbol (No need to alloc)'); add('The byte at this address specifies how the values are shown'); add('0=1 byte notation'); add('1=2 byte notation'); add('2=4 byte notation'); add('3=8 byte notation'); add('4=float notation'); add('5=double notation'); add('6=array of bytes'); add('7=string ascii'); add('8=string unicode'); add('ff=use ''scandisplayroutine:'' to convert the data to a string'); add('*/'); add('db 2 //2=4 byte notation'); add(''); add('scandisplayroutine:'); add('/*'); add('displayroutine is a ''special'' globally registered symbol (No need to alloc)'); add('if ''scandisplayroutinetype:'' is set to 255 then this routine will be called to'); add('convert the value at the address specified to a ascii-string'); add('eax=pointer to bytes at the address'); add('edx=pointer to destination string (max 50 chars)'); add(''); add('note: scandisplayroutine is only 16KB big'); add('*/'); add('mov [edx],"N" //NYI, not yet implemented'); add('mov [edx+1],"Y"'); add('mov [edx+2],"I"'); add('mov [edx+3],0'); add('ret'); add(''); add(''); add('[disable]'); add('dealloc(checkroutine)'); add('dealloc(prologue,2048)'); add('dealloc(epilogue,2048)'); add('dealloc(fastscanstepsize)'); add('dealloc(variablesize)'); add('dealloc(scantext)'); add('dealloc(scanvalue)'); add('dealloc(singlescanvalue)'); add('dealloc(doublescanvalue)'); end; new1.Enabled:=false; editscript:=true; injectintomyself:=true; if showmodal=mrok then begin scriptname:='script '+inttostr(length(customscanscripts)+1); if not inputquery(strCustomScanConfig,'The script seems to be valid. What is the name of this script?',scriptname) then exit; //create a new entry in the custom list i:=length(customscanscripts); setlength(CustomScanScripts,i+1); CustomScanScripts[i].name:=scriptname; CustomScanScripts[i].data:=tstringlist.create; CustomScanScripts[i].data.Text:=assemblescreen.Text; CustomScanScripts[i].CustomScanType:=cstAutoAssembler; UpdateScanType; //reload the custom script list scantype.ItemIndex:=i; end; finally free; //clean up end; end; end; procedure TMainForm.ScanTypeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i: integer; index: integer; begin index:=scantype.itemindex; if (key=vk_delete) and (getSelectedVariableType=vtCustom) and (index>=0) then //custom scan and something is selected if messagedlg('Delete this custom script?',mtConfirmation,[mbyes,mbno],0)=mryes then begin CustomScanScripts[index].data.free; for i:=index to length(customscanscripts)-2 do CustomScanScripts[i]:=CustomScanScripts[i+1]; setlength(CustomScanScripts,length(CustomScanScripts)-1); scantype.Items.Delete(index); if length(CustomScanScripts)>=index then scantype.ItemIndex:=length(CustomScanScripts)-1; scantype.Refresh; end; end; procedure TMainForm.HeaderControl1SectionClick( HeaderControl: THeaderControl; Section: THeaderSection); begin if editingscript then exit; //no sorting till the edit is done case section.Index of 0: sortbyfrozenbutton.Click; 1: sortbydescriptionbutton.Click; 2: sortbyaddressbutton.Click; 3: sortbytypebutton.Click; 4: sortbyvaluebutton.Click; end; end; procedure TMainForm.HeaderControl1SectionResize( HeaderControl: THeaderControl; Section: THeaderSection); var x: integer; begin x:=(headercontrol1.Sections[headercontrol1.Sections.Count-1].Left+headercontrol1.Sections[headercontrol1.Sections.Count-1].Width); scrollbox1.HorzScrollBar.Range:=x; resizescreen; end; procedure TMainForm.FormDestroy(Sender: TObject); begin saveformposition(self,[ headercontrol1.Sections[0].Width, headercontrol1.Sections[1].Width, headercontrol1.Sections[2].Width, headercontrol1.Sections[3].Width, headercontrol1.Sections[4].Width, panel5.height, foundlist3.columns[0].width ]); end; procedure TMainForm.tbSpeedChange(Sender: TObject); var x: integer; y: single; begin x:=tbSpeed.position; case x of 0: y:=0; 1: y:=0.5; 2: y:=1; 3: y:=2; 4: y:=5; 5: y:=10; 6: y:=20; 7: y:=50; 8: y:=100; 9: y:=200; 10: y:=500; else y:=1; end; editSH2.text:=format('%.1f',[y]); end; procedure TMainForm.btnSetSpeedhack2Click(Sender: TObject); var newspeed: single; fs: Tformatsettings; error: boolean; begin error:=false; try newspeed:=StrToFloat(editsh2.Text); except GetLocaleFormatSettings(GetThreadLocale, fs); try newspeed:=StrToFloat(editsh2.Text, fs); except error:=true; end; end; if error or IsInfinite(newspeed) or IsNan(newspeed) then raise exception.Create(editSH2.text+' is not a valid speed'); if speedHack<>nil then speedhack.setSpeed(newspeed); end; procedure TMainForm.cbSpeedhackClick(Sender: TObject); begin if formsettings.cbOldSpeedhack.checked then begin cbfastscanclick(sender); exit; end; if cbSpeedhack.Checked then begin try if speedhack<>nil then freeandnil(speedhack); speedhack:=TSpeedhack.create; except on e: exception do begin cbSpeedhack.checked:=false; raise exception.create(e.Message); end; end; end else begin if speedhack<>nil then freeandnil(speedhack); end; panel14.Visible:=cbSpeedhack.Checked; end; procedure TMainForm.Edit2Change(Sender: TObject); begin editSH2.text:=edit2.text; end; {--------Processlist menuitem--------} var il: TImageList; procedure TMainForm.Process1Click(Sender: TObject); var sl: tstringlist; mi: array of TMenuItem; currentmi: TMenuItemExtra; i,j: integer; tempicon: graphics.TIcon; begin //fill with processlist if il=nil then il:=TImageList.Create(self); il.Clear; Menu.Images:=il; sl:=tstringlist.Create; try GetProcessList(sl); for i:=process1.Count-1 downto 3 do process1.Items[i].Free; setlength(mi,sl.count); for i:=0 to sl.count-1 do begin j:=sl.count-1-i; currentmi:=TMenuItemExtra.Create(self); currentmi.Caption:=sl[i]; currentmi.Default:=dword(sl.Objects[i])=ProcessID; currentmi.data:=pointer(PProcessListInfo(sl.Objects[i])^.processid); currentmi.OnClick:=ProcessItemClick; if PProcessListInfo(sl.Objects[i])^.processIcon>0 then begin tempicon:=graphics.TIcon.Create; tempicon.handle:=PProcessListInfo(sl.Objects[i])^.processIcon; il.AddIcon(tempicon); tempicon.Free; currentmi.ImageIndex:=il.Count-1; end else currentmi.ImageIndex:=-1; mi[j]:=currentmi; end; process1.Add(mi); finally for i:=0 to sl.Count-1 do if sl.Objects[i]<>nil then freemem(pointer(sl.Objects[i])); sl.free; end; end; procedure TMainForm.ProcessItemClick(Sender: TObject); var pid: dword; oldprocess: Dword; oldprocesshandle: thandle; oldprocessname: string; begin if openprocessPrologue then begin oldprocessname:=copy(mainform.ProcessLabel.Caption,pos('-',mainform.ProcessLabel.Caption)+1,length(mainform.ProcessLabel.Caption)); oldprocess:=processID; oldprocesshandle:=processhandle; if (sender is TMenuItemExtra) then begin pid:=dword(TMenuItemExtra(sender).data); unpause; DetachIfPossible; with TProcessWindow.Create(self) do begin pwop(inttohex(pid,8)); ProcessLabel.caption:=StripHotkey(TMenuItemExtra(sender).Caption); free; end; openprocessepilogue(oldprocessname,oldprocess,oldprocesshandle); end; end; end; {^^^^^^^^Processlist menuitem^^^^^^^^} procedure TMainForm.About1Click(Sender: TObject); begin About:=TAbout.create(self); About.showmodal; end; procedure TMainForm.CreateProcess1Click(Sender: TObject); var x: dword; oldprocess: Dword; oldprocesshandle: thandle; oldprocessname: string; begin if openprocessPrologue then begin oldprocessname:=copy(mainform.ProcessLabel.Caption,pos('-',mainform.ProcessLabel.Caption)+1,length(mainform.ProcessLabel.Caption)); oldprocess:=processID; oldprocesshandle:=processhandle; with TProcessWindow.Create(self) do begin button3.Click; free; end; if processid<>oldprocess then openprocessepilogue(oldprocessname,oldprocess,oldprocesshandle); end; end; procedure TMainForm.Helpindex1Click(Sender: TObject); begin Application.HelpContext(1); end; procedure TMainForm.New1Click(Sender: TObject); begin if MessageDlg('Are you sure you want to erase the data in the current table?',mtconfirmation, [mbyes,mbno],0)=mryes then clearlist; end; procedure TMainForm.ClearList; { Will remove all entries from the cheattable, comments, and advanced options window } begin Comments.Memo1.Clear; comments.Memo1.Lines.Add(strInfoAboutTable); Numberofrecords:=0; advancedoptions.codelist2.items.clear; advancedoptions.numberofcodes:=0; Updatescreen; Updatelist; end; procedure TMainForm.actScriptEngineExecute(Sender: TObject); begin with TfrmCScript.create(self) do show; end; procedure TMainForm.File1Click(Sender: TObject); begin menu.Images:=imagelist1; end; procedure TMainForm.Label61Click(Sender: TObject); var c: string; startvalue,stopvalue: dword; s: tstringlist; i: integer; plist:PPointerlist; begin if DBKDebug_WaitForDebugEvent(1000) then begin DBKDebug_ContinueDebugEvent(false); end else showmessage('timeout'); end; procedure TMainForm.actOpenProcesslistExecute(Sender: TObject); begin speedbutton1.Click; end; procedure TMainForm.Panel5Resize(Sender: TObject); begin speedbutton3.top:=foundlist3.top+foundlist3.height-speedbutton3.Height; speedbutton3.left:=foundlist3.left+foundlist3.width+2; end; procedure TMainForm.Foundlist3Resize(Sender: TObject); begin beep; end; initialization end.