diff --git a/README.md b/README.md index 6e18155..a41ce6b 100644 --- a/README.md +++ b/README.md @@ -4,26 +4,21 @@ XDK Assist is an application designed to allow you to easily communicate with an The original XDK Assist was originally closed source software. It was a product of me being on the original EvolutionX team and creating custom tools for our work. It eventually evolved into something more robust and I released it to the public as-is. A few updates were released, but the project never had an official homepage or source of truth for downloads. -# Why release the code so late? - -I recently saw that some people are still using XDK Assist today even though it's been almost two decades since the original Xbox was released. Two decades ago I was a much different developer and wasn't so open to open sourcing my programs. Today, however, I'm all for it. I'm hoping release of this code might benefit the few folks out there who still use it. At a minimum it at least helps to preserve what I consider an important part of the Xbox homebrew scene. +## How is this branch different? -## Not so fast... +The `2.x-dev` branch is different than the `master` branch in that it contains an unreleased version of XDK Assist. This version was a rewrite of the application to be more streamlined, faster, more stable, and remove a lot of cruft. Development of this version was never completed. It compiles and will run, but I do not remember what features were implemented beyond just having a UI. It doesn't look like the dump button is wired up, so functionality of this version is extremely limited. It's included for posterity. -There are, however, some caveats. I was also a much (much) more junior developer two decades ago and did not use proper source control systems. Shoot, two decades ago I wasn't much of a developer at all. In the codebase you'll find a lack of decent commenting, organization, naming, etc. You'll also find lines of functional code commented out with no explanation as to why. - -This release of the code is also compiled from multiple backups. I've attempted to pull in the latest changes from each backup, but it's entirely possible I've missed something or pulled out a vital component. +# Why release the code so late? -Given the above items it's possible this application actually does not work. I have no way to test that this application still works as expected, since it requires an original Xbox a running debug bios. It will compile and run as expected, but there are things I simply cannot review. For example, `TBreakpoint` is commented out in `XBOXManager.pas` and is present in `Breakpoint.pas`. Was that a refactor in progress? Did I finish? Who knows. +I recently saw that some people are still using XDK Assist today even though it's been almost two decades since the original Xbox was released. Two decades ago I was a much different developer and wasn't so open to open sourcing my programs. Today, however, I'm all for it. I'm hoping release of this code might benefit the few folks out there who still use it. At a minimum it at least helps to preserve what I consider an important part of the Xbox homebrew scene. # Requirements * Delphi 2007 * Indy 10.1.1 -* TMPHexEditor (bundled: hexcontrol) * A modded original Xbox with a debug bios loaded (i.e. EvoX) -I was able to get this to compile again under Delphi 2007 with Indy 10 that ships with Delphi 2007. It also requires installation of a TMPHexEditor component (bundled with) from Markus Stephany (). You can find a newer version of this component, but it is not tested. You may be able to get it to compile with different versions of Delphi or Indy, but those are untested as well. +I was able to get this to compile again under Delphi 2007 with Indy 10 that ships with Delphi 2007. You may be able to get it to compile with different versions of Delphi or Indy, but those are untested as well. # Shoutouts diff --git a/XDKAssist.dpr b/XDKAssist.dpr index 589ee99..04e4589 100644 --- a/XDKAssist.dpr +++ b/XDKAssist.dpr @@ -1,25 +1,29 @@ program XDKAssist; +{%ToDo 'XDKAssist.todo'} + uses Forms, Dialogs, SysUtils, - Main in 'src\Main.pas' {frmMain}, - Breakpoint in 'src\Breakpoint.pas', - LogStream in 'src\LogStream.pas', - Tool in 'src\Tool.pas', - Settings in 'src\Settings.pas', - AppGlobal in 'src\AppGlobal.pas', - XBOXManager in 'src\XBOXManager.pas'; + MainForm in 'src\MainForm.pas' {frmMain}, + CXboxManager in 'src\CXboxManager.pas', + CXMemoryManager in 'src\CXMemoryManager.pas', + CXBreakpointManager in 'src\CXBreakpointManager.pas', + Global in 'src\Global.pas', + Log in 'src\Log.pas', + AppStrings in 'src\AppStrings.pas'; + +{$E exe} {$R *.res} begin Application.Initialize; - Application.Title := 'XDK Assist'; + Application.Title := 'XDK Assist v2'; try Application.CreateForm(TfrmMain, frmMain); - Application.Run; + Application.Run; except on E: Exception do ShowMessage(E.Message); end; diff --git a/XDKAssist.dproj b/XDKAssist.dproj index 4ac5f19..af9bda9 100644 --- a/XDKAssist.dproj +++ b/XDKAssist.dproj @@ -1,24 +1,22 @@  - {bafd21de-c786-409f-87d5-f9f2162c20e4} + {5f6ecf7c-8be1-412e-b91f-a6378dc92d81} XDKAssist.dpr Debug AnyCPU DCC32 build\debug\bin\XDKAssist.exe - true - vcl;rtl;vclx;vclactnband;dbrtl;bdertl;dsnap;teeUI;teedb;tee;adortl;IndyCore;IndySystem;IndyProtocols;xmlrtl;inet;IntrawebDB_90_100;Intraweb_90_100;vclie;inetdbbde;inetdbxpress;soaprtl;VclSmp;MPHexEditor_D7;vcldb 7.0 + True False False + True + True + True 0 - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug RELEASE build\release\bin build\release @@ -28,11 +26,12 @@ 7.0 - 2 - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug - $(BDS)\Lib\Debug\Indy10;$(BDS)\lib\Debug + True + True + True + True + True + True DEBUG build\debug\bin build\debug @@ -44,17 +43,7 @@ Delphi.Personality -FalseTrueFalseTrueFalse0017FalseFalseTrueFalseFalse103312520.0.1.71.0.0.0EvoX-TPrivate EvoX-T training toolXDK AssistRushed public release - - - - - - - - - - +FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse103312521.0.0.01.0.0.0XDKAssist.dpr @@ -75,22 +64,23 @@ Microsoft Office 2000 Sample Automation Server Wrapper Components Microsoft Office XP Sample Automation Server Wrapper Components - XDKAssist.dprFalse + + MainSource - - - - + + + + + + +
frmMain
 - - - \ No newline at end of file diff --git a/XDKAssist.res b/XDKAssist.res index 839a791..a6743cb 100644 Binary files a/XDKAssist.res and b/XDKAssist.res differ diff --git a/XDKAssist.todo b/XDKAssist.todo index a355521..139597f 100644 --- a/XDKAssist.todo +++ b/XDKAssist.todo @@ -1,19 +1,2 @@ -{TODO : Display percentage complete on progress bars} -{TODO : For color logging have a rich it up function} -{TODO : Fix disconnection tracking (linked with status checking?)} -{TODO : Command queuing with response checking} -{TODO -cLayout : Better status bar information (program status and what not)} -{DONE -cLayout : Show and hide the main log. Have another log visible by a tabbed window} -{TODO : Possible disassembly view?} -{TODO : have a register compare option} -{TODO : Keep complete breakpoint history with times and registers: list box that when you click it it changes the register information} -{TODO : go through each function and make a list of what you don't like, then go back later and fix all the stuff} -{TODO : Eat messages option will eat common messages like 200- ok and n: execution stopped} -{TODO : Cut out 66% ram usage by reworking buffer stuff. Wait until other changes are in, so you can easily fix any speed issues} -{TODO -cLayout : Redesign log area - show xbox logo faintly behind text, outline the input box, add coloring} -{TODO : Solidify status changes and checking of status} -{TODO : Internal tools editor} -{TODO -cLayout : Redesign register window and breakpoint area} -{TODO -cControls : THistoryBox - contains a 20 string list of previously entered text} -{TODO -cControls : TMPHexEdit - rewrite to allow direct memory access to buffer - or - focus buffer elswhere} -{TODO -cControls : THexBox - accepts only valid hexadecimal input. Features the ability to validate pastes, accept or rject different styles of notation ($,h,0x) and force capitals or zero fills} + + diff --git a/docs/README.md b/docs/README.md deleted file mode 100644 index c7a37b4..0000000 --- a/docs/README.md +++ /dev/null @@ -1,11 +0,0 @@ -# What's in this folder? - -This folder contains some documents I had that were related to XDK Assist. I've included them for posterity, but they aren't of much use practically speaking. - -What_Hack0r_Complains_About_&_Wants.txt - At some point I polled Hack0r for a list of things he'd like to see improved in XDK Assist. This is that list. There's actually an unreleased XDK Assist v2 that began to implement some of these requests. - -xdkassist.ini - The INI file that was bundled with a copy of XDK Assist I had. It demonstrates the configuration for the Tools system, ArtMoney offsets, etc. - -xdkassist.notes - Notes from an unknown game I was debugging at some point. - -xdkcmds.txt - Several XDK commands that can be issued over Telnet. \ No newline at end of file diff --git a/docs/What_Hack0r_Complains_About_&_Wants.txt b/docs/What_Hack0r_Complains_About_&_Wants.txt deleted file mode 100644 index f22ed7e..0000000 --- a/docs/What_Hack0r_Complains_About_&_Wants.txt +++ /dev/null @@ -1,35 +0,0 @@ -What I have problems with: -- Breaking freezes game and I can't continue (most likely my bios) -- Poking (SETMEM) doesn't stick -- After 35-40 dumps, xbox freezes, won't complete dump -- Hex Memory View will go blank if I search for a wrong address or is out of range (have re-dump to see it again) - -What I'd like to see incorporated: -- A search/filter program (kind of like Art Money or Tsearch)... includes different searching/filtering of floats/Integers by 1,2,3,4,6,8,10 bytes; - Unknown values (increased (by), decreased (by), did not change) - Basically, figure out Art Money, then integrate it into XDKA (easier said then done, I know :P but it makes working a lot easier) -- Integrated Hex-Dec, Dec-Hex calculator (like Windows Calculator); Maybe include a base converter (32 bit, Intel) Basically Hexworkshop's base converter -- Maybe a visible buffer range in the Dumping Tag, for example: PC hex ranges: 2000000h-4000000h -- Customized dump button -- Automatic break point copy to Notes -- Change Xbox Logo -- Instead of the black background, maybe include a Evox-T logo in the background (something subtle so it doesn't overpower the text) -- Change logos next to "Dumping", "Notes"...etc to a more 3D look - -If your hardcore (if not void this), then here is my "asking for too much" category: -- Incorporate a picture dumping tool (takes picture of current screen) -- ASM file maker (I'm too lazy to make a new .txt and save it as .asm) -- Timestamp/Title ID displayer (searches through XBE to find it) -- Incorporate Caustic's XBE-EXE converter - -What I want to stay: -- PC-Xbox Xbox-PC hex converter -- GETMEM -- The "HUD" of course (shows what's happening between PC and Xbox)(Connecting, dump...etc) -- All the tabs -- Dumping (obviously) - - -What I never understood: -- What the "Section Flags" does -- Memory View (kind of pointless) diff --git a/docs/xdkassist.ini b/docs/xdkassist.ini deleted file mode 100644 index 36bab83..0000000 --- a/docs/xdkassist.ini +++ /dev/null @@ -1,57 +0,0 @@ -[Connection] -Host=192.168.1.153 -Port=3000 - -[Dumping] -AutoStop=1 -AutoCopy=1 -Highlight=1 - -[Breakpoints] -Type=Read - -[Window] -Width=657 -Height=611 -LastTab=0 -State=0 - -[Tool0] -Name=bconv32.exe -Class= -Caption=Base Converter -Load=0 - -[Tool1] -Name=C:\Windows\System32\calc.exe -Class= -Caption=Calculator -Load=0 - -[Tool2] -Name=E:\Tools\ArtMoney 7.0.8 Pro\artmoney.exe -Class= -Caption=ArtMoney -Load=0 - -[Tool3] -Name=E:\Tools\tsearch\tsearch.exe -Class= -Caption=TSearch -Load=0 - -[Logging] -Verbose=0 - -[Range] -Enabled=0 -Start=0x005F6920 -End=0x005F6924 -Caption=ArtMoney -Class=TApplication -State=0x00B3F500 - -[Misc] -WarnConClose=1 -[Layout] -ShowMainLog=1 diff --git a/docs/xdkassist.notes b/docs/xdkassist.notes deleted file mode 100644 index edbd6e9..0000000 --- a/docs/xdkassist.notes +++ /dev/null @@ -1,44 +0,0 @@ -0x331cee - -life -0x83B22ADC -Breakpoint detected (write,0x83B22ADC,0x16A036). - -mana -83B22AE0 -83B1ED30 -Breakpoint detected (write,0x83B22AE0,0x15BC35). -Breakpoint detected (write,0x83B90100,0x164B48). - -Breakpoint detected (read,0x83B1E5C0,0x149DC9). -Breakpoint detected (read,0x83B1E5C0,0x149E69) -Breakpoint detected (read,0x83B1E5C0,0x164B38). -Breakpoint detected (read,0x83B1E5C0,0x164B48). - -165293- -1652d8 -1652d8 - - - -0016A02E health -0015BC2D cloak decrease -00165300 eb shoot when 0 -00156575 eb unlim items -00164B40 major -00164B82 minor -00146619 8b alarm - - -items - - -alarm -Breakpoint detected (write,0x48F9FC,0x146C34).always -Breakpoint detected (write,0x48F9FC,0x146C3E).always -Breakpoint detected (write,0x48F9FC,0x147611). -Breakpoint detected (write,0x48F9FC,0x14763D). - - -spear -Breakpoint detected (write,0x83B23E04,0x15657F). \ No newline at end of file diff --git a/docs/xdkcmds.txt b/docs/xdkcmds.txt deleted file mode 100644 index 6d624d9..0000000 --- a/docs/xdkcmds.txt +++ /dev/null @@ -1,172 +0,0 @@ -XDK Telnet Command List by ddh - -Most of this information should be correct. My memory is a little fuzzy about some of the commands I didn't spend much time looking in to. - -Info: - -The game is usually, if not always, thread 28. -More information is available by using the NOTIFYAT command. - -Commands: - -MODULES - Lists current modules - -MODSECTIONS NAME="" - Returns section details about specified module inside of quotes. Use the name from the MODULES command. - -BYE - Disconnect - -REBOOT STOP|WAIT (WARM) (NODEBUG) - Reboots the xbox with the selected reboot style. - -GETMEM ADDR= LENGTH= - Dumps memory in ASCII format. Addr and length can be either hex that is prefixed with 0x, or decimal. - -GETMEM2 ADDR= LENGTH= - Same as GETMEM, only this dumps the memory in binary. It is much faster. - -DEBUGGER CONNECT|DISCONNECT - Informs the XDK that you are a connecting debugger - -ISDEBUGGER - Lets the XDK know that you are a debugger - -GETPID - Returns pid - -THREADS - Returns a thread list - -THREADINFO THREAD= - Returns information about the specified thread. Use the thread number returned by the threads command. - -HALT (THREAD=) - Stops the specified thread, or the default one if no thread is specified - -GO - Tells the xbox to continue running after a STOP. - -CONTINUE THREAD= (EXCEPTION) - Tells the xbox to continue running the specified thread. Used in conjunction with GO. - -WALKMEM - Returns all valid memory sections for the xbox. Use in conjunction with getmem2 for easy mem dumping. - -STOPON (CREATETHREAD|FCE) - Specifies some events that the XDK should stop on. - -ISSTOPPED THREAD= - Checks if the specified thread is stopped or not. - -NOTIFYAT PORT= (DROP) (DEBUG) - Tells the xbox to send more information to you on the specified port. Add the drop when you are done listening (i.e. disconnecting). - -GETEXTCONTEXT THREAD= (CONTROL) (INT) (FP) - Gets context details about the specified thread. This returns binary information. - -BREAK (READ|WRITE|EXECUTE)=0x SIZE= (CLEAR) -BREAK ADDR=0x SIZE= - Sets and clears a breakpoint. You can specify the type of breakpoint, the starting address, and the size of the area you want monitored. Append the CLEAR command to the set string. - -XBEINFO (RUNNING|NAME="") - Returns the timestamp, checksum, and name of the specified XBE. - -DEBUGNAME - Get the name of the running XBOX - -PCLIST - Returns performance information about the XBOX - -QUERYPC NAME=\"%s\" TYPE=0x%08x - Returns specific information about an item spat out by PCLISt - -GPUCOUNT ENABLE|DISABLE - Enable or disable GPU count - -magicboot title="" (DEBUG) - Reboots the system and launches the named xbe - - -ISBREAK ADDR=0x - - - -RESUME THREAD= -SUSPEND THREAD= -SETCONTEXT THREAD= -GETCONTEXT THREAD= (CONTROL|INT|FP) -MODLONG NAME= -BOXID -NONCE -AUTHUSER ADMIN RESP=0q%08x%08x -AUTHUSER NAME=\"%s\" PASSWD=0q%08x%08x -SETUSERPRIV NAME=\"%s\" -GETUSERPRIV NAME=\"%s\" -GETUSERPRIV ME -USER NAME=\"%s\" -USER NAME=\"%s\" REMOVE -USERLIST -ADMINPW NONE -ADMINPW PASSWD=0q%08x%08x -LOCKMODE UNLOCK -LOCKMODE BOXID=0q%08x%08x -SYSTIME -setsystime clockhi=0x%08x clocklo=0x%08x -SENDFILE NAME=\"%s\" LENGTH=0x%x -GETFILE NAME=\"%s\" -GETFILEATTRIBUTES NAME=\"%s\" -SETFILEATTRIBUTES NAME=\"%s\"" " CREATEHI=0x%08x CREATELO=0x%08x CHANGEHI=0x%08x CHANGELO=0x%08x (READONLY=%d HIDDEN=%d) -MKDIR NAME=\"%s\" -RENAME NAME=\"%s\" NEWNAME=\"%s\" -DELETE NAME=\"%s\" (DIR) -DIRLIST NAME=\"%s\" -ALTADDR -DEDICATE HANDLER=%s -DEDICATE GLOBAL -XTLINFO -SUSPEND THREAD=%d -RESUME THREAD=%d -BREAK START -FUNCCALL THREAD=%lu -CAPCONTROL %s -TITLE NAME="" DIR="" CMDLINE="" -DRIVELIST -DRIVEFREESPACE NAME=\"%s\" -screenshot -PSSnap x=%d y=%d flags=%d marker=%d -VSSnap first=%d last=%d flags=%d marker=%d -XBOXIP -mmglobal -STOPON CREATETHREAD|FCE|DEBUGSTR -NOSTOPON CREATETHREAD|FCE|DEBUGSTR -SETCONFIG INDEX=0x%08x VALUE=0x%08x - - - - -SETCONTEXT -THREAD=28 Esp=0 -xd0032adc Ebp=0x -d0032ba0 Eip=0x8 -001c19f EFlags=0 -x202 Eax=0x8004a -c01 Ebx=0x8004ac - -0000: 53 45 54 43 4F 4E 54 45 58 54 20 54 48 52 45 41 SETCONTEXT THREA -0010: 44 3D 32 38 20 45 73 70 3D 30 78 64 30 30 33 32 D=28 Esp=0xd0032 -0020: 63 31 34 20 45 62 70 3D 30 78 31 63 65 30 30 36 c14 Ebp=0x1ce006 -0030: 30 20 45 69 70 3D 30 78 38 30 30 31 63 31 39 66 0 Eip=0x8001c19f -0040: 20 45 46 6C 61 67 73 3D 30 78 32 30 32 20 45 61 EFlags=0x202 Ea -0050: 78 3D 30 78 38 30 30 34 61 63 30 31 20 45 62 78 x=0x8004ac01 Ebx -0060: 3D 30 78 38 30 30 34 61 63 38 63 20 45 63 78 3D =0x8004ac8c Ecx= -0070: 30 78 30 20 45 64 78 3D 30 78 62 30 30 63 62 64 0x0 Edx=0xb00cbd -0080: 63 38 20 45 73 69 3D 30 78 38 30 30 31 62 65 35 c8 Esi=0x8001be5 -0090: 31 20 45 64 69 3D 30 78 62 30 30 32 36 39 37 37 1 Edi=0xb0026977 -00A0: 20 43 72 30 4E 70 78 53 74 61 74 65 3D 30 78 30 Cr0NpxState=0x0 -00B0: 20 65 78 74 3D 32 38 38 0D 0A 54 F1 58 00 C2 00 ext=288..T.X... - -0000: 67 65 74 64 33 64 73 74 61 74 65 20 73 69 7A 65 getd3dstate size -0010: 3D 31 31 38 30 0D 0A 00 00 00 CA 00 00 00 00 00 =1180........... - diff --git a/hexcontrol/Delphi-7/MPHexEditor_D7.dpk b/hexcontrol/Delphi-7/MPHexEditor_D7.dpk deleted file mode 100644 index 280abf2..0000000 --- a/hexcontrol/Delphi-7/MPHexEditor_D7.dpk +++ /dev/null @@ -1,38 +0,0 @@ -package MPHexEditor_D7; - -{$R *.res} -{$R '..\MPHexEditorReg.dcr'} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'mirkes.de HexEditor vcl'} -{$IMPLICITBUILD OFF} - -requires - rtl, - designide; - -contains - MPHexEditorReg in '..\MPHexEditorReg.pas', - MPHexEditor in '..\MPHexEditor.pas', - MPHexEditorEx in '..\MPHexEditorEx.pas'; - -end. diff --git a/hexcontrol/Delphi-7/MPHexEditor_D7.res b/hexcontrol/Delphi-7/MPHexEditor_D7.res deleted file mode 100644 index b111060..0000000 Binary files a/hexcontrol/Delphi-7/MPHexEditor_D7.res and /dev/null differ diff --git a/hexcontrol/MPDELVER.INC b/hexcontrol/MPDELVER.INC deleted file mode 100644 index fb91958..0000000 --- a/hexcontrol/MPDELVER.INC +++ /dev/null @@ -1,100 +0,0 @@ -{$IFDEF VER80} - ERROR Delphi 1 not supported! -{$ENDIF} -{$IFDEF VER90} - {$DEFINE DELPHI} - {$DEFINE DELPHI2} - {$DEFINE DELPHI2UP} -{$ENDIF} -{$IFDEF VER93} - {$DEFINE BCB} - {$DEFINE BCB1} - {$DEFINE DELPHI2UP} -{$ENDIF} -{$IFDEF VER100} - {$DEFINE DELPHI} - {$DEFINE DELPHI3} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} -{$ENDIF} -{$IFDEF VER110} - {$DEFINE BCB} - {$DEFINE BCB3} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} -{$ENDIF} -{$IFDEF VER120} - {$DEFINE DELPHI} - {$DEFINE DELPHI4} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} -{$ENDIF} -{$IFDEF VER125} - {$DEFINE BCB} - {$DEFINE BCB4} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} -{$ENDIF} -{$IFDEF VER130} - {$IFNDEF BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHI5} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$ELSE} - {$DEFINE BCB} - {$DEFINE BCB5} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$ENDIF} -{$ENDIF} -{$IFDEF VER140} - {$IFNDEF BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHI6} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$DEFINE DELPHI6UP} - {$ELSE} - {$DEFINE BCB} - {$DEFINE BCB6} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$DEFINE DELPHI6UP} - {$ENDIF} -{$ENDIF} -{$IFDEF VER150} - {$IFNDEF BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHI7} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$DEFINE DELPHI6UP} - {$DEFINE DELPHI7UP} - {$ELSE} - {$DEFINE BCB} - {$DEFINE BCB7} - {$DEFINE DELPHI2UP} - {$DEFINE DELPHI3UP} - {$DEFINE DELPHI4UP} - {$DEFINE DELPHI5UP} - {$DEFINE DELPHI6UP} - {$DEFINE DELPHI7UP} - {$ENDIF} -{$ENDIF} -{$IFDEF DELPHI4UP} - {$DEFINE DYNARRAY} -{$ENDIF} - diff --git a/hexcontrol/MPHexEditor.RES b/hexcontrol/MPHexEditor.RES deleted file mode 100644 index 3759589..0000000 Binary files a/hexcontrol/MPHexEditor.RES and /dev/null differ diff --git a/hexcontrol/MPHexEditor.chm b/hexcontrol/MPHexEditor.chm deleted file mode 100644 index 6a73194..0000000 Binary files a/hexcontrol/MPHexEditor.chm and /dev/null differ diff --git a/hexcontrol/MPHexEditorReg.dcr b/hexcontrol/MPHexEditorReg.dcr deleted file mode 100644 index 28cffa9..0000000 Binary files a/hexcontrol/MPHexEditorReg.dcr and /dev/null differ diff --git a/hexcontrol/hexeditor.html b/hexcontrol/hexeditor.html deleted file mode 100644 index bf31d26..0000000 --- a/hexcontrol/hexeditor.html +++ /dev/null @@ -1,690 +0,0 @@ - - - - - - - TMPHexEditor/TMPHexEditorEx readme - - - - - - - - - - -

TMPHexEditor/TMPHexEditorEx components by mirkes.de

- -

TMPHexEditor is a TCustomGrid descendant to view and - edit binary files in hexadecimal and textual format.

- -

TMPHexEditorEx is an advanced hex editor, is supports - OLE drag and drop, printing, print preview and more.

- -
- top -
- -

contents:

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
version: -   version of the package
target: -   supported borland ides
sources: -   status of the sourcecode
history: -   version history of the package
installation:   how to - install the package
usage: -   how to use the package
contact: -   how to contact the author of the package
license: -   license of the package
- -
- top -
- -

version:

- -

version 12-29-2004, released december 29, 2004

- -
- top -
- -

target:

- -

the package has been tested and should work in - Borland Delphi 4, 6 and 7 and C++ Builder 6.

- -
- top -
- -

sources:

- -

the component sources are included in the package.

- -
- top -
- -

history:

- -

version 12-29-2004: december 29, 2004

- -
    -
  • initialized Result to '' in some string functions/methods to avoid non empty Result vars - at function startup due to compiler optimizations (particularly on d4), e.g. printing did not - work correctly under d4
    • -
  • updated some of the sample projects (fixed the broken bcb6 sample, added printing to the - hex viewer and the bcb6 editor sample)
    • -
- -

version 12-28-2004: december 28, 2004

- -
    -
  • changed the progress event calling part in Find and FindWithWildcard to avoid a - division by zero error when working on files < 500 bytes
    • -
- -

version 12-21-2004: december 21, 2004

- -
    -
  • changed PrepareFindReplaceData method to avoid an exception when - the string parameter is empty
    • -
  • TMPHexEditorEx: support for CF_HTML clipboard format
    • -
- -

version 11-12-2004: november 12, 2004

- -
    -
  • changed mouse selection in insert mode, now it's more text editor-like
    • -
  • Undo and Redo disabled when ReadonlyView is True
    • -
  • TMPHexEditorEx: ole drag and drop move operation is now disabled if the editor's - ReadOnlyView property is set to True
    • -
  • some small other modifications
    • -
- -

version 10-26-2004: october 26, 2004

- -
    -
  • fixed a typecasting bug in the Undo method (integer overflow)
    • -
  • added some utility functions for unsigned int64 arithmetics (AddU64, TryAddU64, SubtractU64, TrySubtractU64, MultiplyU64, TryMultiplyU64, DivideU64, TryDivideU64, ModuloU64, TryModuloU64)
    • -
- -

version 08-29-2004: august 29, 2004

- -
    -
  • added ActiveFieldBackground color property
    • -
  • added print flag pfIncludeRuler in TMPHexEditorEx
    • -
- -

version 08-14-2004: august 14, 2004

- -
    -
  • the caret was not set properly when switching from - hex to char pane if no data was in the editor
    • -
  • MaskedChars property added
    • -
  • changed printing in TMPHexEditorEx (color handling, pfSelectionBold meaning)
    • -
- -

version 06-15-2004: june 15, 2004

- -
    -
  • added DrawDataPosition and IsDrawDataSelected - properties
    • - -
  • changes in drawing/invalidating to avoid unnecessary - painting
    • - -
  • OnMouseDown is now called also if offset pane or ruler - are clicked
    • - -
  • if BytesPerUnit is changed, the selection is reset if - (SelCount mod BytesPerUnit) <> 0
    • -
- -

version 06-10-2004: june 10, 2004

- - - -

version 06-07-2004: june 07, 2004

- -
    -
  • fixed a crash ("Grid index out of range") when switching - from unicode
    • - -
  • SyncView method modified to be able to synchronize the - view of editors with different data sizes/layouts, also with - offset
    • - -
  • on changing TopRow/LeftCol the caret is - repositionned
    • - -
  • overwritten mouse wheel handling to allow page - scrolling
    • - -
  • manual handling of MaskChar property streaming due to bug - reports ("Invalid Property Value")
    • -
- -

version 05-30-2004: may 30, 2004

- -
    -
  • fixed broken CanOpenFile routine (files were always - marked read-only)
    • -
- -

version 05-27-2004: may 27, 2004

- -
    -
  • added IsMaxOffset property
    • - -
  • the control gets focused when the mouse is clicked even - when the mouse is over the selection
    • -
- -

version 05-13-2004: may 13, 2004

- -
    -
  • OnDrawCell is now also called for the top left cell
    • - -
  • setting UnicodeChars to False now correctly sets - BytesPerUnit to 1
    • -
- -

version 04-18-2004: april 18, 2004

- -
    -
  • parameters aBuffer and bBuffer were interchanged in the - CopyMemory call in TranslateBufferFromAnsi
    • - -
  • GetOffsetString can now be called in OnGetOffsetText - without crashing (infinite recursion = stack overflow)
    • -
- -

version 01-08-2004: january 08, 2004

- -
    -
  • added some explicit pointer typecasts for {$T+} - compatibility
    • - -
  • removed FindTable and FindTableI properties under BCB - (BCB doesn't like array properties)
    • -
- -

version 12-16-2003: december 16, 2003

- -
    -
  • setting the DataSize property is now undoable
    • - -
  • added the public SetDataSizeFillByte property to be able - to control what byte is used to enlarge the data
    • - -
  • now checking NoSizeChange before allowing to set - DataSize
    • - -
  • CreateUndo is no longer a function, but a procedure. now - an exception is raised when no undo record can be - created
    • -
- -

version 12-10-2003: december 10, 2003

- -
    -
  • renamed OnLoadSaveProgress to OnProgress
    • - -
  • added property FindProgress
    • - -
  • added custom find methods OnFind, OnWildcardFind
    • - -
  • Find and FindWithWildcard speeded up by using precompiled - character tables
    • - -
  • Find and FindWithWildcard now also fire the OnProgress - event if FindProgress is set to true
    • - -
  • fixed a bug in mouse handling (weird selection or line - offsets when doublecklicking ruler bar/offset panel)
    • - -
  • modified selection code to better support double byte - selection (unicode)
    • -
- -

version 09-24-2003: september 24, 2003

- -
    -
  • modified the BCB6 package
    • -
- -

version 09-09-2003: september 09, 2003

- -
    -
  • changed some constants, classes and types from MPTH... to - MPH...
    • - -
  • changed MPHCustTransFieldFrom/To to - MPHCustomCharConv
    • - -
  • BytesPerBlock and SeparateBlocksInCharField - propertíes added
    • - -
  • DataSize property is writeable now
    • - -
  • Page down key now also reaches the last row
    • - -
  • added OnGetOffsetText property
    • - -
  • added AddSelectionUndo procedure
    • - -
  • added defines for delphi7, renamed delver.inc to - mpdelver.inc
    • - -
  • added wildcard search (FindWithWildcard)
    • - -
  • added SeekToEOF
    • - -
  • changed keyboard handling, so OnKeyDown should work - better
    • - -
  • added GotoBookmark method to set cursor to a bookmarked - position
    • - -
  • added OnBookmarkChanged property
    • - -
  • support for unsigned int64 radix conversions
    • - -
  • Replace method added
    • -
- -

version 07-05-2003: july 05, 2003

- -
    -
  • better handling of odd sized files when BytesPerUnit - <> 1
    • - -
  • added support for pasting clipboard data in fixed - filesize mode in TMPHexEditorEx
    • - -
  • added RegEdit_HexData clipboard support in - TMPHexEditorEx
    • -
- -

version 05-25-2003-b: may 25, 2003

- -
    -
  • fixed a bug (moving the cursor beyond eof)
    • -
- -

version 05-25-2003: may 25, 2003

- -
    -
  • added some kind of ownerdraw (see OnDrawCell)
    • - -
  • no ':' is printed when offset display is not used
    • - -
  • added hpp generating statements for bcb - compatibility
    • -
- -

version 05-20-2003: may 20, 2003

- -
    -
  • renamed, added and changed some methods, classes and - properties
    • - -
  • fixed some bugs in the ruler display (e.g. when - BytesPerRow is changed)
    • - -
  • fixed some bugs when BytesPerUnit <> 1
    • - -
  • added some unicode support (UnicodeChars and - UnicodeBigEndian)
    • - -
  • fixed some half byte (nibble) related bugs
    • -
- -

version 05-17-2003: may 17, 2003

- -
    -
  • added DisplayStart and DisplayEnd functions to retrieve - the data bounds currently displayed
    • - -
  • added BytesPerUnit and RulerBytesPerUnit properties to - treat words/dwords/qwords as a unit
    • - -
  • added SyncView procedure and OnSelectionChanged property - to synchronize position and selection with another - editor
    • - -
  • added ShowPositionIfNotFocused property to show the - current position if the editor is not focused
    • - -
  • corrected bottom margin handling when printing
    • - -
  • corrected upper/lowercase hex chars in printing
    • - -
  • the current unit is selected now when doubleclicking - data
    • - -
  • added flags pfCurrentViewOnly (just print the currently - visible data) to PrintOptions.Flags
    • -
- -

version 10-25-2002: october 25, 2002

- -
    -
  • corrected the BytesPerColumn default value
    • -
- -

version 08-18-2002: august 18, 2002

- -
    -
  • modified painting and selection
    • - -
  • implemented an additional ruler bar at the top
    • - -
  • new properties: ShowRuler, DrawGutter3D
    • -
- -

version 08-12-2002: august 12, 2002

- -
    -
  • modified Changed calls to get correct Modified property - in OnChange handler
    • -
- -

version 08-09-2002: august 09, 2002

- -
    -
  • included missing include file delver.inc
    • - -
  • added OnChange event
    • -
- -

version 07-21-2002: july 21, 2002

- -

too many changes to mention here (completely rewritten, - basic and advanced versions TMPHexEditor and TMPHexEditorEx), - please read the documentation included with this package for - more information

- -
- top -
- -

v 1.16: 02/02/99

- -
    -
  • added WMGetDlgCode to avoid problems with - shortcut-controls on the form
    • - -
  • changed the property name ReadOnly to ReadOnlyFile ( to - avoid confusion, sorry )
    • - -
  • fixed updating when the font gets changed
    • - -
  • added OnKeyPress-support ( now you can modify the key - before THexEditor will parse it in this event )
    • - -
  • property WantTabs : Boolean ; if true, you can navigate - between char and hex field with the TAB key, if false, you - can navigate between your form's controls with the TAB key, - to change the current field in THexEditor, you have to use - CTRL+T.
    • - -
  • property ReadOnlyView : Boolean ; if true, than the - text/data in THexEditor can't get edited via key presses, - just selection , moving and scrolling are still - available
    • -
- -

v 1.15: 01/03/99

- -
    -
  • added option odOctal to TOffsetDisplayStyle to display - line offset in octal system ("8"-based)
    • - -
  • fixed a problem on creating a THexEditor dynamically ( - thanks to John Shailes , JohnShailes _at_ email.msn.com - )
    • - -
  • property AllowInsertMode : Boolean ; if this is set to - true, THexEditor doesn't overwrite but insert values at the - current cursor position ( this cannot be set if NoSizeChange - is True )
    • - -
  • property IsInsertMode : Boolean ; readonly, if it returns - true, the current mode is inserting (see above )
    • - -
  • property AutoCaretMode : Boolean ; if true, the caret - will be set to a block in overwrite mode and to a left line - in insert mode automatically
    • -
- -

v 1.14: not released

- -
    -
  • fixed some bugs
    • - -
  • added currently unsupported variable line lengths
    • - -
  • added NoSizeChange property
    • -
- -

v 1.13: 11/07/98

- -

added AsText and AsHex property ( and converting functions - for "aa00bb" style hex files ) , MaskWhiteSpaces property to - avoid the '.' if you have a font that can display chars from #0 - to #31; also typing capitals rather than lowercase chars in the - char field is now possible ( most of this stuff has been - suggested from Philippe Chessa , Philippe_Chessa _at_ - compuserve.com, thanks )

- -

v 1.12: 10/25/98

- -
    -
  • added Half Byte (Nibble) support (insert/delete, swap - hi/lo nibbles in hex view)
    • - -
  • better performance
    • - -
  • the markers are now available for reading/writing
    • - -
  • added support for some different code types in the char - view : ANSI , 8 Bit ASCII ( OEM / Dos style ) , 7 Bit ASCII , - Macintosh(TM) character set , IBM(TM) EBCDIC cp 038 also - conversion of the file's contents (or a range of them) from - one to another code type is possible (many thanks to - Christophe LE CORFEC, CLC _at_ khalif.com for ebcdic and half - byte suggestions)
    • -
- -

v 1.1 : 10/04/98

- -
    -
  • added find,seek, customizable layout (many thanks to John - Hamm, John _at_ TEMPUS.COM )
    • -
- -

v 1.0 Beta 1 : 08/15/98

- -
    -
  • first public release
    • -
- -
- top -
- -

installation:

- -
    -
  • Delphi 7: open, compile and install the package - MPHexEditor_D7.dpk under the vcl\Delphi-7 directory
    • - -
  • Delphi 6: open, compile and install the package - MPHexEditor_D6.dpk under the vcl\Delphi-6 directory
    • - -
  • Delphi 4: open, compile and install the package - MPHexEditor_D4.dpk under the vcl\Delphi-4 directory
    • - -
  • BCB 6: open, compile and install the package - MPHexEditor_BCB6.bpk under the vcl\BCB-6 directory
    • - -
  • others: copy all files under the \vcl subdir in a - directory contained in delphi's search path. add - MPHexEditorReg.pas to one of your library packages (e.g. - "Borland Delphi User Components") and recompile this package. - After successfull recompiling, the two components - TMPHexEditor and TMPHexEditorEx should be available on the - "mirkes.de" tab.
    • -
- -
- top -
- -

usage:

- -

read the help file included in this package (under the \doc - path).

- -
- top -
- -

contact:

- -

the author of this package is markus stephany, losheim am - see, saarland, germany.

- -

mailto:vcl[at]mirkes[dot]de - (change the obvious!)

- -

http://www.mirkes.de

- -
- top -
- -

license:

- 
-Copyright : © markus stephany, all rights reserved
-
-    This source code is freeware. You may use, change, and distribute without
-    charge the source code as you like. This unit can be used freely in any
-    commercial applications. However, it may not be sold as a standalone product
-    and the source code may not be included in a commercial product. This unit
-    is provided as is with no warrent or support. Make sure to read relevant
-    information and documentation from Microsoft before using this unit.
-
- -
- top -
- -

-end-

- - \ No newline at end of file diff --git a/hexcontrol/mphexeditor.pas b/hexcontrol/mphexeditor.pas deleted file mode 100644 index 6f4df94..0000000 --- a/hexcontrol/mphexeditor.pas +++ /dev/null @@ -1,8708 +0,0 @@ -(* - - TMPHexEditor v 12-29-2004
- - @author((C) markus stephany, merkes@mirkes.de, all rights reserved.) - @abstract(TMPHexEditor displays and edits binary files in hexadecimal notation) - @lastmod(12-29-2004) - - credits to :

- - John Hamm, http://users.snapjax.com/john/

- - - Christophe Le Corfec for introducing the EBCDIC format and the nice idea about - half byte insert/delete

- - - Philippe Chessa for his suggestions about AsText, AsHex and better support for - the french keyboard layout

- - - Daniel Jensen for octal offset display and the INS-key recognition stuff

- - - Shmuel Zeigerman for introducing more flexible offset display formats

- - - Vaf, http://carradio.al.ru for reporting missing delver.inc and suggesting OnChange

- - - Eugene Tarasov for reporting that setting the BytesPerColumn value to 4 at design - time didn't work

- - - FuseBurner for BytesPerUnit/RulerBytesPerUnit related suggestions

- - - Motzi for SyncView/ShowPositionIfNotFocused related suggestions

- - - Martin Hsiao for bcb compatibility and reporting some bugs when moving cursor beyond eof

- - - Miyu for delphi 7 defines

- - - Nils Hoyer for bcb testing and his help on creating a BCB6 package

- - - Skamnitsly S.V for reporting a bug when doubleclicking the ruler bar

- - - Pete Fraser for reporting problems with array properties under BCB

- - - Andrew Novikov for bug reports and suggestions

- - - Al for bug reports

- - - Dieter Köhler for reporting the delphi vcl related CanFocus bug

- - - Piotr Likus for reporting a cardinal<->integer related bug in the Undo method

- - - Marc Girod for bug reports

- -

history:

-

    -
  • v 12-29-2004: december 29, 2004

    - - initialized Result to '' in some string functions/methods to avoid - non empty Result vars at function startup due to compiler - optimizations (particularly on d4), e.g. printing did not work - correctly under d4
    - - updated some of the sample projects (fixed the broken bcb6 sample, - added printing to the hex viewer and the bcb6 editor sample)

    • - -
  • v 12-28-2004: december 28, 2004

    - - changed the progress event calling part in @link(Find) and - @link(FindWithWildcard) to avoid a division by zero error when working - on files < 500 bytes

    • - -
  • v 12-21-2004: december 21, 2004

    - - changed @link(PrepareFindReplaceData) to avoid an exception when - the string parameter is empty

    • - -
  • v 11-12-2004: november 12, 2004

    - - changed mouse selection in insert mode, now it's more text - editor-like
    - - @link(Undo) and @link(Redo) disabled when @link(ReadonlyView) - is True
    - - some small other modifications
    -

    • - -
  • v 10-26-2004: october 26, 2004

    - - fixed a typecasting bug in the Undo method (integer overflow)
    - - added some utility functions for unsigned int64 arithmetics (@link(AddU64), @link(TryAddU64), - @link(SubtractU64), @link(TrySubtractU64), @link(MultiplyU64), @link(TryMultiplyU64), - @link(DivideU64), @link(TryDivideU64), @link(ModuloU64), @link(TryModuloU64)) -

    • - -
  • v 08-29-2004: august 29, 2004

    - - Added @link(ActiveFieldBackground) color property

    • - -
  • v 08-14-2004: august 14, 2004

    - - the caret was not set properly when switching from - hex to char pane if no data was in the editor
    - - Added @link(MaskedChars) property

    • - -
  • v 06-15-2004: june 15, 2004

    - - Added @link(DrawDataPosition) and @link(IsDrawDataSelected) properties
    - - changes in drawing/invalidating to avoid unnecessary painting
    - - OnMouseDown is now called also if offset pane or ruler are clicked
    - - if @link(BytesPerUnit) is changed, the selection is reset - if (SelCount mod BytesPerUnit) <> 0
    - - if @link(CaretKind) is ckAuto, the caret is a bottom line if - @link(ReadOnlyView) is True

    • - -
  • v 06-10-2004: june 10, 2004

    - - added @link(RulerNumberBase) property
    - - overwritten CanFocus method due to vcl bug (see - - http://info.borland.com/devsupport/delphi/fixes/delphi4/vcl.html, - ref 279

    • - -
  • v 06-07-2004: june 07, 2004

    - - fixed a crash ("Grid index out of range") when switching from - unicode
    - - @link(SyncView) modified to be able to synchronize the view - of editors with different data sizes/layouts, also with offset
    - - on changing TopRow/LeftCol the caret is repositionned
    - - overwritten mouse wheel handling to allow page scrolling
    - - manual handling of MaskChar property streaming due to bug reports - ("Invalid Property Value")

    • - -
  • v 05-30-2004: may 30, 2004

    - - fixed broken CanOpenFile routine (files were always marked read-only)

    • - -
  • v 05-27-2004: may 27, 2004

    - - added @link(IsMaxOffset) property
    - - the control gets focused when the mouse is clicked even when - the mouse is over the selection

    • - -
  • v 05-13-2004: may 13, 2004

    - - @link(OnDrawCell) is now also called for the top left cell
    - - setting @link(UnicodeChars) to False now correctly sets - @link(BytesPerUnit) to 1

    • - -
  • v 04-18-2004: april 18, 2004

    - - parameters aBuffer and bBuffer were interchanged in the - CopyMemory call in @link(TranslateBufferFromAnsi)
    - - @link(GetOffsetString) can now be called in @link(OnGetOffsetText) - without crashing (infinite recursion = stack overflow)

    • - -
  • v 01-08-2004: january 08, 2004

    - - added some explicit pointer typecasts for {$T+} compatibility
    - - removed FindTable and FindTableI properties under BCB (doesn't - compile)

    • - -
  • v 12-16-2003: december 16, 2003

    - - Setting the @link(DataSize) property is now undoable
    - - Added the public @link(SetDataSizeFillByte) property to be able to control - what byte is used to enlarge the data
    - - Now checking @link(NoSizeChange) before allowing to set @link(DataSize)
    - - CreateUndo is no longer a function, but a procedure. Now an - exception is raised when no undo record can be created

    • - -
  • v 12-10-2003: december 10, 2003

    - - Renamed OnLoadSaveProgress to @link(OnProgress)
    - - Added property @link(FindProgress)
    - - Added custom find methods (@link(OnFind), @link(OnWildcardFind)
    - - @link(Find) and @link(FindWithWildcard) speeded up by using - precompiled character tables
    - - @link(Find) and @link(FindWithWildcard) now also fire the @link(OnProgress) event - if @link(FindProgress) is set to true
    - - fixed a bug in mouse handling (weird selection or line offsets when - doublecklicking ruler bar/offset panel)
    - - modified selectioncode to better support double byte selection (unicode)

    • - -
  • v 09-24-2003: september 24, 2003

    - - modified the BCB6 package

    • - -
  • v 09-09-2003: september 09, 2003

    - - changed some constants, classes and types from MPTH... to MPH...
    - - changed MPHCustTransFieldFrom/To to @link(MPHCustomCharConv)
    - - @link(BytesPerBlock) and @link(SeparateBlocksInCharField) properties added
    - - @link(DataSize) property is writeable now
    - - Page down key now also reaches the last row
    - - added @link(OnGetOffsetText) property
    - - added @link(AddSelectionUndo) procedure
    - - added defines for delphi7, renamed delver.inc to mpdelver.inc
    - - added wildcard search (@link(FindWithWildcard))
    - - added @link(SeekToEOF)
    - - changed keyboard handling, so OnKeyDown should work better
    - - added @link(GotoBookmark) method to set cursor to a bookmarked position
    - - added @link(OnBookmarkChanged) property
    - - support for unsigned int64 radix conversions
    - - @link(Replace) method added

    • - -
  • v 07-05-2003: july 05, 2003

    - - better handling of odd sized files when BytesPerUnit <> 1
    - - added support for pasting clipboard data in fixed filesize mode in @link(TMPHexEditorEx)
    - - added RegEdit_HexData clipboard support in @link(TMPHexEditorEx)

    • - -
  • v 05-25-2003-b: may 25, 2003

    - - fixed a bug (moving the cursor beyond eof)

    • - -
  • v 05-25-2003: may 25, 2003

    - - added some kind of ownerdraw (see @link(OnDrawCell))

    • - -
  • v 05-20-2003: may 20, 2003

    - - renamed, added and changed some methods, classes and properties
    - - fixed some bugs in the ruler display (e.g. when BytesPerRow is - changed)
    - - fixed some bugs when BytesPerUnit <> 1
    - - added some unicode support (@link(UnicodeChars) and - @link(UnicodeBigEndian))
    - - fixed some half byte (nibble) related bugs

    • - -
  • v 05-17-2003: may 17, 2003

    - - added @link(DisplayStart) and @link(DisplayEnd) functions to retrieve - the data bounds currently displayed
    - - added @link(BytesPerUnit) and @link(RulerBytesPerUnit) properties to - treat words/dwords/qwords as a unit
    - - added @link(SyncView) procedure and @link(OnSelectionChanged) - property to synchronize position and selection with another - editor
    - - added @link(ShowPositionIfNotFocused) property to show the current - position if the editor is not focused

    • - -
  • v 10-25-2002: october 25, 2002

    - - corrected the BytesPerColumn default value

    • - -
  • v 08-18-2002: august 18, 2002

    - - modified painting and selection
    - - implemented an additional ruler bar at the top
    - - new properties: @link(ShowRuler), @link(DrawGutter3D)

    • - -
  • v 08-12-2002: august 12, 2002

    - - modified Changed calls to get correct Modified property in - OnChange handler

    • - -
  • v 08-09-2002: august 09, 2002

    - - included missing include file delver.inc
    - - added OnChange event

    • - -
  • v 07-21-2002: july 21, 2002

    - too many changes to mention here (completely rewritten, basic and advanced versions - TMPHexEditor and TMPHexEditorEx), plz read the documentation included with this - package for more information
    • -

- -*) - -unit MPHexEditor; -{$R *.res} -{.$DEFINE TINYHEXER} // don't define this! -{$DEFINE FASTACCESS} // if this is defined, direct access to the stream memory is given - -(* define this if you want to have the old savetostream behaviour - (clear target stream before copying data). - if it is undef'd, do not clear the target stream - (just copy the editor data to the stream) *) -{.$DEFINE OLD_STREAM_OUT} - -{$IFNDEF PASDOC} -{$I MPDELVER.INC} -{$ELSE} - -{$ENDIF} - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, - Grids; - -type - // @exclude - TGridCoord = Grids.TGridCoord; - - // character conversion type - TMPHCharConvType = (cctFromAnsi, cctToAnsi); - // character conversion table - TMPHCharConvTable = array[0..255] of Char; - // character conversion data storage - TMPHCharConv = array[TMPHCharConvType] of TMPHCharConvTable; - -const - // block size in file i/o - MPH_FILEIO_BLOCKSIZE = $F000; - - // this message is posted to the hex editor when it should update the caret position - CM_INTUPDATECARET = CM_BASE + $100; - - // this message is posted when an OnSelectionChange event is to be fired - CM_SELECTIONCHANGED = CM_BASE + $101; - - (* translation tables from/to ms windows ansi (~ MS Latin-1) *) - - // macintosh..ms ansi conversion - MPH_CCONV_MAC: TMPHCharConv = ( - //ansi to mac - (#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, #$08, #$09, #$0A, #$0B, - #$0C, #$0D, #$0E, #$0F, - #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, #$18, #$19, #$1A, #$1B, - #$1C, #$1D, #$1E, #$1F, - #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, #$28, #$29, #$2A, #$2B, - #$2C, #$2D, #$2E, #$2F, - #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$3A, #$3B, - #$3C, #$3D, #$3E, #$3F, - #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$4A, #$4B, - #$4C, #$4D, #$4E, #$4F, - #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$5B, - #$5C, #$5D, #$5E, #$5F, - #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$6A, #$6B, - #$6C, #$6D, #$6E, #$6F, - #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, #$78, #$79, #$7A, #$7B, - #$7C, #$7D, #$7E, #$7F, - #$C4, #$C5, #$AB, #$C9, #$D1, #$F7, #$DC, #$E1, #$E0, #$E2, #$E4, #$E3, - #$AC, #$B0, #$AA, #$F8, - #$D5, #$CE, #$C3, #$CF, #$D3, #$D4, #$D2, #$DB, #$DA, #$DD, #$F6, #$F5, - #$FA, #$F9, #$FB, #$FC, - #$A0, #$C1, #$A2, #$A3, #$DF, #$B4, #$B6, #$A4, #$C6, #$A9, #$BB, #$C7, - #$C2, #$AD, #$A8, #$FF, - #$A1, #$B1, #$B2, #$B3, #$A5, #$B5, #$A6, #$B7, #$B8, #$B9, #$BC, #$C8, - #$BA, #$BD, #$CA, #$C0, - #$CB, #$E7, #$E5, #$CC, #$80, #$81, #$AE, #$82, #$E9, #$83, #$E6, #$E8, - #$ED, #$EA, #$EB, #$EC, - #$D0, #$84, #$F1, #$EE, #$EF, #$CD, #$85, #$D7, #$AF, #$F4, #$F2, #$F3, - #$86, #$D9, #$DE, #$A7, - #$88, #$87, #$89, #$8B, #$8A, #$8C, #$BE, #$8D, #$8F, #$8E, #$90, #$91, - #$93, #$92, #$94, #$95, - #$F0, #$96, #$98, #$97, #$99, #$9B, #$9A, #$D6, #$BF, #$9D, #$9C, #$9E, - #$9F, #$FD, #$FE, #$D8 - ), - // mac to ansi - (#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, #$08, #$09, #$0A, #$0B, - #$0C, #$0D, #$0E, #$0F, - #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, #$18, #$19, #$1A, #$1B, - #$1C, #$1D, #$1E, #$1F, - #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, #$28, #$29, #$2A, #$2B, - #$2C, #$2D, #$2E, #$2F, - #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$3A, #$3B, - #$3C, #$3D, #$3E, #$3F, - #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$4A, #$4B, - #$4C, #$4D, #$4E, #$4F, - #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$5B, - #$5C, #$5D, #$5E, #$5F, - #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$6A, #$6B, - #$6C, #$6D, #$6E, #$6F, - #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, #$78, #$79, #$7A, #$7B, - #$7C, #$7D, #$7E, #$7F, - #$C4, #$C5, #$C7, #$C9, #$D1, #$D6, #$DC, #$E1, #$E0, #$E2, #$E4, #$E3, - #$E5, #$E7, #$E9, #$E8, - #$EA, #$EB, #$ED, #$EC, #$EE, #$EF, #$F1, #$F3, #$F2, #$F4, #$F6, #$F5, - #$FA, #$F9, #$FB, #$FC, - #$A0, #$B0, #$A2, #$A3, #$A7, #$B4, #$B6, #$DF, #$AE, #$A9, #$8E, #$82, - #$8C, #$AD, #$C6, #$D8, - #$8D, #$B1, #$B2, #$B3, #$A5, #$B5, #$A6, #$B7, #$B8, #$B9, #$BC, #$AA, - #$BA, #$BD, #$E6, #$F8, - #$BF, #$A1, #$AC, #$92, #$80, #$81, #$A8, #$AB, #$BB, #$83, #$BE, #$C0, - #$C3, #$D5, #$91, #$93, - #$D0, #$84, #$96, #$94, #$95, #$90, #$F7, #$D7, #$FF, #$DD, #$98, #$97, - #$86, #$99, #$DE, #$A4, - #$88, #$87, #$89, #$8B, #$8A, #$C2, #$CA, #$C1, #$CB, #$C8, #$CD, #$CE, - #$CF, #$CC, #$D3, #$D4, - #$F0, #$D2, #$DA, #$DB, #$D9, #$9B, #$9A, #$85, #$8F, #$9D, #$9C, #$9E, - #$9F, #$FD, #$FE, #$AF - ) - ); - - // ebcdic cp38..ms ansi conversion - MPH_CCONV_BCD38: TMPHCharConv = ( - //ansi to bcd (taken from recode 3.5) - (#$00, #$01, #$02, #$03, #$37, #$2D, #$2E, #$2F, #$16, #$05, #$25, #$0B, - #$0C, #$0D, #$0E, #$0F, - #$10, #$11, #$12, #$13, #$3C, #$3D, #$32, #$26, #$18, #$19, #$3F, #$27, - #$1C, #$1D, #$1E, #$1F, - #$40, #$4F, #$7F, #$7B, #$5B, #$6C, #$50, #$7D, #$4D, #$5D, #$5C, #$4E, - #$6B, #$60, #$4B, #$61, - #$F0, #$F1, #$F2, #$F3, #$F4, #$F5, #$F6, #$F7, #$F8, #$F9, #$7A, #$5E, - #$4C, #$7E, #$6E, #$6F, - #$7C, #$C1, #$C2, #$C3, #$C4, #$C5, #$C6, #$C7, #$C8, #$C9, #$D1, #$D2, - #$D3, #$D4, #$D5, #$D6, - #$D7, #$D8, #$D9, #$E2, #$E3, #$E4, #$E5, #$E6, #$E7, #$E8, #$E9, #$4A, - #$E0, #$5A, #$5F, #$6D, - #$79, #$81, #$82, #$83, #$84, #$85, #$86, #$87, #$88, #$89, #$91, #$92, - #$93, #$94, #$95, #$96, - #$97, #$98, #$99, #$A2, #$A3, #$A4, #$A5, #$A6, #$A7, #$A8, #$A9, #$C0, - #$20, #$D0, #$A1, #$07, - #$80, #$22, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$8A, #$8B, - #$8C, #$8D, #$8E, #$8F, - #$90, #$77, #$2C, #$0A, #$3B, #$3E, #$1A, #$70, #$71, #$72, #$9A, #$9B, - #$9C, #$9D, #$9E, #$9F, - #$A0, #$15, #$73, #$74, #$75, #$76, #$6A, #$78, #$09, #$3A, #$AA, #$AB, - #$AC, #$AD, #$AE, #$AF, - #$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7, #$B8, #$B9, #$BA, #$BB, - #$BC, #$BD, #$BE, #$BF, - #$23, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$CA, #$CB, - #$CC, #$CD, #$CE, #$CF, - #$1B, #$24, #$06, #$14, #$28, #$2B, #$21, #$17, #$51, #$52, #$DA, #$DB, - #$DC, #$DD, #$DE, #$DF, - #$2A, #$E1, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$29, #$EA, #$EB, - #$EC, #$ED, #$EE, #$EF, - #$30, #$31, #$08, #$33, #$34, #$35, #$36, #$04, #$38, #$39, #$FA, #$FB, - #$FC, #$FD, #$FE, #$FF - ), - // bcd to ansi (taken from recode 3.5) - (#$00, #$01, #$02, #$03, #$F7, #$09, #$D2, #$7F, #$F2, #$A8, #$93, #$0B, - #$0C, #$0D, #$0E, #$0F, - #$10, #$11, #$12, #$13, #$D3, #$A1, #$08, #$D7, #$18, #$19, #$96, #$D0, - #$1C, #$1D, #$1E, #$1F, - #$7C, #$D6, #$81, #$C0, #$D1, #$0A, #$17, #$1B, #$D4, #$E9, #$E0, #$D5, - #$92, #$05, #$06, #$07, - #$F0, #$F1, #$16, #$F3, #$F4, #$F5, #$F6, #$04, #$F8, #$F9, #$A9, #$94, - #$14, #$15, #$95, #$1A, - #$20, #$C1, #$C2, #$C3, #$C4, #$C5, #$C6, #$C7, #$C8, #$C9, #$5B, #$2E, - #$3C, #$28, #$2B, #$21, - #$26, #$D8, #$D9, #$E2, #$E3, #$E4, #$E5, #$E6, #$E7, #$E8, #$5D, #$24, - #$2A, #$29, #$3B, #$5E, - #$2D, #$2F, #$82, #$83, #$84, #$85, #$86, #$87, #$88, #$89, #$A6, #$2C, - #$25, #$5F, #$3E, #$3F, - #$97, #$98, #$99, #$A2, #$A3, #$A4, #$A5, #$91, #$A7, #$60, #$3A, #$23, - #$40, #$27, #$3D, #$22, - #$80, #$61, #$62, #$63, #$64, #$65, #$66, #$67, #$68, #$69, #$8A, #$8B, - #$8C, #$8D, #$8E, #$8F, - #$90, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F, #$70, #$71, #$72, #$9A, #$9B, - #$9C, #$9D, #$9E, #$9F, - #$A0, #$7E, #$73, #$74, #$75, #$76, #$77, #$78, #$79, #$7A, #$AA, #$AB, - #$AC, #$AD, #$AE, #$AF, - #$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7, #$B8, #$B9, #$BA, #$BB, - #$BC, #$BD, #$BE, #$BF, - #$7B, #$41, #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$CA, #$CB, - #$CC, #$CD, #$CE, #$CF, - #$7D, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F, #$50, #$51, #$52, #$DA, #$DB, - #$DC, #$DD, #$DE, #$DF, - #$5C, #$E1, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$EA, #$EB, - #$EC, #$ED, #$EE, #$EF, - #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$FA, #$FB, - #$FC, #$FD, #$FE, #$FF - ) - ); - -type - // custom Exception class - EMPHexEditor = class(Exception); - - (* bookmark record:
- defined by pressing SHIFT+CTRL+[0..9], goto bookmark by pressing CTRL+[0..9]

- - - mPosition: file position
- - mInCharField: cursor in character pane (True) or hex number pane - *) - TMPHBookmark = record - mPosition: integer; - mInCharField: boolean; - end; - - // array of bookmarks, representing keys 0..9 - TMPHBookmarks = array[0..9] of TMPHBookmark; - - (* look of the editor's caret:
- - ckFull: full block
- - ckLeft: left line
- - ckBottom: bottom line
- - ckAuto: left line if @link(InsertMode), full block if overwrite, - bottom line if ReadOnlyView - *) - TMPHCaretKind = (ckFull, - ckLeft, - ckBottom, - ckAuto - ); - - (* how to show a file's content in the character pane of the editor:
- - tkAsIs: leave as is (current windows code page)
- - tkDos8: current dos codepage
- - tkASCII: 7 bit ascii
- - tkMac: macintosh charset (translation always from/to ms cp 1252 (ms latin1)!!
- - tkBCD: ibm ebcdic codepage 38 (translation always from/to ms cp 1252 (ms latin1)!!
- - tkCustom: custom codepage stored in @link(MPHCustomCharConv) - *) - TMPHTranslationKind = (tkAsIs, - tkDos8, - tkASCII, - tkMac, - tkBCD - - ,tkCustom - - ); - - (* action indicator used in @link(OnProgress) event handler:
- - pkLoad: loading data
- - pkSave: saving data
- - pkFind: finding - *) - TMPHProgressKind = (pkLoad, - pkSave, pkFind - ); - - (* progress event handler, used in @link(OnProgress)

- - - ProgressType: am i loading or saving? (see @link(TMPHProgressKind))
- - aName: name of file to be load from/saved to
- - Percent: current progress (0..100)
- - Cancel: if set to true, the load/save procedure will abort (no meaning in Find* methods)
- *) - TMPHProgressEvent = procedure(Sender: TObject; - const ProgressType: TMPHProgressKind; - const aName: TFileName; - const Percent: byte; - var Cancel: boolean) of object; - - (* retrieve the "line number" to display by the application

- - - Number: the number to convert to text - - OffsetText: the resulting text output - *) - TMPHGetOffsetTextEvent = procedure(Sender: TObject; - const Number: int64; - var OffsetText: string) of object; - - (* handler for custom search routines

- - - Pattern: the data to find - - PatLength: length of the data to find - - SearchFrom: first search position - - SearchUntil: last search position - - IgnoreCase: case sensitive? - - Wilcard: Wildcard character (only used by FindWithWildcard) - - FoundPos: result, set to -1 if data was not found - *) - TMPHFindEvent = procedure(Sender: TObject; - const Pattern: PChar; const PatLength: integer; - const SearchFrom, SearchUntil: integer; - const IgnoreCase: boolean; - const Wildcard: Char; - var FoundPos: Integer) of object; - - // precompiled converted character table types for faster data search - PMPHFindTable = ^TMPHFindTable; - TMPHFindTable = array[#0..#255] of Char; - - //@exclude - // flags internally used in the undo storage - TMPHUndoFlag = ( - // kind of undo storage - ufKindBytesChanged, - ufKindByteRemoved, - ufKindInsertBuffer, - ufKindReplace, - ufKindAppendBuffer, - ufKindNibbleInsert, - ufKindNibbleDelete, - ufKindConvert, - ufKindSelection, // store a selection - ufKindCombined, - ufKindAllData, // store current data and size for complete undo - // additional information - ufFlagByte1Changed, - ufFlagByte2Changed, - ufFlagModified, - ufFlag2ndByteCol, - ufFlagInCharField, - ufFlagHasSelection, - ufFlagInsertMode, - ufFlagIsUnicode, - ufFlagIsUnicodeBigEndian, - ufFlagHasDescription - ); - - //@exclude - // set of undo flags - TMPHUndoFlags = set of TMPHUndoFlag; - -type - // persistent color storage (contains the colors in hex editors) - TMPHColors = class(TPersistent) - private - FParent: TControl; - FOffset: TColor; - FOddColumn: TColor; - FEvenColumn: TColor; - FCursorFrame: TColor; - FNonFocusCursorFrame: TColor; - FBackground: TColor; - FChangedText: TColor; - FChangedBackground: TColor; - FCurrentOffsetBackground: TColor; - FOffsetBackGround: TColor; - FActiveFieldBackground: TColor; - FCurrentOffset: TColor; - FGrid: TColor; - procedure SetOffsetBackGround(const Value: TColor); - procedure SetCurrentOffset(const Value: TColor); - procedure SetParent(const Value: TControl); - procedure SetGrid(const Value: TColor); - procedure SetBackground(const Value: TColor); - procedure SetChangedBackground(const Value: TColor); - procedure SetChangedText(const Value: TColor); - procedure SetCursorFrame(const Value: TColor); - procedure SetEvenColumn(const Value: TColor); - procedure SetOddColumn(const Value: TColor); - procedure SetOffset(const Value: TColor); - procedure SetActiveFieldBackground(const Value: TColor); - procedure SetCurrentOffsetBackground(const Value: TColor); - procedure SetNonFocusCursorFrame(const Value: TColor); - public - // @exclude(constructor) - constructor Create(Parent: TControl); - // @exclude() - procedure Assign(Source: TPersistent); override; - // parent hex editor control - property Parent: TControl read FParent write SetParent; - published - // background color - property Background: TColor read FBackground write SetBackground; - // background color of modified bytes (in overwrite mode) - property ChangedBackground: TColor read FChangedBackground write - SetChangedBackground; - // foreground color of modified bytes (in overwrite mode) - property ChangedText: TColor read FChangedText write SetChangedText; - // color of the cursor and position frame in the second pane - property CursorFrame: TColor read FCursorFrame write SetCursorFrame; - // foreground color of the line offsets - property Offset: TColor read FOffset write SetOffset; - // foreground color of odd columns - property OddColumn: TColor read FOddColumn write SetOddColumn; - // foreground color of even columns - property EvenColumn: TColor read FEvenColumn write SetEvenColumn; - // background color of the current line in the offset pane (gutter) - property CurrentOffsetBackground: TColor read FCurrentOffsetBackground write - SetCurrentOffsetBackground; - // background color of the offset pane (gutter) - property OffsetBackGround: TColor read FOffsetBackGround write - SetOffsetBackGround; - // foreground color of the current line in the offset pane (gutter) - property CurrentOffset: TColor read FCurrentOffset write SetCurrentOffset; - // pen color of the grid - property Grid: TColor read FGrid write SetGrid; - // color of a cursor frame in a non-focused editor - property NonFocusCursorFrame: TColor read FNonFocusCursorFrame write - SetNonFocusCursorFrame; - // background color of the active field (hex/chars) - property ActiveFieldBackground: TColor read FActiveFieldBackground write SetActiveFieldBackground; - end; - - // @exclude(stream class for internal storage/undo) - TMPHMemoryStream = class(TMemoryStream) - private - procedure CheckBounds(const AMax: Integer); - function PointerAt(const APosition: Integer): Pointer; - protected - public - procedure ReadBufferAt(var Buffer; const APosition, ACount: Integer); - procedure WriteBufferAt(const Buffer; const APosition, ACount: Integer); - procedure Move(const AFromPos, AToPos, ACount: Integer); - procedure TranslateToAnsi(const FromTranslation: TMPHTranslationKind; const - APosition, ACount: integer); - procedure TranslateFromAnsi(const ToTranslation: TMPHTranslationKind; const - APosition, ACount: integer); - function GetAsHex(const APosition, ACount: integer; const SwapNibbles: - Boolean): string; - end; - - //@exclude - // undo storage implementation - TMPHUndoStorage = class; - - //@exclude - // offset format flags - TMPHOffsetFormatFlag = (offCalcWidth, - // calculate minwidth depending on data size (width field = '-') - offCalcRow, - // calculate _BytesPerUnit depending on bytes per row (=real line numbers) - offCalcColumn, // " bytes per column (= column numbers) - offBytesPerUnit // use BytesPerUnit property - ); - - //@exclude - // set of the above flags - TMPHOffsetFormatFlags = set of TMPHOffsetFormatFlag; - - //@exclude - // offset format record - TMPHOffsetFormat = record - Format: string; // format as string - Prefix, - Suffix: string; // splitted format - MinWidth: integer; // min length of value (zero padded on the left) - Flags: // auto calculation flags - TMPHOffsetFormatFlags; - Radix, // radix (base) of display (2..16) - _BytesPerUnit: byte; // length of one unit (1 Byte...BytesPerRow Bytes) - end; - - (* owner draw event type. parameters:

- - Sender: the hex editor
- - ACanvas: the editor's canvas
- - ACol, ARow: the position to be drawn
- - AWideText: the text to be drawn
- - ARect: the cell rectangle
- - ADefaultDraw: if set to True (default), default drawing isperformed after the event handler returns. - if set to false, the event handler must do all cell painting. - *) - TMPHDrawCellEvent = procedure(Sender: TObject; ACanvas: TCanvas; ACol, ARow: - Integer; var AWideText: WideString; ARect: TRect; var ADefaultDraw: Boolean) - of object; - - // protected ancestor of the hex editor components - - TCustomMPHexEditor = class(TCustomGrid) - - private - - FIntLastHexCol: integer; - FFindTable, - FFindTableI: TMPHFindTable; - FIsMaxOffset: boolean; - FFindProgress: boolean; - FBlockSize: Integer; - FSepCharBlocks: boolean; - FOnGetOffsetText: TMPHGetOffsetTextEvent; - FFixedFileSize: boolean; - FCharWidth, - FCharHeight: integer; - FBookmarkImageList: TImageList; - FInsertModeOn: boolean; - FCaretBitmap: TBitmap; - FColors: TMPHColors; - FBytesPerRow: integer; - FOffSetDisplayWidth: integer; - FBytesPerRowDup: integer; - FDataStorage: TMPHMemoryStream; - FSwapNibbles: integer; - FFocusFrame: boolean; - FIsFileReadonly: boolean; - FBytesPerCol: integer; - FPosInCharField, - FLastPosInCharField: boolean; - FFileName: string; - FModifiedBytes: TBits; - FBookmarks: TMPHBookmarks; - FSelStart, - FSelPosition, - FSelEnd: integer; - FSelBeginPosition: integer; - FTranslation: TMPHTranslationKind; - FCaretKind: TMPHCaretKind; - FReplaceUnprintableCharsBy: char; - FAllowInsertMode: boolean; - FWantTabs: boolean; - FReadOnlyView: boolean; - FHideSelection: boolean; - FGraySelOnLostFocus: boolean; - FOnProgress: TMPHProgressEvent; - FMouseDownCol, - FMouseDownRow: integer; - FShowDrag: boolean; - FDropCol, - FDropRow: integer; - FOnInvalidKey, - FOnTopLeftChanged: TNotifyEvent; - FDrawGridLines: boolean; - FDrawGutter3D: boolean; - FGutterWidth: integer; - FOffsetFormat: TMPHOffsetFormat; - FSelectionPossible: boolean; - FBookmarkBitmap: TBitmap; - FCursorList: array of integer; - FHasCustomBMP: boolean; - FStreamFileName: string; - FHasFile: boolean; - FMaxUndo: integer; - FHexChars: array[0..15] of char; - FHexLowerCase: boolean; - FOnChange: TNotifyEvent; - FShowRuler: boolean; - FBytesPerUnit: Integer; - FRulerBytesPerUnit: Integer; - FOnSelectionChanged: TNotifyEvent; - FSelectionChangedCount: Integer; - FShowPositionIfNotFocused: Boolean; - FOffsetHandler: Boolean; - FUsedRulerBytesPerUnit: Integer; - FIsSelecting: boolean; - FMouseUpCanResetSel: boolean; - FUndoStorage: TMPHUndoStorage; - FUnicodeCharacters: Boolean; - FUnicodeBigEndian: Boolean; - FMaskedChars: TSysCharSet; - - FDrawDataPosition: integer; - FOnDrawCell: TMPHDrawCellEvent; - - FOnBookmarkChanged: TNotifyEvent; - property Color; - function IsInsertModePossible: boolean; - function IsFileSizeFixed: boolean; - procedure InternalErase(const KeyWasBackspace: boolean; const UndoDesc: - string = ''); - procedure SetReadOnlyView(const Value: boolean); - procedure SetCaretKind(const Value: TMPHCaretKind); - procedure SetFocusFrame(const Value: boolean); - procedure SetBytesPerColumn(const Value: integer); - procedure SetSwapNibbles(const Value: boolean); - function GetSwapNibbles: boolean; - function GetBytesPerColumn: integer; - procedure SetOffsetDisplayWidth; - procedure SetColors(const Value: TMPHColors); - procedure SetReadOnlyFile(const Value: boolean); - procedure SetTranslation(const Value: TMPHTranslationKind); - procedure SetModified(const Value: boolean); - procedure SetChanged(DataPos: integer; const Value: boolean); - procedure SetFixedFileSize(const Value: boolean); - procedure SetAllowInsertMode(const Value: boolean); - function GetInsertMode: boolean; - procedure SetWantTabs(const Value: boolean); - procedure SetHideSelection(const Value: boolean); - procedure SetGraySelectionIfNotFocused(const Value: boolean); - function CalcColCount: integer; - function GetLastCharCol: integer; - function GetPropColCount: integer; - function GetPropRowCount: integer; - function GetMouseOverSelection: boolean; - function CursorOverSelection(const X, Y: integer): boolean; - function MouseOverFixed(const X, Y: integer): boolean; - procedure AdjustBookmarks(const From, Offset: integer); - procedure IntSetCaretPos(const X, Y, ACol: integer); - procedure TruncMaxPosition(var DataPos: integer); - procedure SetSelection(DataPos, StartPos, EndPos: integer); - function GetCurrentValue: integer; - procedure SetInsertMode(const Value: boolean); - function GetModified: boolean; - //function GetDataPointer: Pointer; - procedure SetBytesPerRow(const Value: integer); - procedure SetMaskChar(const Value: char); - procedure SetAsText(const Value: string); - procedure SetAsHex(const Value: string); - function GetAsText: string; - function GetAsHex: string; - procedure WMTimer(var Msg: TWMTimer); message WM_TIMER; - // show or hide caret depending on row/col in view - procedure CheckSetCaret; - // get the row according to the given buffer position - function GetRow(const DataPos: integer): integer; - // invalid key pressed (in ebcdic) - procedure WrongKey; - // create an inverting caret bitmap - procedure CreateCaretGlyph; - // get start of selection - function GetSelStart: integer; - // get end of selection - function GetSelEnd: integer; - // get selection count - function GetSelCount: integer; - // set selection start - procedure SetSelStart(aValue: integer); - // set selection end - procedure SetSelEnd(aValue: integer); - // position the caret in the given field - procedure SetInCharField(const Value: boolean); - // is the caret in the char field ? - function GetInCharField: boolean; - // insert a buffer (internal) - procedure InternalInsertBuffer(Buffer: PChar; const Size, Position: - integer); - // append some data (int) - procedure InternalAppendBuffer(Buffer: PChar; const Size: integer); - // store the caret properties - procedure InternalGetCurSel(var StartPos, EndPos, ACol, ARow: integer); - // delete data - procedure InternalDelete(StartPos, EndPos, ACol, ARow: integer); - // delete one half byte - function InternalDeleteNibble(const Pos: integer; - const HighNibble: boolean): boolean; - // insert half byte - function InternalInsertNibble(const Pos: integer; const HighNibble: - boolean): boolean; - // used by nibble functions - function CreateShift4BitStream(const StartPos: integer; var FName: - TFileName): TFileStream; - // convert a given amount of data from ansi to something different and vice versa - procedure InternalConvertRange(const aFrom, aTo: integer; const aTransFrom, - aTransTo: TMPHTranslationKind); - // move data in buffer to a different position - procedure MoveFileMem(const aFrom, aTo, aCount: integer); - function GetBookmark(Index: byte): TMPHBookmark; - procedure SetBookmark(Index: byte; const Value: TMPHBookmark); - procedure SetBookmarkVals(const Index: byte; const Position: integer; const - InCharField: boolean); - procedure SetDrawGridLines(const Value: boolean); - procedure SetGutterWidth(const Value: integer); - // images have changed - procedure BookmarkBitmapChanged(Sender: TObject); - procedure SetBookmarkBitmap(const Value: TBitmap); - - function GetVersion: string; - procedure SetVersion(const Value: string); - - // free alloc'd memory of one of the storage streams; - procedure FreeStorage(FreeUndo: boolean = False); - function GetCanUndo: boolean; - function GetCanRedo: boolean; - function GetUndoDescription: string; - function GetOffsetFormat: string; - procedure SetOffsetFormat(const Value: string); - // generate offset format - procedure GenerateOffsetFormat(Value: string); - procedure SetHexLowerCase(const Value: boolean); - procedure SetDrawGutter3D(const Value: boolean); - procedure SetShowRuler(const Value: boolean); - procedure SetBytesPerUnit(const Value: integer); - procedure SetRulerString; - procedure CheckSelectUnit(var AStart, AEnd: Integer); - procedure SetRulerBytesPerUnit(const Value: integer); - procedure SetShowPositionIfNotFocused(const Value: Boolean); - function GetDataAt(Index: integer): Byte; - procedure SetDataAt(Index: integer; const Value: Byte); - procedure SetUnicodeCharacters(const Value: Boolean); - procedure SetUnicodeBigEndian(const Value: Boolean); - function GetPositionAtCursor(const ACol, ARow: integer): integer; - function GetIsCharFieldCol(const ACol: integer): Boolean; -{$IFDEF FASTACCESS} - function GetFastPointer: PByteArray; -{$ENDIF} - procedure SetDataSize(const Value: integer); - procedure SetBlockSize(const Value: Integer); - procedure SetSepCharBlocks(const Value: boolean); - private - - FIsDrawDataSelected: boolean; - - FOnWildcardFind: TMPHFindEvent; - FOnFind: TMPHFindEvent; -{$IFDEF FASTACCESS} - FSetDataSizeFillByte: Byte; -{$ENDIF} - FRulerNumberBase: byte; - procedure SetFindProgress(const Value: boolean); - procedure SetRulerNumberBase(const Value: byte); - procedure SetMaskedChars(const Value: TSysCharSet); - protected - // @exclude() - FRulerString: string; - // @exclude() - FRulerCharString: string; - - // @exclude(used by TMPHexEditorEx for internal drag 'n' drop) - FFixedFileSizeOverride: boolean; - // @exclude(used by TMPHexEditorEx for internal undo changing) - FModified: boolean; - // @exclude(overwrite mouse wheel for zooming) - function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): boolean; - override; - // @exclude(overwrite mouse wheel for zooming) - function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): boolean; - override; - // @exclude(actually used bytes per unit) - property UsedRulerBytesPerUnit: Integer read FUsedRulerBytesPerUnit; - // @exclude(True: cells are currently to be selected) - property IsSelecting: boolean read FIsSelecting; - // @exclude(True: MouseUp resets selection) - property MouseUpCanResetSel: boolean read FMouseUpCanResetSel write - FMouseUpCanResetSel; - // @exclude(memory stream which contains the undo/redo data) - property UndoStorage: TMPHUndoStorage read FUndoStorage; - // @exclude(stream that contains the data) - property DataStorage: TMPHMemoryStream read FDataStorage; - // @exclude(fire OnSelectionChange) - procedure SelectionChanged; virtual; - // @exclude(set a new selection) - procedure NewSelection(SelFrom, SelTo: integer); - // @exclude(get the current mouse position) - function CheckMouseCoord(var X, Y: integer): TGridCoord; - // @exclude(assure the value is a multiple of FBytesPerUnit) - procedure CheckUnit(var AValue: Integer); - // call changed on every undo creation for OnChange event - procedure Changed; virtual; - // returns the drop file position after a drag'n'drop operation - function DropPosition: integer; - // copy a stream to a second one and fire the OnProgress handler - procedure Stream2Stream(strFrom, strTo: TStream; const Operation: - TMPHProgressKind; const Count: integer = -1); - (* allows descendants to take special action if contents are to be saved - to the file from where the data was load *) - procedure PrepareOverwriteDiskFile; virtual; - // store the current Cursor and set it to crHourGlass (see also @link(OldCursor)) - procedure WaitCursor; - // reset the Cursor to the previous value (see also @link(WaitCursor)) - procedure OldCursor; - // @exclude(override paint) - procedure Paint; override; - // @exclude(view changed) - procedure TopLeftChanged; override; - // adjust cell widths/heigths depending on font, offset format, bytes per row/column... - procedure AdjustMetrics; - // get the size of the contained data - function GetDataSize: integer; - // @exclude(calculate the grid sizes) - procedure CalcSizes; - // @exclude(select one cell) - function SelectCell(ACol, ARow: longint): boolean; override; - // @exclude(get the data position depending on col and row) - function GetPosAtCursor(const aCol, aRow: integer): integer; - // @exclude(vice versa) - function GetCursorAtPos(const aPos: integer; const aChars: boolean): - TGridCoord; - // @exclude(get the column of the other field (hex<->char)) - function GetOtherFieldCol(const aCol: integer): integer; - // @exclude(get the column of the other field (hex<->char)) - function GetOtherFieldColCheck(const aCol: integer): integer; - // @exclude(can the cell be selected ?) - function CheckSelectCell(aCol, aRow: integer): boolean; - // @exclude(char message handler) - procedure WMChar(var Msg: TWMChar); message WM_CHAR; - // @exclude(posted message to update the caret position) - procedure CMINTUPDATECARET(var Msg: TMessage); message CM_INTUPDATECARET; - // @exclude(posted message to fire an OnSelectionChanged event) - procedure CMSelectionChanged(var Msg: TMessage); message - CM_SELECTIONCHANGED; - // @exclude(for shortcuts) - procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; - // @exclude(readjust grid sizes after font has changed) - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - // @exclude(change a byte at the given position) - procedure IntChangeByte(const aOldByte, aNewByte: byte; - aPos, aCol, aRow: integer; const UndoDesc: string = ''); - // @exclude(change two bytes at the given position) - procedure IntChangeWideChar(const aOldChar, aNewChar: WideChar; aPos, aCol, - aRow: integer; const UndoDesc: string = ''); - // @exclude(keydown handler) - procedure KeyDown(var Key: word; Shift: TShiftState); override; - // @exclude(keyup handler) - //procedure KeyUp(var Key: word; Shift: TShiftState); override; - // @exclude(has this byte been modified ?) - function HasChanged(aPos: integer): boolean; - // @exclude(redraw some lines) - procedure RedrawPos(aFrom, aTo: integer); - // @exclude(make a selection) - procedure Select(const aCurCol, aCurRow, aNewCol, aNewRow: integer); - // @exclude(mouse down handler) - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: - integer); override; - // @exclude(mouse move handler) - procedure MouseMove(Shift: TShiftState; X, Y: integer); override; - // @exclude(mouse up handler) - procedure MouseUP(Button: TMouseButton; Shift: TShiftState; X, Y: integer); - override; - // @exclude(is undo record creation possible?) - function CanCreateUndo(const aKind: TMPHUndoFlag; const aCount, aReplCount: - integer): Boolean; virtual; - // @exclude(add an undo to the undo buffer) - procedure CreateUndo(const aKind: TMPHUndoFlag; const aPos, aCount, - aReplCount: integer; const sDesc: string = ''); - // @exclude(after loading) - procedure Loaded; override; - // @exclude(override CreateWnd) - procedure CreateWnd; override; - // @exclude(wm_setfocus handler) - procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; - // @exclude(wm_killfocus handler) - procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; - // @exclude(wm_vscroll handler) - procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; - // @exclude(wm_hscroll handler) - procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL; - // @exclude(resize the control) - procedure Resize; override; - // @exclude(store bitmap ? (its set to true, if a custom bitmap has been stored in BookmarkBitmap)) - function HasCustomBookmarkBitmap: boolean; - // number of bytes to show in each row - property BytesPerRow: integer read FBytesPerRow write SetBytesPerRow; - // if set to True, the find* routines also fire OnProgress events (default is False) - property FindProgress: boolean read FFindProgress write SetFindProgress - default False; - // number of bytes to show in each column - property BytesPerColumn: integer read GetBytesPerColumn write - SetBytesPerColumn default 2; - (* translation kind of the data (used to show characters on and to handle key presses in the char pane), - (see also @link(TMPHTranslationKind)) - *) - property Translation: TMPHTranslationKind read FTranslation write - SetTranslation; - (* offset display ("line numbers") format, in the form
- [r|c|<HEXNUM>%][-|<HEXNUM>!]<HEXNUM>:[Prefix]|[Suffix]
- (<HEXNUM> means a number in hexadecimal format (without prefix/suffix))

- - first field (up to the percent sign):
-
    -
  • sets the "bytes per unit field" of the offset display format
    • -
  • if it's set to 1, each row offset displays the data position in bytes
    • -
  • if it's set to 2, each row offset displays the data position in words
    • -
  • if it's set to 4, each row offset displays the data position in dwords
    • -
  • if it's set to "r", each row offset displays the current row number (1st row=0, - see also @link(BytesPerRow))
    • -
  • if it's set to "c", each row offset displays the current column number (1st column=0, - see also @link(BytesPerColumn))
    • -
  • if this field is omitted, bytes per unit is set to the value of the - @link(RulerBytesPerUnit) property
    • -

- - second field (up to the exclamation mark):
-
    -
  • sets the minimum width of the number part, if the number is shorter, it will be padded - by '0' chars at the left
    • -
  • if this field reads -!, the the minimum width is automatically set to the longest number - that can appear in the editor (the data's size)
    • -
  • if this field is omitted, the minimum width is set to 1
    • -

- - third field (up to the colon):
-
    -
  • sets the radix (base) of the offset format in hex notation
    • -
  • set this to '10' (without quotes) for hexadecimal offset display, set it to '08' for - octal and to '0a' for decimal offset display
    • -
  • this field cannot be omitted, but the whole format string my be blank to avoid the display of - offset identifiers
    • -

- - fourth field (up to the pipe ('|') char):
-
    -
  • the prefix that is put in front of the "number" string (e.g. '0x' or '$' to show that numbers are in hex format) -
  • this field may be omitted (but not the pipe char!)
    • -

- - fifth (and last) field:
-
    -
  • the suffix to put after the "number string" (e.g. 'h' to show hex numbers)
    • -
  • this field may be omitted
- *) - property OffsetFormat: string read GetOffsetFormat write SetOffsetFormat; - - (* if this handler is assigned, the @link(OffsetFormat) is not used to - create "line numbers", but the application tells the editor how to format the offset text - *) - property OnGetOffsetText: TMPHGetOffsetTextEvent read FOnGetOffsetText write - FOnGetOffsetText; - - (* how many bytes form one block in a row? blocks are separated by a one character wide blank. - -1 means no block separation (see also @link(SeparateBlocksInCharField)) *) - property BytesPerBlock: Integer read FBlockSize write SetBlockSize default - -1; - - (* if @link(BytesPerBlock) is used, this property tells the editor whether it should - separate blocks of bytes in the character pane too or not *) - property SeparateBlocksInCharField: boolean read FSepCharBlocks write - SetSepCharBlocks default True; - - // look of the editor's caret (see @link(TMPHCaretKind)) - property CaretKind: TMPHCaretKind read FCaretKind write SetCaretKind default - ckAuto; - // colors to display (see @link(TMPHColors)) - property Colors: TMPHColors read FColors write SetColors; - (* if FocusFrame is set to True, the current caret position will be displayed in the - second field (hex - characters) as a dotted focus frame, if set to False, it will - be shown as an ordinary rectangle - *) - property FocusFrame: boolean read FFocusFrame write SetFocusFrame; - (* if SwapNibbles is set to True, the hex pane will show all bytes in the order - lower 4 bits-higher 4 bits (i.e. the value 192 dec = C0 hex will be drawn as - 0C). if set to False, hex values will be displayed in usual order. this - setting also affects hex data input and hex-string conversions - *) - property SwapNibbles: boolean read GetSwapNibbles write SetSwapNibbles - default False; - // replace @link(MaskedChars) with the following character in the character pane - property MaskChar: char read FReplaceUnprintableCharsBy write SetMaskChar - stored False; - (* if set to True, the data size is readonly, e.g. no data may be appended, deleted - or inserted, just overwriting is allowed. this also affects @link(InsertMode). - *) - property NoSizeChange: boolean read FFixedFileSize write SetFixedFileSize - default False; - (* if set to False, switching between overwrite and insert mode is not allowed - (see also @link(InsertMode) and @link(NoSizeChange)) - *) - property AllowInsertMode: boolean read FAllowInsertMode write - SetAllowInsertMode default True; - (* if set to True, the Tab key is used to switch the caret between hex and character pane. - if set to False, the Tab key can be used to switch between controls. then the - combination CTRL+T is used to switch the panes - *) - property WantTabs: boolean read FWantTabs write SetWantTabs default True; - // if set to True, the data can not be edited, just cursor movement is allowed ("Hex Viewer" mode) - property ReadOnlyView: boolean read FReadOnlyView write SetReadOnlyView - default False; - // hide the current selection when the hex editor looses focus (see also @link(GraySelectionIfNotFocused)) - property HideSelection: boolean read FHideSelection write SetHideSelection - default False; - (* if set to True and @link(HideSelection) is False, then the current selection will be - grayed when the hex editor looses focus (the values from the @link(Colors) property will - be converted to grayscale colors) - *) - property GraySelectionIfNotFocused: boolean read FGraySelOnLostFocus write - SetGraySelectionIfNotFocused default False; - (* this event is called in @link(LoadFromFile), @link(SaveToFile), @link(Find) and - @link(FindWithWildcard) routines, so a progress indicator may be updated - (see also @link(TMPHProgressEvent), @link(FindProgress)) - *) - property OnProgress: TMPHProgressEvent read FOnProgress write - FOnProgress; - (* this event is fired if an invalid character has been typed (like non-hex characters - in the hex pane) - *) - property OnInvalidKey: TNotifyEvent read FOnInvalidKey write FOnInvalidKey; - // this event is fired if the first visible row or column have been changed (e.g. on scrolling) - property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write - FOnTopLeftChanged; - // returns the current selection in hex format ('00010203...') as string, uses @link(SwapNibbles) - function GetSelectionAsHex: string; - (* replace the current selection by a string containing data in hex format ('00 01 02 03' or similar), - uses @link(SwapNibbles) - *) - procedure SetSelectionAsHex(const s: string); - // returns a string containing the currently selected data - function GetSelectionAsText: string; - // replaces the currently selected data with the string's contents - procedure SetSelectionAsText(const s: string); - // if set to True, a grid is drawn - property DrawGridLines: boolean read FDrawGridLines write SetDrawGridLines; - // width of the offset display gutter, if set to -1, automatically adjust the gutter's width - property GutterWidth: integer read FGutterWidth write SetGutterWidth default - -1; - (* bitmap containing 20 10x10 pixels pictures for bokkmarks (they are displayed in the offset - gutter), the first ten pictures represent the bookmarks 0(10)..9, if they are set in the - hexpane, the last 10 pics are shown if bookmarks are set in the character pane (see also - @link(TMPHBookMark)) - *) - property BookmarkBitmap: TBitmap read FBookmarkBitmap write SetBookmarkBitmap - stored HasCustomBookmarkBitmap; - - // current version of the hex editor component (returns the build data), readonly - property Version: string read GetVersion write SetVersion stored True; - - // maximum memory that is used for undo storage (in bytes, approximately) - property MaxUndo: integer read FMaxUndo write FMaxUndo default 1024 * 1024; - (* insert mode (typed characters are inserted at the current position) or - overwrite mode (typed characters replace values at the current position), see also - @link(AllowInsertMode), @link(NoSizeChange) and @link(ReadOnlyView) - *) - property InsertMode: boolean read GetInsertMode write SetInsertMode default - False; - // if set to True, hex data and hex offsets are displayed in lower case - property HexLowerCase: boolean read FHexLowerCase write SetHexLowerCase - default False; - // this event is called on every data change (load/empty/undo/redo) - property OnChange: TNotifyEvent read FOnChange write FOnChange; - // if set to True, a 3d line is drawn at the right of the offset gutter - property DrawGutter3D: boolean read FDrawGutter3D write SetDrawGutter3D - default True; - // if set to True, a ruler is shown above the first row - property ShowRuler: boolean read FShowRuler write SetShowRuler default - False; - (* number base (i.e. radix) for the ruler display (2-16), tells the component - which number format to use when drawing the ruler - *) - property RulerNumberBase: byte read FRulerNumberBase write SetRulerNumberBase - default 16; - (* setting this property changes the way how mouse/keyboard selection - works:
- e.g. if set to two, two bytes will be treated as a unit, that means you - cannot select a single byte, only two, four, six... bytes can be selected. - also drag/drop and clipboard pasting is affected (data size - is always a multiple of BytesPerUnit). See also @link(RulerBytesPerUnit) - *) - property BytesPerUnit: integer read FBytesPerUnit write SetBytesPerUnit - default 1; - (* setting this property affects the offset/ruler drawing:
- e.g. if set to two, two bytes will be treated as a unit, that means the - offset and ruler values will step by one each two bytes. - if this property is set to -1, it will use the value of the - @link(BytesPerUnit) property - *) - property RulerBytesPerUnit: integer read FRulerBytesPerUnit write - SetRulerBytesPerUnit default -1; - // mark the current position even if the editor is not focused - property ShowPositionIfNotFocused: Boolean read FShowPositionIfNotFocused - write SetShowPositionIfNotFocused default False; - (* if set to True, the character pane displays unicode characters - and the @link(BytesPerUnit) property is set to 2. @link(Translation) is - set to tkAsIs. @link(BytesPerRow) and @link(BytesPerColumn) must be a - multiple of two to be able to use the unicode mode. - see also @link(UnicodeBigEndian) - *) - property UnicodeChars: Boolean read FUnicodeCharacters write - SetUnicodeCharacters default False; - (* if set to True, big endian unicode mode is used if @link(UnicodeChars) is - enabled - *) - property UnicodeBigEndian: Boolean read FUnicodeBigEndian write - SetUnicodeBigEndian default False; - // this event is fired when the selection/caret position has changed - property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write - FOnSelectionChanged; - - // use this event to implement owner drawing. see also @link(TMPHDrawCellEvent) - property OnDrawCell: TMPHDrawCellEvent read FOnDrawCell write FOnDrawCell; - - // fire OnBookmarkChanged - procedure BookmarkChanged; virtual; - - procedure DoSetCellWidth(const Index: integer; Value: integer); - procedure DefineProperties(Filer: TFiler); override; - procedure ReadMaskChar(Reader: TReader); - procedure ReadMaskChar_I(Reader: TReader); - procedure WriteMaskChar_I(Writer: TWriter); - public - { Public-Deklarationen } - //@exclude() - constructor Create(aOwner: TComponent); override; - //@exclude() - destructor Destroy; override; - // these characters are masked in the character pane using @link(MaskChar) - property MaskedChars: TSysCharSet read FMaskedChars write SetMaskedChars; - (* during OnDrawCell event handlers, this property tells the data position currently - being drawn (-1, if offset or ruler are drawn) - *) - property DrawDataPosition: integer read FDrawDataPosition; - - (* during OnDrawCell event handlers, this property tells whether the cell is - to be drawn in selected style (only valid if DrawDataPosition <> -1) - *) - property IsDrawDataSelected: boolean read FIsDrawDataSelected; - - // @exclude(use TMPHexEditor.ReadBuffer!) - function GetMemory(const Index: Integer): char; - (* @exclude(see http://info.borland.com/devsupport/delphi/fixes/delphi4/vcl.html, - ref 279) - *) - - function CanFocus: Boolean; {$IFDEF DELPHi5UP}override;{$ENDIF} - // @exclude(use TMPHexEditor.WriteBuffer!) - procedure SetMemory(const Index: integer; const Value: char); -{$IFDEF FASTACCESS} - property FastPointer: PByteArray read GetFastPointer; -{$ENDIF} - (* this property is valid only in the @link(OnGetOffsetText) event. if True, - the component asks for the string of the highest possible offset, if False, - a row's offset text is queried - *) - property IsMaxOffset: boolean read FIsMaxOffset; - // seek behind the last position if @link(InsertMode) = True, goto last position otherwise - procedure SeekToEOF; - (* synchronize another TCustomMPHexEditor view (top, left, selection), - the optional SyncOffset parameter may be used for a different viewpoint - *) - procedure SyncView(Source: TCustomMPHexEditor; SyncOffset: integer = 0); - // return the offset of the first displayed data - function DisplayStart: integer; - // return the offset of the last displayed data - function DisplayEnd: integer; - // is the given position part of the selection? - function IsSelected(const APosition: integer): boolean; - // calculate a data position from a col/row pair - property PositionAtCursor[const ACol, ARow: integer]: integer read - GetPositionAtCursor; - // is the given col in the hex or the character pane? - property IsCharFieldCol[const ACol: integer]: Boolean read - GetIsCharFieldCol; -{$IFDEF FASTACCESS} - // this byte value is used to fill the data when setting @link(DataSize) - // enlarges the stream - property SetDataSizeFillByte: Byte read FSetDataSizeFillByte write - FSetDataSizeFillByte; -{$ENDIF} - // has data been load from/saved to a file (or is the filename valid) - property HasFile: boolean read FHasFile write FHasFile; - (* each call to UndoBeginUpdate increments an internal counter that prevents using - undo storage and also disables undo functionality (see also @link(UndoEndUpdate)) - *) - function UndoBeginUpdate: integer; virtual; - (* each call to UndoEndUpdate decrements an internal counter that prevents using - undo storage and also disables undo functionality. the return value is the value - of this counter. if the counter is reset to zero, undo creation is permitted again - (see also @link(UndoBeginUpdate)) - *) - function UndoEndUpdate: integer; virtual; - // remove selection state from all data - procedure ResetSelection(const aDraw: boolean); - // see @link(GetSelectionAsHex) and @link(SetSelectionAsHex) - property SelectionAsHex: string read GetSelectionAsHex write - SetSelectionAsHex; - // see @link(GetSelectionAsText) and @link(SetSelectionAsText) - property SelectionAsText: string read GetSelectionAsText write - SetSelectionAsText; -{$IFNDEF BCB} - (* precompiled character comparison table for custom find routines, see also - @link(FindTableI), @link(OnFind), @link(OnWildcardFind), case sensitive, not - public under BCB! - *) - property FindTable: TMPHFindTable read FFindTable ; - (* precompiled character comparison table for custom find routines, see also - @link(FindTable), @link(OnFind), @link(OnWildcardFind), case insensitive, not - public under BCB! - *) - property FindTableI: TMPHFindTable read FFindTableI; -{$ENDIF} - - // implement your custom @link(Find) routine by assigning a method to this handler, - // see also @link(OnWildcardFind) - property OnFind: TMPHFindEvent read FOnFind write FOnFind; - // implement your custom @link(FindWithWildcard) routine by assigning a method - // to this handler, see also @link(OnFind) - property OnWildcardFind: TMPHFindEvent read FOnWildcardFind - write FOnWildcardFind; - (* returns the given position as it would be drawn in the offset gutter, - see also @link(OffsetFormat) - *) - function GetOffsetString(const Position: cardinal): string; virtual; - (* returns the given position as it would be drawn in the offset gutter, exception: - if @link(OffsetFormat) is set to an empty string, returns the hexadecimal representation - of the Position value (see also @link(GetOffsetString)) - *) - function GetAnyOffsetString(const Position: integer): string; virtual; - // returns the height of one row in pixels - function RowHeight: integer; - // free the undo storage (discard all possible undo steps) - procedure ResetUndo; - // set the current position (like TStream.Seek) - function Seek(const aOffset, aOrigin: integer): integer; - (* searches for text or data in the data buffer, returns the find position (-1, if data have not been found):

- - aBuffer: data to search for
- - aCount: size of data in aBuffer
- - aStart: start search at this position
- - aEnd: searches up to this position
- - IgnoreCase: if True, lowercase and uppercase characters are treated as if they were equal
- - SearchText: if True, the current @link(Translation) is taken into account when searching textual data

- NOTE: call @link(PrepareFindReplaceData) before the first Find call - *) - function Find(aBuffer: PChar; aCount: integer; const aStart, aEnd: integer; - const IgnoreCase: boolean): integer; - (* searches for text or data in the data buffer using a wildcard character - returns the find position (-1, if data have not been found):

- - aBuffer: data to search for
- - aCount: size of data in aBuffer
- - aStart: start search at this position
- - aEnd: searches up to this position
- - IgnoreCase: if True, lowercase and uppercase characters are treated as if they were equal
- - SearchText: if True, the current @link(Translation) is taken into account when searching textual data
- - Wildcard: this character is a placeholder for any character

- NOTE: call @link(PrepareFindReplaceData) before the first FindWithWildcard call - *) - function FindWithWildcard(aBuffer: PChar; aCount: integer; const aStart, - aEnd: integer; - const IgnoreCase: boolean; const Wildcard: char): integer; - (* convert a buffer for @link(Find)/@link(FindWithWildcard)/replace operation depending on - unicode mode. sets the string to lower case if IgnoreCase is True. if in unicode mode, - creates a unicode string. - *) - (* - store a selection as undo record, so you can restore the selection start and end by using - @link(Undo). this can be useful e.g. to show position of replaced data - *) - procedure AddSelectionUndo(const AStart, ACount: integer); - function PrepareFindReplaceData(StrData: string; const IgnoreCase, IsText: - boolean): string; - // read data into a buffer - procedure ReadBuffer(var Buffer; const Index, Count: Integer); - // write a buffer to the file data - procedure WriteBuffer(const Buffer; const Index, Count: Integer); virtual; - // delete the currently selected data - procedure DeleteSelection(const UndoDesc: string = ''); - // load the contents of a stream into the data buffer - procedure LoadFromStream(Strm: TStream); - // load the contents of a file into the data buffer - procedure LoadFromFile(const Filename: string); - // save the contents of the data buffer into a stream - procedure SaveToStream(Strm: TStream); - // save the contents of the data buffer to a file - procedure SaveToFile(const Filename: string; const aUnModify: boolean = - True); - // save a range of bytes to a stream - procedure SaveRangeToStream(Strm: TStream; const APosition, ACount: - integer); - // undo the last modification, multiple undos are possible - function Undo: boolean; - // discard the last undo action (only one single redo is possible) - function Redo: boolean; - // empty the data buffer and set the filename (e.g. "Untitled") - procedure CreateEmptyFile(const TempName: string); - (* returns a buffer containing parts of the data buffer's contents. the buffer is allocated - in this routine and must be freed by the caller - *) - function BufferFromFile(const aPos: integer; var aCount: integer): PChar; - // insert some data at the specified position into the data buffer - procedure InsertBuffer(aBuffer: PChar; const aSize, aPos: integer; const - UndoDesc: string = ''; const MoveCursor: Boolean = True); - // append some data at the end of the data buffer - procedure AppendBuffer(aBuffer: PChar; const aSize: integer; const UndoDesc: - string = ''; const MoveCursor: Boolean = True); - // replace the currently selected data with some other data - procedure ReplaceSelection(aBuffer: PChar; aSize: integer; const UndoDesc: - string = ''; const MoveCursor: Boolean = True); - // replace some amount of data - function Replace(aBuffer: PChar; aPosition, aOldCount, aNewCount: integer; - const UndoDesc: - string = ''; const MoveCursor: Boolean = False): integer; - // get the current data position (depending on the cursor/caret) - function GetCursorPos: integer; - // delete 4 bits (=half byte = nibble) from the data buffer (see also @link(InsertNibble)) - function DeleteNibble(const aPos: integer; const HighNibble: boolean; const - UndoDesc: string = ''): boolean; - // insert 4 bits (0000) into the data buffer (see also @link(DeleteNibble)) - function InsertNibble(const aPos: integer; const HighNibble: boolean; const - UndoDesc: string = ''): boolean; - // convert a part of the data buffer's content from one character table to a different one - procedure ConvertRange(const aFrom, aTo: integer; const aTransFrom, - aTransTo: TMPHTranslationKind; const UndoDesc: string = ''); - (* returns the data position of the top left cell and also whether the caret is in the - character pane, see also @link(SetTopLeftPosition) - *) - function GetTopLeftPosition(var oInCharField: boolean): integer; - (* set top left cell to the given data position and also whether the caret is in the - character pane (see also @link(GetTopLeftPosition)) - *) - procedure SetTopLeftPosition(const aPosition: integer; const aInCharField: - boolean); - (* show a drop position marker on the cell at the given mouse cursor position - (see also @link(HideDragCell)) - *) - function ShowDragCell(const X, Y: integer): integer; - // hide the drop position marker (see also @link(ShowDragCell)) - procedure HideDragCell; - // combine two or more changes, so @link(Undo) will discard the at once - procedure CombineUndo(const aCount: integer; const sDesc: string = ''); - (* translate a byte from the current @link(Translation) to the Windows Codepage - (see also @link(TranslateFromAnsiChar)) - *) - function TranslateToAnsiChar(const aByte: byte): char; - (* translate a byte from Windows Codepage to the current @link(Translation) - (see also @link(TranslateToAnsiChar)) - *) - function TranslateFromAnsiChar(const aByte: byte): char; - // retrieve or set the selection start - property SelStart: integer read GetSelStart write SetSelStart; - // retrieve or set the selection end - property SelEnd: integer read GetSelEnd write SetSelEnd; - // retrieve the size of the selected data - property SelCount: integer read GetSelCount; - // is @link(Undo) possible? - property CanUndo: boolean read GetCanUndo; - // is @link(Redo) possible? - property CanRedo: boolean read GetCanRedo; - // is the caret in the character or the hex pane ? - property InCharField: boolean read GetInCharField write SetInCharField; - // description of the next @link(Undo) action - property UndoDescription: string read GetUndoDescription; - // if True, the currently loaded file cannot be overwritten - property ReadOnlyFile: boolean read FIsFileReadonly write SetReadOnlyFile; - // if True, changes have been made to the data buffer content - property Modified: boolean read GetModified write SetModified; - // retrieves or stores the amount of data in the data buffer - // when enlarging the data stream, the @link(SetDataSizeFillByte) property - // tells which value to use to fill the new data - property DataSize: integer read GetDataSize write SetDataSize; - // array to the data buffer's content - property Data[Index: integer]: Byte read GetDataAt write SetDataAt; - // retrieve or set the data as string - property AsText: string read GetAsText write SetAsText; - // retrieve or set the data as hex formatted string (00 01 02 03...) - property AsHex: string read GetAsHex write SetAsHex; - // name of the file that has been loaded into the data buffer - property Filename: string read FFileName; - // retrieve or set bookmarks programmatically (see also @link(TMPHBookmark)) - property Bookmark[Index: byte]: TMPHBookmark read GetBookmark write - SetBookmark; - // has the byte at the given position been modified ? (only in overwrite mode) - property ByteChanged[index: integer]: boolean read HasChanged write - SetChanged; - // retrieves the number of columns (grid columns) - property ColCountRO: integer read GetPropColCount; - // retrieves the number of rows (grid rows) - property RowCountRO: integer read GetPropRowCount; - // returns True if the mouse cursor is positionned over selected data - property MouseOverSelection: boolean read GetMouseOverSelection; - // get the data value at the current caret position, returns -1 if an error occured - property CurrentValue: integer read GetCurrentValue; - // pointer to the whole data buffer's contents - //property DataPointer: Pointer read GetDataPointer; - // select all data - procedure SelectAll; - // retrieves the number of visible columns - property VisibleColCount; - // retrieves the number of visible rows - property VisibleRowCount; - // the control's canvas - property Canvas; - // current column (grid column) - property Col; - // first visible column - property LeftCol; - // current row (grid row) - property Row; - // first visible row (grid row) - property TopRow; - // this event is fired when a bookmark is added/modifed/removed - property OnBookmarkChanged: TNotifyEvent read FOnBookmarkChanged write - FOnBookmarkChanged; - // call this procedure to navigate to a bookmarked position - function GotoBookmark(const Index: integer): boolean; - // call this function if the external offset formatting changed (see @link(OnGetOffsetText)) - procedure UpdateGetOffsetText; - end; - - // published hex editor component - TMPHexEditor = class(TCustomMPHexEditor) - published - // @exclude(inherited) - property Align; - // @exclude(inherited) - property Anchors; - // @exclude(inherited) - property BiDiMode; - // @exclude(inherited) - property BorderStyle; - // @exclude(inherited) - property Constraints; - // @exclude(inherited) - property Ctl3D; - // @exclude(inherited) - property DragCursor; - // @exclude(inherited) - property DragKind; - // @exclude(inherited) - property DragMode; - // @exclude(inherited) - property Enabled; - // @exclude(inherited) - property Font; - // @exclude(inherited) - property ImeMode; - // @exclude(inherited) - property ImeName; - // @exclude(inherited) - property OnClick; - // @exclude(inherited) - property OnDblClick; - // @exclude(inherited) - property OnDragDrop; - // @exclude(inherited) - property OnDragOver; - // @exclude(inherited) - property OnEndDock; - // @exclude(inherited) - property OnEndDrag; - // @exclude(inherited) - property OnEnter; - // @exclude(inherited) - property OnExit; - // @exclude(inherited) - property OnKeyDown; - // @exclude(inherited) - property OnKeyPress; - // @exclude(inherited) - property OnKeyUp; - // @exclude(inherited) - property OnMouseDown; - // @exclude(inherited) - property OnMouseMove; - // @exclude(inherited) - property OnMouseUp; - // @exclude(inherited) - property OnMouseWheel; - // @exclude(inherited) - property OnMouseWheelDown; - // @exclude(inherited) - property OnMouseWheelUp; - // @exclude(inherited) - property OnStartDock; - // @exclude(inherited) - property OnStartDrag; - // @exclude(inherited) - property ParentBiDiMode; - // @exclude(inherited) - property ParentCtl3D; - // @exclude(inherited) - property ParentFont; - // @exclude(inherited) - property ParentShowHint; - // @exclude(inherited) - property PopupMenu; - // @exclude(inherited) - property ScrollBars; - // @exclude(inherited) - property ShowHint; - // @exclude(inherited) - property TabOrder; - // @exclude(inherited) - property TabStop; - // @exclude(inherited) - property Visible; - // see inherited @inherited - property BytesPerRow; - // see inherited @inherited - property BytesPerColumn; - // see inherited @inherited - property Translation; - // see inherited @inherited - property OffsetFormat; - // see inherited @inherited - property CaretKind; - // see inherited @inherited - property Colors; - // see inherited @inherited - property FocusFrame; - // see inherited @inherited - property SwapNibbles; - // see inherited @inherited - property MaskChar; - // see inherited @inherited - property NoSizeChange; - // see inherited @inherited - property AllowInsertMode; - // see inherited @inherited - property DrawGridLines; - // see inherited @inherited - property WantTabs; - // see inherited @inherited - property ReadOnlyView; - // see inherited @inherited - property HideSelection; - // see inherited @inherited - property GraySelectionIfNotFocused; - // see inherited @inherited - property GutterWidth; - // see inherited @inherited - property BookmarkBitmap; - - // see inherited @inherited - property Version; - - // see inherited @inherited - property MaxUndo; - // see inherited @inherited - property InsertMode; - // see inherited @inherited - property HexLowerCase; - // see inherited @inherited - property OnProgress; - // see inherited @inherited - property OnInvalidKey; - // see inherited @inherited - property OnTopLeftChanged; - // see inherited @inherited - property OnChange; - // see inherited @inherited - property DrawGutter3D; - // see inherited @inherited - property ShowRuler; - // see inherited @inherited - property BytesPerUnit; - // see inherited @inherited - property RulerBytesPerUnit; - // see inherited @inherited - property ShowPositionIfNotFocused; - // see inherited @inherited - property OnSelectionChanged; - // see inherited @inherited - property UnicodeChars; - // see inherited @inherited - property UnicodeBigEndian; - - // see inherited @inherited - property OnDrawCell; - - // see inherited @inherited - property OnBookmarkChanged; - // see inherited @inherited - property OnGetOffsetText; - // see inherited @inherited - property BytesPerBlock; - // see inherited @inherited - property SeparateBlocksInCharField; - // see inherited @inherited - property FindProgress; - // see inherited @inherited - property RulerNumberBase; - end; - - // @exclude(undo storage record) - PMPHUndoRec = ^TMPHUndoRec; - // @exclude(undo storage record) - TMPHUndoRec = packed record - DataLen: integer; - Flags: TMPHUndoFlags; - CurPos: integer; - Pos, Count, ReplCount: cardinal; - CurTranslation: TMPHTranslationKind; - CurBPU: Integer; - Buffer: byte; - end; - - // @exclude(implements undo/redo) - TMPHUndoStorage = class(TMemoryStream) - private - FCount, - FUpdateCount: integer; - FEditor: TCustomMPHexEditor; - FDescription: string; - FRedoPointer, - FLastUndo: PMPHUndoRec; - FLastUndoSize: integer; - FLastUndoDesc: string; - procedure SetCount(const Value: integer); - procedure ResetRedo; - procedure CreateRedo(const Rec: TMPHUndoRec); - function GetUndoKind(const Flags: TMPHUndoFlags): TMPHUndoFlag; - procedure AddSelection(const APos, ACount: integer); - function ReadUndoRecord(var aUR: TMPHUndoRec; var SDescription: string): - TMPHUndoFlag; - function GetLastUndoKind: TMPHUndoFlag; - public - constructor Create(AEditor: TCustomMPHexEditor); - destructor Destroy; override; - procedure SetSize(NewSize: longint); override; - procedure CreateUndo(aKind: TMPHUndoFlag; APosition, ACount, AReplaceCount: - integer; const SDescription: string = ''); - function CanUndo: boolean; - function CanRedo: boolean; - function Redo: boolean; - function Undo: boolean; - function BeginUpdate: integer; - function EndUpdate: integer; - procedure Reset(AResetRedo: boolean = True); - procedure RemoveLastUndo; - property Count: integer read FCount write SetCount; - property UpdateCount: integer read FUpdateCount; - property Description: string read FDescription; - property UndoKind: TMPHUndoFlag read GetLastUndoKind; - end; - -resourcestring - - // long descriptive names of character translations - // tkAsIs - MPH_TK_ASIS = 'Windows'; - // tkDos8 - MPH_TK_DOS8 = 'Dos 8 Bit'; - // tkASCII - MPH_TK_ASCII7 = 'ASCII 7 Bit'; - // tkMac - MPH_TK_MAC = 'Macintosh'; - // tkBCD - MPH_TK_BCD38 = 'EBCDIC Codepage 38'; - - // unicode - MPH_UC = 'Unicode Little Endian'; - // unicode be - MPH_UC_BE = 'Unicode Big Endian'; - - // short names (e.g. for status bars) of character translations - // tkAsIs - MPH_TK_ASIS_S = 'WIN'; - // tkDos8 - MPH_TK_DOS8_S = 'DOS'; - // tkASCII - MPH_TK_ASCII7_S = 'ASC'; - // tkMac - MPH_TK_MAC_S = 'MAC'; - // tkBCD - MPH_TK_BCD38_S = 'BCD'; - - // tkCustom - MPH_TK_CUSTOM_S = 'Cust'; - // tkCustom - MPH_TK_CUSTOM = 'Custom Translation'; - - // unicode - MPH_UC_S = 'UCLE'; - // unicode be - MPH_UC_BE_S = 'UCBE'; - -const - // long descriptions of the different translations (e.g. for menues) - MPHTranslationDesc: array[TMPHTranslationKind] of string = (MPH_TK_ASIS, - MPH_TK_DOS8, MPH_TK_ASCII7, MPH_TK_MAC, MPH_TK_BCD38, - MPH_TK_CUSTOM); - - // short descriptions of the different translations (e.g. for status bars) - MPHTranslationDescShort: array[TMPHTranslationKind] of string = - (MPH_TK_ASIS_S, MPH_TK_DOS8_S, MPH_TK_ASCII7_S, MPH_TK_MAC_S, - MPH_TK_BCD38_S, MPH_TK_CUSTOM_S); - - // public utility functions - -(* translate a hexadecimal data representation ("a000 cc45 d3 42"...) to binary data - (see @link(SwapNibbles) for the meaning of the SwapNibbles value) -*) -function ConvertHexToBin(aFrom, aTo: PChar; const aCount: integer; const - SwapNibbles: boolean; var BytesTranslated: integer): PChar; - -(* translate binary data to its hex representation (see @link(ConvertHexToBin)), - (see @link(SwapNibbles) for the meaning of the SwapNibbles value) -*) -function ConvertBinToHex(aFrom, aTo: PChar; const aCount: integer; const - SwapNibbles: boolean): PChar; - -// convert X and Y into a TGridCoord record -function GridCoord(aX, aY: longint): TGridCoord; -// check whether the given key (VK_...) is currently down -function IsKeyDown(aKey: integer): boolean; -// get a unique filename in the temporary directory -function GetTempName: string; - -(* translate an integer to a radix (base) coded string, e.g.
- - IntToRadix(100,16) converts into a hexadecimal (number) string
- - IntToRadix(100,2) converts into a string consisting only of 0 and 1
- - IntToRadix(100,8) means IntToOctal
-
- hint: Radix must be in the range of 2..16*) -function IntToRadix(Value: integer; Radix: byte): string; -function IntToRadix64(Value: int64; Radix: byte): string; -// translate an integer to a radix coded string and left fill with 0 (see also @link(IntToRadix)) -function IntToRadixLen(Value: integer; Radix, Len: byte): string; -function IntToRadixLen64(Value: int64; Radix, Len: byte): string; -// translate an integer to an octal string (see also @link(IntToRadix)) -function IntToOctal(const Value: integer): string; - -(* translate a radix coded number string into an integer, e.g.
- - RadixToInt('0f', 16) => 15
- - RadixToInt('755', 8) => 493 -*) -function RadixToInt(Value: string; Radix: byte): integer; -function RadixToInt64(Value: string; Radix: byte): int64; - -(* 64 bit unsigned integer arithmetics *) - -// division of two unsigned int64 values, may raise an exception on error -function DivideU64(const Dividend, Divisor: int64): int64; -// division of two unsigned int64 values, returns false if an error occurred -function TryDivideU64(const Dividend, Divisor: int64; - var Val: int64): boolean; -// modulo of two unsigned int64 values, may raise an exception on error -function ModuloU64(const Dividend, Divisor: int64): int64; -// modulo of two unsigned int64 values, returns false if an error occurred -function TryModuloU64(const Dividend, Divisor: int64; - var Val: int64): boolean; -// multiplication of two unsigned int64 values, may raise an exception on error -function MultiplyU64(const Multiplier, Multiplicator: int64): int64; -// multiplication of two unsigned int64 values, returns false if an error occurred -function TryMultiplyU64(const Multiplier, Multiplicator: int64; - var Val: int64): boolean; -// addition of two unsigned int64 values, may raise an exception on error -function AddU64(const Addend1, Addend2: int64): int64; -// addition of two unsigned int64 values, returns false if an error occurred -function TryAddU64(const Addend1, Addend2: int64; - var Val: int64): boolean; -// subtraction of two unsigned int64 values, may raise an exception on error -function SubtractU64(const Minuend, Subtrahend: int64): int64; -// subtraction of two unsigned int64 values, returns false if an error occurred -function TrySubtractU64(const Minuend, Subtrahend: int64; - var Val: int64): boolean; - -(* try to find the correct radix (based on prefix/suffix) and return the number, known - prefixes/suffixes are:
- 0x<number>, 0X<number>, $<number>, <number>h, <number>H: radix 16
- o<number>, O<number>, 0<number>, <number>o, <number>O: radix 8
- %<number>, <number>%: radix 2
- otherwise: radix 10 -*) -function CheckRadixToInt(Value: string): integer; -function CheckRadixToInt64(Value: string): int64; - -// translate an number string built on radix 8 into an integer (see also @link(RadixToInt)) -function OctalToInt(const Value: string): integer; - -// swap lo and high byte of a widechar -procedure SwapWideChar(var WChar: WideChar); - -// @exclude(fade a color to a gray value) -function FadeToGray(aColor: TColor): TColor; - -(* translate data from Ansi to a different character set (see also @link(TMPHTranslationKind))
- - TType: translate to this character set
- - aBuffer: pointer to source data
- - bBuffer: pointer to target data, must be allocated (may equal to aBuffer)
- - aCount: number of bytes to translate -*) -procedure TranslateBufferFromAnsi(const TType: TMPHTranslationKind; aBuffer, - bBuffer: PChar; const aCount: integer); -// translate data from a different character set to Ansi (see also @link(TranslateBufferFromAnsi)) -procedure TranslateBufferToAnsi(const TType: TMPHTranslationKind; aBuffer, - bBuffer: PChar; const aCount: integer); - -// compatibility -{$IFNDEF DELPHI6UP} -procedure RaiseLastOSError; -{$ENDIF} - -// returns the lower of the two numbers -function Min(a1, a2: integer): integer; -// returns the higer of the two numbers -function Max(a1, a2: integer): integer; - -var - (* translation tables for tkCustom *) - - // this character conversion is used in translations from tkAsIs to tkCustom (see @link(TMPHTranslationKind)) - MPHCustomCharConv: TMPHCharConv; - -const - (* standard offset formats *) - - // standard offset format: hex, auto min width, prefixed by 0x - MPHOffsetHex = '-!10:0x|'; - // standard offset format: decimal - MPHOffsetDec = 'a:|'; - // standard offset format: octal, suffixed by a small "o" - MPHOffsetOct = '0!8:o|'; - -implementation - -uses - Consts, {$IFDEF DELPHI6UP}RTLConsts, {$ENDIF}ImgList, StdCtrls, SysConst; - -const - MPH_VERSION = 'December 29, 2004; © markus stephany, vcl[at]mirkes[dot]de' ; - -resourcestring - - // undo descriptions - UNDO_BYTESCHANGED = 'Change Byte(s)'; - UNDO_REMOVED = 'Remove Data'; - UNDO_INSERT = 'Insert Buffer'; - UNDO_REPLACE = 'Replace'; - UNDO_APPEND = 'Append Buffer'; - UNDO_INSNIBBLE = 'Insert Nibble'; - UNDO_DELNIBBLE = 'Delete Nibble'; - UNDO_CONVERT = 'Convert'; - UNDO_SELECTION = 'Cursor movement'; - UNDO_COMBINED = 'Multiple Modification'; - UNDO_ALLDATA = 'All data saved'; - UNDO_NOUNDO = 'No Undo'; - - // error messages - ERR_FILE_OPEN_FAILED = 'Cannot open %s.'#13#10'(%s.)'; - ERR_FILE_READONLY = 'Cannot save readonly file %s.'; - ERR_INVALID_BOOKMARK = 'Invalid bookmark index'; - ERR_INVALID_SELSTART = 'Invalid selection start'; - ERR_INVALID_SELEND = 'Invalid selection end'; - ERR_INVALID_BYTESPERLINE = 'Invalid bytes per line argument'; - ERR_INVALID_BUFFERFROMFILE = 'Invalid buffer from file argument'; - ERR_INVALID_BYTESPERCOL = 'Invalid bytes per column argument'; - ERR_INVALID_BOOKMARKBMP = 'Invalid bookmark bitmap (must be 10 x 200 px)'; - ERR_CANCELLED = 'Operation Cancelled'; - ERR_MISSING_FORMATCHAR = 'Missing char in offset format: %s'; - ERR_INVALID_FORMATRADIX = - 'Invalid radix in offset format (%xh), allowed: 02h..10h'; - ERR_INVALID_RADIXCHAR = - 'Invalid character %s, cannot convert using radix %xh'; - ERR_INVALID_BPU = 'Invalid bytes per unit value %d, allowed: 1,2,4,8'; - ERR_INVALID_BPU_U = 'BytesPerUnit must be set to 2 in unicode mode'; - ERR_INVALID_RBPU = - 'Invalid ruler bytes per unit value %d, allowed: -1,1,2,4,8'; - ERR_DATA_BOUNDS = 'Data position/length out of data bounds'; - ERR_NO_TRANSLATION_IN_UNICODE_MODE = - 'Translations cannot be used in unicode mode'; - ERR_ODD_FILESIZE_UNICODE = 'Cannot use unicode mode with odd-sized files'; - - ERR_FIXED_FILESIZE = 'Cannot change fixed filesize'; - ERR_NOUNDO = 'Cannot update undo storage'; - - // new, empty file - UNNAMED_FILE = 'Untitled'; - -const - // fixed cols/rows - GRID_FIXED = 2; - - // available undo descriptions - STRS_UNDODESC: array[ufKindBytesChanged..ufKindAllData] of string = - (UNDO_BYTESCHANGED, UNDO_REMOVED, UNDO_INSERT, UNDO_REPLACE, UNDO_APPEND, - UNDO_INSNIBBLE, UNDO_DELNIBBLE, UNDO_CONVERT, UNDO_SELECTION, UNDO_COMBINED, - UNDO_ALLDATA); - - // valid hex characters - HEX_LOWER = '0123456789abcdef'; - HEX_UPPER = '0123456789ABCDEF'; - HEX_ALLCHARS = HEX_LOWER + HEX_UPPER; - -{$IFNDEF DELPHI6UP} - -procedure RaiseLastOSError; -begin - RaiseLastWin32Error; -end; -{$ENDIF} - -// invert the given color - -function Invert(Color: TColor): TColor; -begin - Result := ColorToRGB(Color) xor $00FFFFFF; -end; - -// translate the buffer from ANSI to the given translation mode - -procedure TranslateBufferFromAnsi(const TType: TMPHTranslationKind; aBuffer, - bBuffer: PChar; const aCount: integer); -var - LIntLoop: integer; -begin - case TType of - // changed 04/18/04: bBuffer and aBuffer were interchanged! - tkAsIs: Move(aBuffer^, bBuffer^, aCount); - tkDOS8, - tkASCII: CharToOEMBuff(aBuffer, bBuffer, aCount); - tkMAC: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := - MPH_CCONV_MAC[cctFromAnsi][Ord(aBuffer[LIntLoop])]; - tkBCD: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := - MPH_CCONV_BCD38[cctFromAnsi][Ord(aBuffer[LIntLoop])]; - - tkCustom: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := - MPHCustomCharConv[cctFromAnsi][Ord(aBuffer[LIntLoop])]; - - end; -end; - -// translate the buffer to ANSI from the given translation mode - -procedure TranslateBufferToAnsi(const TType: TMPHTranslationKind; aBuffer, - bBuffer: PChar; const aCount: integer); -var - LIntLoop: integer; -begin - case TType of - tkAsIs: Move(aBuffer^, bBuffer^, aCount); - tkDOS8, - tkASCII: OEMToCharBuff(aBuffer, bBuffer, aCount); - tkMAC: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := MPH_CCONV_MAC[cctToAnsi][Ord(aBuffer[LIntLoop])]; - tkBCD: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := - MPH_CCONV_BCD38[cctToAnsi][Ord(aBuffer[LIntLoop])]; - - tkCustom: if aCount > 0 then - for LIntLoop := 0 to Pred(aCount) do - bBuffer[LIntLoop] := - MPHCustomCharConv[cctToAnsi][Ord(aBuffer[LIntLoop])]; - - end; -end; - -// ansi to oem - -function OEM2Char(aByte: byte): char; -var - LszBuf: array[0..1] of char; -begin - LszBuf[0] := char(aByte); - LszBuf[1] := #0; - OEMToChar(LSzBuf, LSzBuf); - Result := LSzBuf[0]; -end; - -// oem to ansi - -function Char2OEM(aByte: byte): char; -var - LszBuf: array[0..1] of char; -begin - LszBuf[0] := char(aByte); - LszBuf[1] := #0; - CharToOEM(LSzBuf, LSzBuf); - Result := LSzBuf[0]; -end; - -(* helper functions *) - -// get a temporary file name - -function GetTempName: string; -var - LStrTemp: string; -begin - SetLength(LStrTemp, MAX_PATH + 1); - SetLength(LStrTemp, GetTempPath(MAX_PATH, @LStrTemp[1])); - LStrTemp := Trim(LStrTemp); -{$IFDEF DELPHI6UP} - LstrTemp := IncludeTrailingPathDelimiter(LstrTemp); -{$ELSE} - if LStrTemp[Length(LStrTemp)] <> '\' then - LStrTemp := LStrTemp + '\'; -{$ENDIF} - repeat - Result := LStrTemp + IntToHex(GetTickCount, 8) + '.MPHT'; - until GetFileAttributes(PChar(Result)) = $FFFFFFFF; -end; - -// can the file be opened for reading (possibly read only) ? - -function CanOpenFile(const aName: TFileName; var ReadOnly: boolean): boolean; -var - LHdlFile: THandle; -begin - Result := False; - ReadOnly := True; - if FileExists(aName) then - begin - LHdlFile := FileOpen(aName, fmOpenRead or fmShareDenyNone); - if LHdlFile <> INVALID_HANDLE_VALUE then - begin - FileClose(LHdlFile); - Result := True; - try - LHdlFile := FileOpen(aName, fmOpenReadWrite); - if LHdlFile <> INVALID_HANDLE_VALUE then - begin - FileClose(LHdlFile); - ReadOnly := False; - end; - except - Result := True; - ReadOnly := True; - end; - end; - end; -end; - -// is that key pressed ? - -function IsKeyDown(aKey: integer): boolean; -begin - Result := (GetKeyState(aKey) and (not 1)) <> 0; -end; - -// return the lesser value - -function Min(a1, a2: integer): integer; -begin - if a1 < a2 then - Result := a1 - else - Result := a2; -end; - -// return the bigger value - -function Max(a1, a2: integer): integer; -begin - if a1 > a2 then - Result := a1 - else - Result := a2; -end; - -// cast x,y to grid coord - -function GridCoord(aX, aY: longint): TGridCoord; -begin - Result.x := aX; - Result.y := aY; -end; - -// convert '00 01 02...' to binary data - -function ConvertHexToBin(aFrom, aTo: PChar; const aCount: integer; - const SwapNibbles: boolean; var BytesTranslated: integer): PChar; -var - LBoolHi: boolean; - LIntLoop: integer; - LBytCurrent: byte; - LChrCurrent: char; -begin - Result := aTo; - BytesTranslated := 0; - LBoolHi := True; - LBytCurrent := 0; - for LIntLoop := 0 to Pred(aCount) do - if Pos(aFrom[LIntLoop], HEX_ALLCHARS) <> 0 then - begin - LChrCurrent := UpCase(aFrom[LIntLoop]); - if LBoolHi then - LBytCurrent := ((Pos(LChrCurrent, HEX_UPPER) - 1) * 16) - else - LBytCurrent := LBytCurrent or ((Pos(LChrCurrent, HEX_UPPER) - 1)); - - LBoolHi := not LBoolHi; - if LBoolHi then - begin - if SwapNibbles then - aTo[BytesTranslated] := char(((LBytCurrent and 15) * 16) or - ((LBytCurrent and $F0) shr 4)) - else - aTo[BytesTranslated] := char(LBytCurrent); - - Inc(BytesTranslated); - end; - end; -end; - -// convert binary data to '00 01 02...' - -function ConvertBinToHex(aFrom, aTo: PChar; const aCount: integer; - const SwapNibbles: boolean): PChar; -var - LIntLoop: integer; - LByteCurrent: byte; - LIntLoop2: integer; -begin - Result := aTo; - LIntLoop2 := 0; - for LIntLoop := 0 to Pred(aCount) do - begin - LByteCurrent := Ord(aFrom[LIntLoop]); - if SwapNibbles then - begin - aTo[LIntLoop2] := UpCase(HEX_UPPER[(LByteCurrent and 15) + 1]); - aTo[LIntLoop2 + 1] := UpCase(HEX_UPPER[(LByteCurrent shr 4) + 1]) - end - else - begin - aTo[LIntLoop2 + 1] := UpCase(HEX_UPPER[(LByteCurrent and 15) + 1]); - aTo[LIntLoop2] := UpCase(HEX_UPPER[(LByteCurrent shr 4) + 1]) - end; - - Inc(LIntLoop2, 2); - end; - aTO[LIntLoop2] := #0; -end; - -// translate an integer to a radix coded string - -function IntToRadix(Value: integer; Radix: byte): string; -begin - Result := IntToRadixLen(Value, Radix, 0); -end; - -function IntToRadix64(Value: int64; Radix: byte): string; -begin - Result := IntToRadixLen64(Value, Radix, 0); -end; - -// translate an integer to a radix coded string and left fill with 0 - -function IntToRadixLen(Value: integer; Radix, Len: byte): string; -var - LCrdTemp: cardinal absolute Value; -begin - Result := ''; - repeat - Result := HEX_UPPER[(LCrdTemp mod Radix) + 1] + Result; - LCrdTemp := LCrdTemp div Radix; - until LCrdTemp = 0; - while Length(Result) < Len do - Result := '0' + Result; -end; - -// unsigned 64 bit integer routines (division and modulo) -// this code is derived from assembler code written by -// Norbert Juffa, found on "the assembly gems page" -// (http://www.df.lth.se/~john_e/) - -procedure _UModDiv64; -begin - asm - // divisor > 2^32-1 ? - test ecx, ecx - - // yes, divisor > 32^32-1 - jnz @big_divisor - - // only one division needed ? (ecx = 0) - cmp edx, ebx - - // yes, one division sufficient - jb @one_div - - // save dividend-lo in ecx - mov ecx, eax - - // get dividend-hi - mov eax, edx - - // zero extend it into edx:eax - xor edx, edx - - // quotient-hi in eax - div ebx - - // ecx = quotient-hi, eax =dividend-lo - xchg eax, ecx - -@one_div: - - // eax = quotient-lo - div ebx - - //ebx = remainder-lo - mov ebx, edx - - //edx = quotient-hi(quotient in edx:eax) - mov edx, ecx - - // ecx = remainder-hi (rem. in ecx:ebx) - xor ecx, ecx - jmp @cleanup; - -@big_divisor: - - // save dividend - push edx - push eax - - // divisor now in edi:ebx and ecx:esi - mov esi, ebx - mov edi, ecx - - // shift both divisor and and dividend right by 1 bit - shr edx, 1 - rcr eax, 1 - ror edi, 1 - rcr ebx, 1 - - // ecx = number of remaining shifts - bsr ecx, ecx - - // scale down divisor and dividend such that divisor less than 2^32 (i.e. fits in ebx) - shrd ebx, edi, CL - shrd eax, edx, CL - shr edx, CL - - // restore original divisor (edi:esi) - rol edi, 1 - - // compute quotient - div ebx - - // get dividend lo-word - pop ebx - - // save quotient - mov ecx, eax - - // quotient * divisor hi-word (low only) - imul edi, eax - - // quotient * divisor lo-word - mul esi - - // edx:eax = quotient * divisor - add edx, edi - - // dividend-lo - (quot.*divisor)-lo - sub ebx, eax - - // get quotient - mov eax, ecx - - // restore dividend hi-word - pop ecx - - // subtract divisor * quot. from dividend - sbb ecx, edx - - // 0 if remainder > 0, else FFFFFFFFh - sbb edx, edx - - // nothing to add - and esi, edx - - // back if remainder positive - and edi, edx - - // correct remaider and quotient if necessary - add ebx, esi - adc ecx, edi - add eax, edx - - // clear hi-word of quot (eax<=FFFFFFFFh) - xor edx, edx - -@cleanup: - end; -end; - -{$WARNINGS OFF} - -function UDiv64(I1, I2: Int64): int64; -begin - asm - // save registers - push ebp - push ebx - push esi - push edi - - // load I2 into ebx/ecx - mov ebx, [ebp+$08]; - mov ecx, [ebp+$0c]; - - // load I1 into eax/edx - mov eax, [ebp+$10]; - mov edx, [ebp+$14]; - - call _UModDiv64 - - // store result (division result is in eax:edx) - mov [ebp-$08], eax; - mov [ebp-$04], edx; - - // restore registers - pop edi - pop esi - pop ebx - pop ebp - end; -end; - -function UMod64(I1, I2: Int64): int64; -begin - asm - // save registers - push ebp - push ebx - push esi - push edi - - // load I2 into ebx/ecx - mov ebx, [ebp+$08]; - mov ecx, [ebp+$0c]; - - // load I1 into eax/edx - mov eax, [ebp+$10]; - mov edx, [ebp+$14]; - - call _UModDiv64 - - // store result (division remainder is in ebx:ecx) - mov [ebp-$08], ebx; - mov [ebp-$04], ecx; - - // restore registers - pop edi - pop esi - pop ebx - pop ebp - end; -end; -{$WARNINGS ON} - -(* 64 bit unsigned integer arithmetics *) -function DivideU64(const Dividend, Divisor: int64): int64; -begin - Result := UDiv64(Dividend, Divisor); -end; - -function TryDivideU64(const Dividend, Divisor: int64; - var Val: int64): boolean; -begin - Result := True; - try - Val := UDiv64(Dividend, Divisor); - except - Result := False; - end; -end; - -function ModuloU64(const Dividend, Divisor: int64): int64; -begin - Result := UMod64(Dividend, Divisor); -end; - -function TryModuloU64(const Dividend, Divisor: int64; - var Val: int64): boolean; -begin - Result := True; - try - Val := UMod64(Dividend, Divisor); - except - Result := False; - end; -end; - -// unsigned 64 bit integer routines (multiplication, addition, substraction) -// this code is derived from assembler code found in the online book -// "Art of Assembly Programming" maintained by Randall Hyde -// (http://webster.cs.ucr.edu/) - -function TryMultiplyU64(const Multiplier, Multiplicator: int64; - var Val: int64): boolean; -asm - // save registers - push ebx - push esi - - mov byte ptr result, 1 - - // store val pointer - mov esi, eax - - // multiply lo dword of multiplier * lo dword of multiplicator - mov eax, dword ptr Multiplier - mul dword ptr Multiplicator - - // save lo dword - mov dword [esi], eax - - // save hi dword of partial product - mov ecx, edx - - // multiply lo dword of multiplier * hi dword of multiplicator - mov eax, dword ptr Multiplier - mul dword ptr Multiplicator+4 - - // add to the partial product (including carry) - add eax, ecx - adc edx, 0 - - // save partial product - mov ebx, eax - mov ecx, edx - - // multiply hi dword of multiplier * lo dword of multiplicator - mov eax, dword ptr Multiplier+4 - mul dword ptr Multiplicator - - // add the partial product - add eax, ebx - - // save the partial product - mov dword ptr [esi+4], eax - - // add in the carry flag - adc ecx, edx - - // save carry - pushfd - - // multiply hi dword of multiplier * hi dword of multiplicator - mov eax, dword ptr Multiplier+4 - mul dword ptr Multiplicator+4 - - // load carry - popfd - - // add partial product + carry - adc eax, ecx - adc edx, 0 - - // check overflow - test eax, eax - jnz @over - test edx, edx - jz @finish - -@over: - // overflow - mov byte ptr result, 0 - -@finish: - // restore register - pop esi - pop ebx -end; - -function MultiplyU64(const Multiplier, Multiplicator: int64): int64; -begin - if not TryMultiplyU64(Multiplier, Multiplicator, Result) then - raise EIntOverflow.Create(SIntOverflow); -end; - -function TryAddU64(const Addend1, Addend2: int64; - var Val: int64): boolean; -asm - mov byte ptr result, 1 - - // store val pointer - mov edx, eax - - // add lo dwords - mov eax, dword ptr Addend1 - add eax, dword ptr Addend2 - - // store lo dword - mov dword ptr [edx], eax - - // add hi dwords + carry - mov eax, dword ptr Addend1+4 - adc eax, dword ptr Addend2+4 - - // store hi dword - mov dword ptr [edx+4], eax - - // check carry - jnc @finish - mov byte ptr result, 0 -@finish: -end; - -function AddU64(const Addend1, Addend2: int64): int64; -begin - if not TryAddU64(Addend1, Addend2, Result) then - raise EIntOverflow.Create(SIntOverflow); -end; - -function TrySubtractU64(const Minuend, Subtrahend: int64; - var Val: int64): boolean; -asm - mov byte ptr result, 1 - - // store val pointer - mov edx, eax - - // subtract lo dwords - mov eax, dword ptr Minuend - sub eax, dword ptr Subtrahend - - // store lo dword - mov dword ptr [edx], eax - - // subtract hi dwords - carry - mov eax, dword ptr Minuend+4 - sbb eax, dword ptr Subtrahend+4 - - // store hi dword - mov dword ptr [edx+4], eax - - // check carry - jnc @finish - mov byte ptr result, 0 -@finish: -end; - -function SubtractU64(const Minuend, Subtrahend: int64): int64; -begin - if not TrySubtractU64(Minuend, Subtrahend, Result) then - raise EIntOverflow.Create(SIntOverflow); -end; - -function IntToRadixLen64(Value: int64; Radix, Len: byte): string; -begin - Result := ''; - repeat - Result := HEX_UPPER[UMod64(Value, Radix) + 1] + Result; - Value := UDiv64(Value, Radix); - until Value = 0; - while Length(Result) < Len do - Result := '0' + Result; -end; - -// translate an integer value to an octal string - -function IntToOctal(const Value: integer): string; -begin - Result := IntToRadix(Value, 8); -end; - -// translate a radix coded string into an integer - -function RadixToInt(Value: string; Radix: byte): integer; -var - LCrdTemp: cardinal absolute Result; -begin - LCrdTemp := 0; - Value := UpperCase(Value); - while Value <> '' do - begin - if not (Pos(Value[1], HEX_UPPER) in [1..Radix]) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_RADIXCHAR, [Value[1], Radix]); - LCrdTemp := LCrdTemp * Radix + cardinal(Pos(Value[1], HEX_UPPER) - 1); - Delete(Value, 1, 1); - end; -end; - -function RadixToInt64(Value: string; Radix: byte): int64; -begin - Result := 0; - Value := UpperCase(Value); - while Value <> '' do - begin - if not (Pos(Value[1], HEX_UPPER) in [1..Radix]) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_RADIXCHAR, [Value[1], Radix]); - Result := Result * Radix + cardinal(Pos(Value[1], HEX_UPPER) - 1); - Delete(Value, 1, 1); - end; -end; - -(* try to find the correct radix (based on prefix/suffix) and return the number, known - prefixes/suffixes are:
- 0x, 0X, $, h, H: radix 16
- o, O, o, O: radix 8
- %, %: radix 2
- otherwise: radix 10 -*) - -function CheckRadixToInt(Value: string): integer; -begin - // hex - if UpperCase(Copy(Value, 1, 2)) = '0X' then - Result := RadixToInt(Copy(Value, 3, MaxInt), 16) - else if Copy(Value, 1, 1) = '$' then - Result := RadixToInt(Copy(Value, 2, MaxInt), 16) - else if UpperCase(Copy(Value, Length(Value), 1)) = 'H' then - Result := RadixToInt(Copy(Value, 1, Length(Value) - 1), 16) - else {// octal} if UpperCase(Copy(Value, Length(Value), 1)) = 'O' then - Result := RadixToInt(Copy(Value, 1, Length(Value) - 1), 8) - else if UpperCase(Copy(Value, 1, 1)) = 'O' then - Result := RadixToInt(Copy(Value, 2, MaxInt), 8) - (* removed, is ambigous else if (Copy(Value, 1, 1) = '0') and (AllCharsIn(['0'..'7'])) then - Result := RadixToInt(Value, 8)*) - else {// binary} if UpperCase(Copy(Value, Length(Value), 1)) = '%' then - Result := RadixToInt(Copy(Value, 1, Length(Value) - 1), 2) - else if UpperCase(Copy(Value, 1, 1)) = '%' then - Result := RadixToInt(Copy(Value, 2, MaxInt), 2) - else - // decimal - Result := StrToInt(Value); -end; - -function CheckRadixToInt64(Value: string): int64; -begin - // hex - if UpperCase(Copy(Value, 1, 2)) = '0X' then - Result := RadixToInt64(Copy(Value, 3, MaxInt), 16) - else if Copy(Value, 1, 1) = '$' then - Result := RadixToInt64(Copy(Value, 2, MaxInt), 16) - else if UpperCase(Copy(Value, Length(Value), 1)) = 'H' then - Result := RadixToInt64(Copy(Value, 1, Length(Value) - 1), 16) - else {// octal} if UpperCase(Copy(Value, Length(Value), 1)) = 'O' then - Result := RadixToInt64(Copy(Value, 1, Length(Value) - 1), 8) - else if UpperCase(Copy(Value, 1, 1)) = 'O' then - Result := RadixToInt64(Copy(Value, 2, MaxInt), 8) - (* removed, is ambigous else if (Copy(Value, 1, 1) = '0') and (AllCharsIn(['0'..'7'])) then - Result := RadixToInt(Value, 8)*) - else {// binary} if UpperCase(Copy(Value, Length(Value), 1)) = '%' then - Result := RadixToInt64(Copy(Value, 1, Length(Value) - 1), 2) - else if UpperCase(Copy(Value, 1, 1)) = '%' then - Result := RadixToInt64(Copy(Value, 2, MaxInt), 2) - else - // decimal - Result := StrToInt64(Value) -end; - -// translate an octal to an integer - -function OctalToInt(const Value: string): integer; -begin - Result := RadixToInt(Value, 8); -end; - -// swap lo and high byte of a widechar - -procedure SwapWideChar(var WChar: WideChar); -var - LWrdChar: word absolute WChar; -begin - LWrdChar := Swap(LWrdChar); -end; - -// fade a color to a gray value - -function FadeToGray(aColor: TColor): TColor; -var - LBytGray: byte; -begin - aColor := ColorToRGB(aColor); - LBytGray := HiByte(GetRValue(aColor) * 74 + GetGValue(aColor) * 146 + - GetBValue(aColor) * 36); - Result := RGB(LBytGray, LBytGray, LBytGray); -end; - -(* TCustomMPHexEditor *) - -constructor TCustomMPHexEditor.Create(aOwner: TComponent); -var - LIntLoop: integer; -begin - inherited Create(aOwner); -{$IFDEF FASTACCESS} - FSetDataSizeFillByte := 0; -{$ENDIF} - FMaskedChars := [#0..#31]; - FRulerNumberBase := 16; - FOffsetHandler := False; - FOnFind := nil; - FOnWildcardFind := nil; - FFindProgress := False; - FBlockSize := -1; - FSepCharBlocks := True; - FUnicodeCharacters := False; - FUnicodeBigEndian := False; - FSelectionChangedCount := 0; - FBytesPerUnit := 1; - FRulerBytesPerUnit := -1; - FUsedRulerBytesPerUnit := 1; - FShowPositionIfNotFocused := False; - FShowRuler := False; - FDrawGutter3D := True; - FHexLowerCase := True; - SetHexLowerCase(False); - DoubleBuffered := True; - FBookmarkBitmap := TBitmap.Create; - FCursorList := nil; - FHasCustomBMP := False; - FStreamFileName := ''; - FHasFile := False; - FMaxUndo := 1024 * 1024; - FPosInCharField := False; - FLastPosInCharField := True; - - FGutterWidth := -1; - GenerateOffsetFormat(MPHOffsetHex); - FSelectionPossible := True; - FBookmarkImageList := TImageList.Create(self); - FBookmarkImageList.DrawingStyle := dsTransparent; - FBookmarkImageList.BkColor := clBlack; - FBookmarkImageList.Width := 10; - FBookmarkImageList.Height := 10; - - Options := [goThumbTracking]; - DesignOptionsBoost := []; - DefaultDrawing := False; - FSaveCellExtents := False; - - FColors := TMPHColors.Create(Self); - FDrawGridLines := False; - - ParentColor := False; - FDataStorage := TMPHMemoryStream.Create; - FUndoStorage := TMPHUndoStorage.Create(self); - - Color := FColors.Background; - - FCharWidth := -1; - FOffSetDisplayWidth := -1; - FBytesPerRow := 16; - FCaretKind := ckAuto; - FFocusFrame := True; - FSwapNibbles := 0; - FFileName := '---'; - - Font.Name := 'Courier New'; - Font.Size := 11; - BorderStyle := bsSingle; - FBytesPerCol := 4; - CTL3D := False; - Cursor := crIBeam; - FModifiedBytes := TBits.Create; - for LIntLoop := Low(FBookmarks) to High(FBookmarks) do - FBookmarks[LIntLoop].mPosition := -1; - SetSelection(-1, -1, -1); - FIsSelecting := False; - ResetUndo; - DefaultColWidth := 0; - DefaultRowHeight := 0; - RowHeights[0] := 0; - RowHeights[1] := 0; - ColCount := CalcColCount; - RowCount := GRID_FIXED + 1; - FTranslation := tkAsIs; - FModified := False; - FIsFileReadonly := True; - FBytesPerRowDup := 2 * FBytesPerRow; - FIntLastHexCol := (GRID_FIXED + FBytesPerRowDup - 1); - FReplaceUnprintableCharsBy := '.'; - FCaretBitmap := TBitmap.Create; - FFixedFileSize := False; - FFixedFileSizeOverride := False; - FAllowInsertMode := True; - FInsertModeOn := False; - FWantTabs := True; - FReadOnlyView := False; - FHideSelection := False; - FGraySelOnLostFocus := False; - FOnProgress := nil; - FShowDrag := False; - FSelBeginPosition := -1; - FBookmarkBitmap.OnChange := BookmarkBitmapChanged; - FBookmarkBitmap.LoadFromResourceName(HINSTANCE, 'BOOKMARKICONS'); - SetRulerString; -{$IFDEF DELPHI7UP} - ControlStyle := ControlStyle + [csNeedsBorderPaint]; -{$ENDIF} -end; - -destructor TCustomMPHexEditor.Destroy; -begin - - FCursorList := nil; - FBookmarkBitmap.OnChange := nil; - FreeStorage; - FreeStorage(True); - FUndoStorage.Free; - FDataStorage.Free; - FModifiedBytes.Free; - FColors.Free; - FCaretBitmap.Free; - FBookmarkImageList.Free; - FBookmarkBitmap.Free; - inherited Destroy; -end; - -procedure TCustomMPHexEditor.AdjustMetrics; -var - LIntLoop: integer; - LIntChWidth: integer; -begin - Canvas.Font.Assign(Font); - FCharWidth := Canvas.TextWidth('w'); - - SetOffsetDisplayWidth; - DoSetCellWidth(1, 6); - - for LIntLoop := 0 to FBytesPerRowDup do - begin - if LIntLoop = Pred(FBytesPerRowDup) then - LIntChWidth := FCharWidth * 2 - else - begin - LIntChWidth := FCharWidth; - if (((LIntLoop + GRID_FIXED) mod FBytesPerCol) = 1) then - Inc(LIntChWidth, FCharWidth); - if (FBlockSize > 1) and (((LIntLoop + GRID_FIXED) mod (FBlockSize * 2)) = - 1) then - Inc(LIntChWidth, FCharWidth); - end; - DoSetCellWidth(LIntLoop + GRID_FIXED, LIntChWidth); - end; - - if FUnicodeCharacters then - LIntLoop := Pred(FBytesPerRow div 2) - else - LIntLoop := Pred(FBytesPerRow); - for LIntLoop := 0 to LIntLoop do - //FBytesPerRowDup + 1 to (FBytesPerRow * 3) - 1 do - begin - if (FUsedRulerBytesPerUnit > 1) and ((LIntLoop mod FUsedRulerBytesPerUnit) - = Pred(FUsedRulerBytesPerUnit)) and (not FUnicodeCharacters) then - LIntChWidth := (FCharWidth * 3 div 2) + 1 - else - LIntChWidth := FCharWidth + 1; - if not FUnicodeCharacters then - begin - if (FBlockSize > 1) and FSepCharBlocks and ((LIntLoop mod FBlockSize) = - Pred(FBlockSize)) then - Inc(LIntChWidth, FCharWidth); - end - else - begin - if (FBlockSize > 1) and FSepCharBlocks and ((LIntLoop mod (FBlockSize div - 2)) = Pred(FBlockSize div 2)) then - Inc(LIntChWidth, FCharWidth); - end; - DoSetCellWidth(LIntLoop + GRID_FIXED + FBytesPerRowDup + 1, LIntChWidth); - end; - - DoSetCellWidth(GetLastCharCol, (FCharWidth * 2) + 1); - - FCharHeight := Canvas.TextHeight('yY') + 2; - DefaultRowHeight := FCharHeight; - RowHeights[1] := 0; - if FShowRuler then - RowHeights[0] := DefaultRowHeight + 3 - else - RowHeights[0] := 0; - CheckSetCaret; -end; - -function TCustomMPHexEditor.GetDataSize: integer; -begin - Result := FDataStorage.Size; -end; - -procedure TCustomMPHexEditor.CreateEmptyFile; -begin - FreeStorage; - if TempName = '' then - FFileName := UNNAMED_FILE - else - FFileName := TempName; - ResetUndo; - ResetSelection(False); - FModifiedBytes.Size := 0; - CalcSizes; - FModified := False; - FIsFileReadonly := True; - FHasFile := False; - MoveColRow(GRID_FIXED, GRID_FIXED, True, True); - Changed; -end; - -procedure TCustomMPHexEditor.SaveToStream(Strm: TStream); -begin - WaitCursor; - try - FDataStorage.Position := 0; - - Stream2Stream(FDataStorage, Strm, pkSave); - finally - Invalidate; - OldCursor; - end; -end; - -procedure TCustomMPHexEditor.SaveRangeToStream(Strm: TStream; const APosition, - ACount: integer); -begin - WaitCursor; - try - FDataStorage.Position := APosition; - Stream2Stream(FDataStorage, Strm, pkSave, ACount); - finally - Invalidate; - OldCursor; - end; -end; - -procedure TCustomMPHexEditor.SaveToFile(const Filename: string; - const aUnModify: boolean = True); -var - LfstFile: TFileStream; -begin - if (FFileName = FileName) then - PrepareOverwriteDiskFile; - - LfstFile := TFileStream.Create(FileName, fmCreate); - try - FStreamFileName := FileName; - SaveToStream(LfstFile); - FHasFile := True; - if aUnModify then - begin - FModifiedBytes.Size := 0; - FModified := False; - FIsFileReadonly := False; - FFileName := Filename; - FDataStorage.Position := 0; - ResetUndo; - end; - finally - FStreamFileName := ''; - LfstFile.Free; - end; -end; - -procedure TCustomMPHexEditor.LoadFromStream(Strm: TStream); -begin - try - FreeStorage; - CalcSizes; - WaitCursor; - try - try - Strm.Position := 0; - FDataStorage.Size := Strm.Size; - FDataStorage.Position := 0; - - Stream2Stream(Strm, FDataStorage, pkLoad); - //FDataStorage.CopyFrom(Strm, Strm.Size - Strm.Position); - - FDataStorage.Position := 0; - finally - with FUndoStorage do - if UpdateCount < 1 then - Reset; - FModifiedBytes.Size := 0; - CalcSizes; - FModified := False; - FIsSelecting := False; - MoveColRow(GRID_FIXED, GRID_FIXED, True, True); - Changed; - end; - finally - OldCursor; - end; - except - FreeStorage; - FreeStorage(True); - FHasFile := False; - raise; - end; -end; - -procedure TCustomMPHexEditor.LoadFromFile(const Filename: string); -var - LfstFile: TFileStream; -begin - if CanOpenFile(FileName, FIsFileReadonly) then - begin - LfstFile := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); - try - FStreamFileName := FileName; - try - LoadFromStream(LfstFile); - except - FHasFile := False; - raise; - end; - FFileName := FileName; - FHasFile := True; - finally - FStreamFileName := ''; - LfstFile.Free; - end; - end - else - raise EFOpenError.CreateFmt(ERR_FILE_OPEN_FAILED, [FileName, - SysErrorMessage(GetLastError)]); -end; - -procedure TCustomMPHexEditor.CalcSizes; -var - LIntRows: integer; -begin - if FModifiedBytes.Size > DataSize then - FModifiedBytes.Size := DataSize; - - if DataSize < 1 then - begin - RowCount := GRID_FIXED + 1; - ColCount := CalcColCount; - FixedCols := GRID_FIXED; - end - else - begin - LIntRows := (DataSize + (FBytesPerRow - 1)) div FBytesPerRow; - if ((DataSize mod FBytesPerRow) = 0) and InsertMode then - INC(LIntRows); - RowCount := LIntRows + GRID_FIXED; - - ColCount := CalcColCount; - FixedCols := GRID_FIXED; - end; - FixedRows := GRID_FIXED; - AdjustMetrics; -end; - -function TCustomMPHexEditor.TranslateFromAnsiChar(const aByte: byte): char; -begin - case FTranslation of - tkAsIs: Result := char(aByte); - tkDos8, - tkASCII: - begin - if ((FTranslation = tkDos8) or (aByte < 128)) and (aByte > 31) then - Result := Char2Oem(aByte) - else - Result := #0; - end; - tkMac: Result := MPH_CCONV_MAC[cctFromAnsi][aByte]; - tkBCD: Result := MPH_CCONV_BCD38[cctFromAnsi][aByte]; - - tkCustom: Result := MPHCustomCharConv[cctFromAnsi][aByte]; - - else - Result := #0; - end; - if Result in FMaskedChars then - Result := #0; -end; - -function TCustomMPHexEditor.TranslateToAnsiChar(const aByte: byte): char; -begin - case FTranslation of - tkAsIs: Result := char(aByte); - tkDos8, - tkASCII: - begin - Result := Oem2Char(aByte); - if ((FTranslation = tkASCII) and (aByte > 127)) then - Result := FReplaceUnprintableCharsBy; - end; - tkMac: Result := MPH_CCONV_MAC[cctToAnsi][aByte]; - tkBCD: Result := MPH_CCONV_BCD38[cctToAnsi][aByte]; - - tkCustom: Result := MPHCustomCharConv[cctToAnsi][aByte]; - - else - Result := FReplaceUnprintableCharsBy; - end; - - if (FReplaceUnprintableCharsBy <> #0) and (Result in FMaskedChars) then - Result := FReplaceUnprintableCharsBy; -end; - -// get the position of the drag marker - -function TCustomMPHexEditor.DropPosition: integer; -var - LBoolInCharField: boolean; -begin - Result := -1; - LBoolInCharField := FPosInCharField; - try - if FShowDrag then - begin - Result := GetPosAtCursor(FDropCol, FDropRow); - CheckUnit(Result); - end; - finally - FPosInCharField := LBoolInCharField; - end; -end; - -procedure TCustomMPHexEditor.Stream2Stream(strFrom, strTo: TStream; - const Operation: TMPHProgressKind; const Count: integer = -1); -var - LBytProgress, LBytLastProgress: byte; - LIntRemain, LIntRead, LIntCount: integer; - LBoolCancel: boolean; - LStrFile: string; - - LBytBuffer: array[0..MPH_FILEIO_BLOCKSIZE - 1] of byte; -begin - LIntCount := Count; - if LIntCount = -1 then - LIntCount := strFrom.Size - strFrom.Position; - - LIntRemain := LIntCount; - LBoolCancel := False; - LBytLastProgress := 255; - LStrFile := FStreamFileName; - if LStrFile = '' then - LStrFile := FFileName; - - while LIntRemain > 0 do - begin - LBytProgress := Round(((LIntCount - LIntRemain) / LIntCount) * 100); - if (LBytProgress <> LBytLastProgress) or (LIntRemain <= - MPH_FILEIO_BLOCKSIZE) then - begin - if LIntRemain <= MPH_FILEIO_BLOCKSIZE then - LBytLastProgress := 100 - else - LBytLastProgress := LBytProgress; - if Assigned(FOnProgress) then - begin - FOnProgress(self, Operation, LStrFile, LBytLastProgress, - LBoolCancel); - if LBoolCancel then - raise EMPHexEditor.Create(ERR_CANCELLED); - end - end; - - LIntRead := Min(LIntRemain, MPH_FILEIO_BLOCKSIZE); - strFrom.ReadBuffer(LBytBuffer, LIntRead); - strTo.WriteBuffer(LBytBuffer, LIntRead); - Dec(LIntRemain, LIntRead); - end; -end; - -function TCustomMPHexEditor.SelectCell(ACol, ARow: longint): boolean; -var - LIntCurRow: integer; - LRctCellRect: TRect; - LIntOtherFieldCol: integer; - LIntNewPosition, LIntPrevPosition: integer; -begin - LIntCurRow := Row; - if DataSize > 0 then - Result := CheckSelectCell(aCol, aRow) - else - begin - if not ((aCol = GRID_FIXED) or (aCol = Max(GetOtherFieldColCheck(GRID_FIXED) - , GRID_FIXED)) and (aRow = GRID_FIXED)) then - Result := False - else - begin - LRctCellRect := CellRect(aCol, aRow); - if LRctCellRect.Left + LRctCellRect.Bottom = 0 then - IntSetCaretPos(-50, -50, -1) - else - IntSetCaretPos(LRctCellRect.Left, LRctCellRect.Top, aCol); - Result := True; - Exit; - end; - end; - - if Result then - begin - //cursor in anderem feld löschen - if (aCol <> Col) or (aRow <> Row) then - begin - LIntOtherFieldCol := GetOtherFieldColCheck(Col); - LRctCellRect := CellRect(LIntOtherFieldCol, LIntCurRow); - InvalidateRect(Handle, @LRctCellRect, False); - if FShowRuler and (aCol <> Col) then - begin - LRctCellRect := CellRect(LIntOtherFieldCol, 0); - InvalidateRect(Handle, @LRctCellRect, False); - LRctCellRect := CellRect(Col, 0); - InvalidateRect(Handle, @LRctCellRect, False); - end; - - // cursor in anderem feld setzen - LIntOtherFieldCol := GetOtherFieldColCheck(aCol); - LRctCellRect := CellRect(LIntOtherFieldCol, aRow); - InvalidateRect(Handle, @LRctCellRect, False); - if FShowRuler and (aCol <> Col) then - begin - LRctCellRect := CellRect(LIntOtherFieldCol, 0); - InvalidateRect(Handle, @LRctCellRect, False); - LRctCellRect := CellRect(aCol, 0); - InvalidateRect(Handle, @LRctCellRect, False); - end; - - if LIntCurRow <> aRow then - begin - LRctCellRect := CellRect(0, LIntCurRow); - InvalidateRect(Handle, @LRctCellRect, False); - LRctCellRect := CellRect(0, aRow); - InvalidateRect(Handle, @LRctCellRect, False); - end; - end; - - if FIsSelecting then - begin - LIntNewPosition := GetPosAtCursor(aCol, aRow); - LIntPrevPosition := GetPosAtCursor(Col, Row); - if FSelBeginPosition = -1 then - FSelBeginPosition := LIntPrevPosition; - if not InsertMode then - begin - CheckSelectUnit(FSelBeginPosition, LIntNewPosition); - NewSelection(FSelBeginPosition, LIntNewPosition); - end - else - begin - if FSelBeginPosition > LIntNewPosition then - begin - CheckUnit(FSelBeginPosition); - CheckUnit(LIntNewPosition); - if FSelBeginPosition = LIntNewPosition then - begin - ResetSelection(True); - FSelBeginPosition := LIntNewPosition; - FIsSelecting := True; - end - else - begin - NewSelection(FSelBeginPosition - FBytesPerUnit, LIntNewPosition); - end; - end - else if FSelBeginPosition < LIntNewPosition then - begin - CheckUnit(FSelBeginPosition); - CheckUnit(LIntNewPosition); - if FSelBeginPosition = LIntNewPosition then - begin - ResetSelection(True); - FSelBeginPosition := LIntNewPosition; - FIsSelecting := True; - end - else - begin - NewSelection(FSelBeginPosition, LIntNewPosition - FBytesPerUnit); - end; - end - else - begin - ResetSelection(True); - FSelBeginPosition := LIntNewPosition; - FIsSelecting := True; - end - end; - end - else - ResetSelection(True); - - // caret neu setzen - //CheckSetCaret; - LRctCellRect := CellRect(aCol, aRow); - if LRctCellRect.Left + LRctCellRect.Bottom = 0 then - IntSetCaretPos(-50, -50, -1) - else - IntSetCaretPos(LRctCellRect.Left, LRctCellRect.Top, aCol); - SelectionChanged; - end; -end; - -// Obtient la position dans le fichier à partir de la position du curseur - -function TCustomMPHexEditor.GetPosAtCursor(const aCol, aRow: integer): integer; -begin - FPosInCharField := (aCol > (GRID_FIXED + FBytesPerRowDup)); - if FPosInCharField then - begin - Result := aCol - ((GRID_FIXED + 1) + FBytesPerRowDup); - if FUnicodeCharacters then - Result := Result * 2; - end - else - Result := (aCol - GRID_FIXED) div 2; - - Result := Result + ((aRow - GRID_FIXED) * FBytesPerRow); - if Result < 0 then - Result := 0; -end; - -function TCustomMPHexEditor.GetRow(const DataPos: integer): integer; -begin - Result := (DataPos div FBytesPerRow) + GRID_FIXED; -end; - -function TCustomMPHexEditor.GetCursorAtPos(const aPos: integer; - const aChars: boolean): TGridCoord; -var - LIntCol: integer; -begin - if aPos < 0 then - begin - Result.y := GRID_FIXED; - Result.x := GRID_FIXED; - Exit; - end; - - Result.y := GetRow(aPos); - LIntCol := aPos mod FBytesPerRow; - - if aChars then - begin - if FUnicodeCharacters then - Result.x := (LIntCol div 2) + (GRID_FIXED + 1) + FBytesPerRowDup - else - Result.x := LIntCol + (GRID_FIXED + 1 + FBytesPerRowDup) - end - else - Result.x := (LIntCol * 2) + GRID_FIXED; -end; - -function TCustomMPHexEditor.GetOtherFieldCol(const aCol: integer): integer; -var - LIntCol: integer; -begin - FPosInCharField := (aCol > (GRID_FIXED + FBytesPerRowDup)); - if FPosInCharField then - begin - LIntCol := (aCol - (GRID_FIXED + 1 + FBytesPerRowDup)); - if FUnicodeCharacters then - Result := (LIntCol * 4) + GRID_FIXED - else - Result := (LIntCol * 2) + GRID_FIXED; - end - else - begin - if FUnicodeCharacters then - LIntCol := ((aCol - GRID_FIXED) div 4) - else - LIntCol := ((aCol - GRID_FIXED) div 2); - Result := LIntCol + (GRID_FIXED + 1 + FBytesPerRowDup); - end; -end; - -function TCustomMPHexEditor.GetOtherFieldColCheck(const aCol: integer): integer; -var - LIntCol: integer; -begin - if aCol > (GRID_FIXED + FBytesPerRowDup) then - begin - LIntCol := (aCol - (GRID_FIXED + 1 + FBytesPerRowDup)); - if FUnicodeCharacters then - Result := (LIntCol * 4) + GRID_FIXED - else - Result := (LIntCol * 2) + GRID_FIXED; - end - else - begin - if FUnicodeCharacters then - LIntCol := ((aCol - GRID_FIXED) div 4) - else - LIntCol := ((aCol - GRID_FIXED) div 2); - Result := LIntCol + (GRID_FIXED + 1 + FBytesPerRowDup); - end; -end; - -function TCustomMPHexEditor.CheckSelectCell(aCol, aRow: integer): boolean; -var - LgrcEndCoords: TGridCoord; - LIntPos: integer; -begin - Result := inherited SelectCell(aCol, aRow); - - if not FSelectionPossible then - Exit; - - try - FSelectionPossible := False; - - if Result then - begin - // überprüfen, ob linke maustaste oder shift gedrückt, sonst selection zurücksetzen - if not (IsKeyDown(VK_SHIFT) or IsKeyDown(VK_LBUTTON)) then - ResetSelection(True); - - // überprüfen, ob außerhalb der DateiGröße - LIntPos := GetPosAtCursor(aCol, aRow); - if (LIntPos >= DataSize) and not (InsertMode and (LIntPos = DataSize) and - (FPosInCharField or ((aCol mod 2) = 0))) then - begin - if (not InsertMode) then - LgrcEndCoords := GetCursorAtPos(DataSize - 1, InCharField) - else - LgrcEndCoords := GetCursorAtPos(DataSize, InCharField); - - MoveColRow(LgrcEndCoords.x, LgrcEndCoords.y, True, True); - Result := False; - end - else if aCol = (GRID_FIXED + FBytesPerRowDup) then - begin - Result := False; - if IsKeyDown(VK_LBUTTON) then - begin - aCol := aCol - 1; - aCol := Max(GRID_FIXED, aCol); - MoveColRow(aCol, aRow, True, True); - Exit; - end; - end; - end; - - finally - FSelectionPossible := True; - end; -end; - -procedure TCustomMPHexEditor.WMChar(var Msg: TWMChar); -var - LIntPos: integer; - LChrChar: char; - LBytOldData, LBytNewData: byte; - LArrNewData: packed array[0..7] of byte; - LWChrNewData: WideChar absolute LArrNewData; - LgrcPosition: TGridCoord; - LWChrOldData: WideChar; - LWrdKey: Word; -begin - LChrChar := char(Msg.CharCode); - - if Assigned(OnKeyPress) then - OnKeyPress(Self, LChrChar); - - if FReadOnlyView or (LChrChar in FMaskedChars) then - Exit; - - LIntPos := GetPosAtCursor(Col, Row); - if (LIntPos >= DataSize) and not InsertMode then - Exit; - - if not FPosInCharField then - begin - // hex-eingabe, nur 0..9 , a..f erlaubt - if Pos(LChrChar, HEX_ALLCHARS) <> 0 then - begin - LChrChar := UpCase(LChrChar); - - if not InsertMode then - ResetSelection(True); - - LgrcPosition := GetCursorAtPos(LIntPos, FPosInCharField); - // Obtient la valeur du byte dans le fichier (OldByte) - if DataSize > LIntPos then - LBytOldData := Data[LIntPos] - else - LBytOldData := 0; - - if (LgrcPosition.x = (Col - FSwapNibbles)) or (SelCount <> 0) then - LBytNewData := LBytOldData and 15 + ((Pos(LChrChar, HEX_UPPER) - 1) * 16) - else - LBytNewData := (LBytOldData and $F0) + (Pos(LChrChar, HEX_UPPER) - 1); - - FillChar(LArrNewData, sizeof(LArrNewData), #0); - if InsertMode and ((((Col - GRID_FIXED) mod (FBytesPerUnit * 2)) = 0) or - (SelCount > 0)) then - begin - if FSwapNibbles = 0 then - LBytNewData := LBytNewData and $F0 - else - LBytNewData := LBytNewData and $0F; - LArrNewData[0] := LBytNewData; - - if DataSize = 0 then - AppendBuffer(PChar(@LArrNewData), FBytesPerUnit, '', False) - else if SelCount = 0 then - begin - InsertBuffer(PChar(@LArrNewData), FBytesPerUnit, LIntPos, '', False); - end - else - ReplaceSelection(PChar(@LArrNewData), FBytesPerUnit, '', False); - end - else - begin - if LIntPos >= DataSize then - Exit; - IntChangeByte(LBytOldData, LBytNewData, LIntPos, Col, Row); - end; - FIsSelecting := False; - - LWrdKey := VK_RIGHT; - KeyDown(LWrdKey, []); - end - else - WrongKey - end - else - begin - // zeichen-eingabe, alle zeichen erlaubt - LChrChar := TranslateFromAnsiChar(Ord(LChrChar)); - - if (LChrChar in FMaskedChars) then - begin - WrongKey; - Exit; - end; - - if not InsertMode then - ResetSelection(True); - - LgrcPosition := GetCursorAtPos(LIntPos, FPosInCharField); - - FillChar(LArrNewData, sizeof(LArrNewData), #0); - if not FUnicodeCharacters then - LArrNewData[0] := Ord(LChrChar) - else - begin - LWChrNewData := StringToWideChar(LChrChar, @LWChrNewData, 2)^; - if FUnicodeBigEndian then - SwapWideChar(LWChrNewData); - end; - if (DataSize = 0) or (DataSize = LIntPos) then - LBytOldData := 0 - else - LBytOldData := Data[LIntPos]; - if FUnicodeCharacters then - begin - if (DataSize = 0) or (DataSize = LIntPos) or (DataSize = (LIntPos + 1)) - then - LWChrOldData := #0 - else - ReadBuffer(LWChrOldData, LIntPos, 2); - end; - - if InsertMode then - begin - if SelCount > 0 then - ReplaceSelection(PChar(@LArrNewData), FBytesPerUnit, '', False) - else - begin - if LIntPos = DataSize then - AppendBuffer(PChar(@LArrNewData), FBytesPerUnit) - else - begin - if (LIntPos mod FBytesPerUnit) = 0 then - InsertBuffer(PChar(@LArrNewData), FBytesPerUnit, LIntPos, '', False) - else - IntChangeByte(LBytOldData, LArrNewData[0], LIntPos, Col, Row) - end; - FIsSelecting := False; - end; - end - else - begin - if FUnicodeCharacters then - IntChangeWideChar(LWChrOldData, LWChrNewData, LIntPos, Col, Row) - else - IntChangeByte(LBytOldData, Ord(LChrChar), LIntPos, Col, Row); - end; - - LWrdKey := VK_RIGHT; - KeyDown(LWrdKey, []); - end; -end; - -{-------------------------------------------------------------------------------} -// *** procedure TCustomMPHexEditor.IntChangeByte*** -// Change la valeur du byte -// Renseigne la structure Undo -{-------------------------------------------------------------------------------} - -procedure TCustomMPHexEditor.IntChangeByte(const aOldByte, aNewByte: byte; aPos, - aCol, aRow: integer; const UndoDesc: string = ''); -var - LRctBoxRect: TRect; - LIntOtherFieldCol: integer; -begin - if aOldByte = aNewByte then - Exit; - - CreateUndo(ufKindBytesChanged, aPos, 1, 0, UndoDesc); - - // Ecrit dans le fichier - Data[aPos] := aNewByte; - - if not InsertMode then - FModifiedBytes.Bits[aPos] := True; - - aCol := GetCursorAtPos(aPos, False).X; - LIntOtherFieldCol := GetOtherFieldColCheck(aCol); - LRctBoxRect := BoxRect(aCol, aRow, aCol + 1, aRow); - InvalidateRect(Handle, @LRctBoxRect, False); - LRctBoxRect := BoxRect(LIntOtherFieldCol, aRow, LIntOtherFieldCol, aRow); - InvalidateRect(Handle, @LRctBoxRect, False); - Changed; -end; - -procedure TCustomMPHexEditor.IntChangeWideChar(const aOldChar, aNewChar: - WideChar; aPos, aCol, aRow: integer; const UndoDesc: string); -var - LRctBoxRect: TRect; - LIntOtherFieldCol: integer; - LBArrOld: packed array[0..1] of Byte absolute aOldChar; - LBArrNew: packed array[0..1] of Byte absolute aNewChar; -begin - if aOldChar = aNewChar then - Exit; - - CreateUndo(ufKindBytesChanged, aPos, 2, 0, UndoDesc); - - // Ecrit dans le fichier - WriteBuffer(aNewChar, aPos, 2); - - if not InsertMode then - begin - FModifiedBytes.Bits[aPos] := LBArrOld[0] <> LBArrNew[0]; - FModifiedBytes.Bits[aPos + 1] := LBArrOld[1] <> LBArrNew[1]; - end; - - aCol := GetCursorAtPos(aPos, False).X; - LIntOtherFieldCol := GetOtherFieldColCheck(aCol); - LRctBoxRect := BoxRect(aCol, aRow, aCol + 3, aRow); - InvalidateRect(Handle, @LRctBoxRect, False); - LRctBoxRect := BoxRect(LIntOtherFieldCol, aRow, LIntOtherFieldCol, aRow); - InvalidateRect(Handle, @LRctBoxRect, False); - Changed; -end; - -procedure TCustomMPHexEditor.KeyDown(var Key: word; Shift: TShiftState); -var - LIntCol: integer; - LgrcPosition: TGridCoord; - LIntRow: integer; -begin - if Assigned(OnKeyDown) then - OnKeyDown(self, Key, Shift); - - // reset selection if no shift key is pressed (except of SHIFT-Key) - if not ((Shift <> []) or (KEY = VK_SHIFT)) then - if not InsertMode then - ResetSelection(True); - - case Key of - - VK_PRIOR: - begin - if ssCtrl in Shift then - begin - // go to the first visible line - LIntRow := TopRow; - LIntCol := Col; - if LIntRow > -1 then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end - else - begin - // scroll up one page - LIntRow := Max(GRID_FIXED, Row - VisibleRowCount + 1); - TopRow := Max(GRID_FIXED, TopRow - VisibleRowCount + 1); - LIntCol := Col; - if LIntRow > -1 then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end; - end; - - VK_NEXT: - begin - if ssCtrl in Shift then - begin - // go to the Last visible line - LIntRow := Min(RowCount - 1, TopRow + VisibleRowCount - 1); - LIntCol := Col; - if LIntRow > 0 then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end - else - begin - // scroll down one page - LIntRow := Min(RowCount - 1, Row + VisibleRowCount - 1); - TopRow := Min(Max(GRID_FIXED, RowCount - VisibleRowCount), - TopRow + VisibleRowCount - 1); - LIntCol := Col; - if LIntRow > 0 then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end; - end; - - VK_HOME: - begin - InCharField; - if (ssCtrl in Shift) then - begin // strg+pos1 - if not FPosInCharField then - MoveColRow(GRID_FIXED, GRID_FIXED, True, True) - else - MoveColRow(Max(GRID_FIXED, GetOtherFieldCol(GRID_FIXED)), - GRID_FIXED, True, True); - end - else - begin // normaler zeilenstart - if not FPosInCharField then - MoveColRow(GRID_FIXED, Row, True, True) - else - MoveColRow(Max(GRID_FIXED, GetOtherFieldCol(GRID_FIXED)), - Row, True, True); - end; - end; - - VK_END: - begin - InCharField; - if (ssCtrl in Shift) then - begin // strg+end - if (not InsertMode) then - LgrcPosition := GetCursorAtPos(DataSize - 1, FPosInCharField) - else - LgrcPosition := GetCursorAtPos(DataSize, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True) - end - else - begin // normales zeilenende - if not FPosInCharField then - begin - LIntCol := GetPosAtCursor(GRID_FIXED, Row + 1) - 1; - TruncMaxPosition(LIntCol); - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x + 1, LgrcPosition.y, True, True) - end - else - begin - LIntCol := GetPosAtCursor(GRID_FIXED, Row + 1) - 1; - TruncMaxPosition(LIntCol); - LgrcPosition := GetCursorAtPos(LIntCol, True); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end - end; - end; - - VK_LEFT, VK_BACK: - if (InsertMode and (not FReadOnlyView)) and (Key = VK_BACK) then - begin - if SelCount > 0 then - DeleteSelection - else - InternalErase(True) - end - else if (not (ssCTRL in Shift)) then - begin - if FIsSelecting or (FUnicodeCharacters and FPosInCharField) then - LIntCol := GetPosAtCursor(Col, Row) - FBytesPerUnit - else - LIntCol := GetPosAtCursor(Col, Row) - 1; - if FPosInCharField then - begin - if LIntCol < 0 then - LIntCol := 0; - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end - else - begin - if FIsSelecting then - begin - CheckUnit(LIntCol); - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end - else - begin - LIntCol := LIntCol + 1; - LgrcPosition := GetCursorAtPos(LIntCol, False); - if LgrcPosition.x < Col then - MoveColRow(Col - 1, Row, True, True) - else - begin - LIntCol := LIntCol - 1; - if LIntCol >= 0 then - begin - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x + 1, LgrcPosition.y, True, True); - end; - end - end; - end; - end - else - begin - if Key = VK_LEFT then - begin - LIntCol := GRID_FIXED; - MoveColRow(LIntCol, Row, True, True); - end; - end; - - VK_RIGHT: - begin - if (not (ssCTRL in Shift)) then - begin - if FIsSelecting or (FUnicodeCharacters and FPosInCharField) then - LIntCol := GetPosAtCursor(Col, Row) + FBytesPerUnit - else - LIntCol := GetPosAtCursor(Col, Row) + 1; - if FPosInCharField then - begin - TruncMaxPosition(LIntCol); - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end - else - begin - if FIsSelecting then - begin - CheckUnit(LIntCol); - TruncMaxPosition(LIntCol); - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end - else - begin - LIntCol := LIntCol - 1; - LgrcPosition := GetCursorAtPos(LIntCol, False); - if (LgrcPosition.x = Col) and not (LIntCol = DataSize) then - MoveColRow(Col + 1, Row, True, True) - else - begin - LIntCol := LIntCol + 1; - if (LIntCol < DataSize) or ((LIntCol = DataSize) and InsertMode) - then - begin - LgrcPosition := GetCursorAtPos(LIntCol, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - end; - end - end; - end; - end - else - begin - LIntCol := GetLastCharCol; - MoveColRow(LIntCol, Row, True, True); - end; - end; - - VK_DOWN: - begin - if (not (ssCTRL in Shift)) then - begin - LIntRow := Row + 1; - - LIntCol := Col; - if LIntRow < RowCount then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end; - end; - - VK_UP: - begin - if (not (ssCTRL in Shift)) then - begin - LIntRow := Row - 1; - LIntCol := Col; - if LIntRow > 1 then - begin - MoveColRow(LIntCol, LIntRow, True, True); - end; - end; - end; - - Word('T'): if (ssCtrl in Shift) then - begin - Col := Max(GRID_FIXED, GetOtherFieldCol(Col)); - end; - - VK_TAB: if ((Shift = []) or (Shift = [ssShift])) then - begin // tab-taste - Col := Max(GRID_FIXED, GetOtherFieldCol(Col)); - end; - - Word('0')..Word('9'): if ssCtrl in Shift then - begin - if ssShift in Shift then - begin - LIntRow := GetPosAtCursor(Col, Row); - SetBookmarkVals(Key - Ord('0'), LIntRow, FPosInCharField); - end - else - begin - GotoBookmark(Key - Ord('0')); - end; - end; - - VK_SHIFT: if (Shift = [ssShift]) or (Shift = [ssShift, ssCtrl]) then - begin // selektion starten - FIsSelecting := True; - end; - - VK_INSERT: - begin - InsertMode := not InsertMode; - end; - - VK_DELETE: if (not FReadOnlyView) then - begin - if (SelCount > 0) and (InsertMode or (Shift = [ssCtrl])) then - DeleteSelection - else if InsertMode or (Shift = [ssCtrl]) then - InternalErase(False) - end; - end; -end; - -function TCustomMPHexEditor.HasChanged(aPos: integer): boolean; -begin - Result := False; - if InsertMode then - Exit; - - if FModifiedBytes.Size > aPos then - Result := FModifiedBytes.Bits[aPos]; -end; - -function TCustomMPHexEditor.IsSelected(const APosition: integer): boolean; -begin - Result := False; - if (FSelPosition <> -1) and (APosition >= FSelStart) and (APosition <= FSelEnd) - then - begin - Result := True - end; -end; - -procedure TCustomMPHexEditor.NewSelection(SelFrom, SelTo: integer); -var - LIntSelStart, LIntSelEnd, LIntSelPos: integer; - LIntOldStart, LIntNewStart, LIntOldEnd, LIntNewEnd: integer; -begin - CheckSelectUnit(SelFrom, SelTo); - LIntSelEnd := FSelEnd; - LIntSelStart := FSelStart; - LIntSelPos := FSelPosition; - - SetSelection(SelFrom, Min(SelFrom, SelTo), Max(SelFrom, SelTo)); - - if (LIntSelPos = -1) then - RedrawPos(Min(FSelStart, FSelEnd), Max(FSelStart, FSelEnd)) - else - begin - // den bereich neu zeichnen, der neu selektiert ist, sowie den, der nicht mehr selektiert ist - // hinzugekommene selektion berechnen - LIntNewStart := Min(SelFrom, SelTo); - LIntOldStart := Min(LIntSelEnd, LIntSelStart); - LIntNewEnd := Max(SelFrom, SelTo); - LIntOldEnd := Max(LIntSelEnd, LIntSelStart); - RedrawPos(Min(LIntNewStart, LIntOldStart), Max(LIntNewStart, LIntOldStart)); - RedrawPos(Min(LIntOldEnd, LIntNewEnd), Max(LIntOldEnd, LIntNewEnd)); - end; - SelectionChanged; -end; - -function TCustomMPHexEditor.GetOffsetFormat: string; -begin - Result := FOffsetFormat.Format; -end; - -procedure TCustomMPHexEditor.SetOffsetFormat(const Value: string); -begin - if Value <> FOffsetFormat.Format then - try - GenerateOffsetFormat(Value); - SetOffsetDisplayWidth; - Invalidate; - except - GenerateOffsetFormat(FOffsetFormat.Format); - raise; - end; -end; - -procedure TCustomMPHexEditor.SetHexLowerCase(const Value: boolean); -begin - if FHexLowerCase <> Value then - begin - FHexLowerCase := Value; - if Value then - Move(HEX_LOWER[1], FHexChars, sizeof(FHexChars)) - else - Move(HEX_UPPER[1], FHexChars, sizeof(FHexChars)); - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.GenerateOffsetFormat(Value: string); -var - LIntTemp: integer; - LStrTemp: string; -begin - with FOffsetFormat do - begin - Flags := []; - LStrTemp := Value; - // aufbau: [r|c|%][-|!]:[Prefix]|[Suffix] - if LStrTemp <> '' then - begin - // bytes per unit - if UpperCase(Copy(LStrTemp, 1, 2)) = 'R%' then - begin - Flags := Flags + [offCalcRow]; - Delete(LStrTemp, 1, 2); - _BytesPerUnit := BytesPerRow; - end - else if UpperCase(Copy(LStrTemp, 1, 2)) = 'C%' then - begin - Flags := Flags + [offCalcColumn]; - Delete(LStrTemp, 1, 2); - _BytesPerUnit := BytesPerColumn; - end - else - begin - LIntTemp := 1; - while (LIntTemp <= Length(LStrTemp)) and - (LStrTemp[LIntTemp] in ['0'..'9', 'A'..'F', 'a'..'f']) do - Inc(LIntTemp); - if Copy(LStrTemp, LIntTemp, 1) = '%' then - begin - // width field - if LIntTemp = 1 then - begin - Flags := Flags + [offBytesPerUnit]; - _BytesPerUnit := FUsedRulerBytesPerUnit; - Delete(LStrTemp, 1, 1) - end - else - begin - _BytesPerUnit := RadixToInt(Copy(LStrTemp, 1, LIntTemp - 1), 16); - // StrToInt('$'+Copy(LStrTemp, 1, LIntTemp-1)); - Delete(LStrTemp, 1, LIntTemp); - end; - end - else - begin - Flags := Flags + [offBytesPerUnit]; - _BytesPerUnit := FUsedRulerBytesPerUnit; - end; - end; - if not (_BytesPerUnit in [1, 2, 4, 8]) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_BPU, [_BytesPerUnit]); - // auto calc width - if Copy(LStrTemp, 1, 2) = '-!' then - begin - Flags := Flags + [offCalcWidth]; - Delete(LStrTemp, 1, 2); - MinWidth := 1; - end - else - begin - // width ? - LIntTemp := 1; - while (LIntTemp <= Length(LStrTemp)) and - (LStrTemp[LIntTemp] in ['0'..'9', 'A'..'F', 'a'..'f']) do - Inc(LIntTemp); - if Copy(LStrTemp, LIntTemp, 1) = '!' then - begin - // width field - if LIntTemp = 1 then - begin - MinWidth := 1; - Delete(LStrTemp, 1, 1) - end - else - begin - MinWidth := RadixToInt(Copy(LStrTemp, 1, LIntTemp - 1), 16); - // StrToInt('$'+Copy(LStrTemp, 1, LIntTemp-1)); - Delete(LStrTemp, 1, LIntTemp); - end; - end - else - MinWidth := 1; - end; - - // radix - LIntTemp := 1; - while (LIntTemp <= Length(LStrTemp)) and (LStrTemp[LIntTemp] in ['0'..'9', - 'A'..'F', 'a'..'f']) do - Inc(LIntTemp); - - if LIntTemp = 1 then - raise EMPHexEditor.CreateFmt(ERR_MISSING_FORMATCHAR, ['number radix']); - - if Copy(LStrTemp, LIntTemp, 1) <> ':' then - raise EMPHexEditor.CreateFmt(ERR_MISSING_FORMATCHAR, [':']); - - Radix := RadixToInt(Copy(LStrTemp, 1, LIntTemp - 1), 16); - if not (Radix in [2..16]) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_FORMATRADIX, [Radix]); - - Delete(LStrTemp, 1, LIntTemp); - - // prefix, suffix - LIntTemp := Pos('|', LStrTemp); - if LIntTemp = 0 then - raise EMPHexEditor.CreateFmt(ERR_MISSING_FORMATCHAR, ['|']); - - Prefix := Copy(LStrTemp, 1, LIntTemp - 1); - Suffix := Copy(LStrTemp, LIntTemp + 1, MaxInt); - end; - Format := Value; - end; -end; - -procedure TCustomMPHexEditor.Select(const aCurCol, aCurRow, aNewCol, aNewRow: - integer); -var - LIntOldStart, - //LIntOldEnd, - LIntNewStart, - LIntNewEnd: integer; -begin - //LIntOldEnd := FSelEnd; - //LIntOldStart := FSelStart; - LIntNewStart := GetPosAtCursor(aNewCol, aNewRow); - if FSelPosition = -1 then - begin - LIntOldStart := LIntNewStart; - //LIntOldEnd := LIntNewStart; - LIntNewEnd := GetPosAtCursor(aCurCol, aCurRow); - NewSelection(LIntNewEnd, LIntOldStart); // abcd - //SetSelection(LIntNewEnd, Min(LIntOldStart, LIntNewEnd), Max(LIntNewEnd, - //LIntOldEnd)); - //RedrawPos(FSelStart, FSelEnd) - end - else - //begin - NewSelection(FSelPosition, LIntNewStart); // abcd - (*// testen, ob neue selection /\ liegt als fSelPO - // wenn ja, dann start = sel, ende = selpo - if LIntNewStart < FSelPosition then - begin - NewSelection(FSelPosition, LIntNewStart);// abcd - //SetSelection(FSelPosition, LIntNewStart, FSelPosition); - //RedrawPos(Min(FSelStart, LIntOldStart), Max(FSelStart, LIntOldStart)); - //RedrawPos(Min(FSelEnd, LIntOldEnd), Max(FSelEnd, LIntOldEnd)); - end - else - begin - NewSelection(FSelPosition, LIntNewStart); //abcd - //SetSelection(FSelPosition, FSelPosition, LIntNewStart); - //RedrawPos(Min(FSelStart, LIntOldStart), Max(FSelStart, LIntOldStart)); - //RedrawPos(Min(FSelEnd, LIntOldEnd), Max(FSelEnd, LIntOldEnd)); - end; -end;*) -end; - -procedure TCustomMPHexEditor.RedrawPos(aFrom, aTo: integer); -var - LRctBox: TRect; -begin - aFrom := GetRow(aFrom); - aTo := GetRow(aTo); - LRctBox := BoxRect(GRID_FIXED, aFrom, GetLastCharCol, aTo); - InvalidateRect(Handle, @LRctBox, False); -end; - -procedure TCustomMPHexEditor.ResetSelection(const aDraw: boolean); -var - LIntOldStart, - LIntOldEnd: integer; -begin - FIsSelecting := False; - LIntOldStart := FSelStart; - LIntOldEnd := FSelEnd; - SetSelection(-1, -1, -1); - FSelBeginPosition := -1; - - if aDraw and ((LIntOldStart > -1) or (LIntOldStart > -1)) then - RedrawPos(LIntOldStart, LIntOldEnd); -end; - -procedure TCustomMPHexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); -var - LgrcDummy: TGridCoord; - lboolInherited: boolean; -begin - FIsSelecting := False; - FMouseUpCanResetSel := False; - - if Button = mbLeft then - LgrcDummy := CheckMouseCoord(X, Y); - - // do not change selection when clicking ruler or offset panel. - if (not MouseOverSelection) and (not MouseOverFixed(x, y)) then - begin - lBoolInherited := True; - inherited MouseDown(Button, Shift, x, y); - end - else - begin - lboolInherited := False; - // but set focus if possible (05/27/2004) - if not (csDesigning in ComponentState) and - (CanFocus or (GetParentForm(Self) = nil)) then - SetFocus; - end; - - if (GetParentForm(self) <> nil) then - if (GetParentForm(self).ActiveControl = self) then - if GetParentForm(self) <> Screen.ActiveForm then - if HandleAllocated then - Windows.SetFocus(self.Handle); - - if (Button = mbLeft) and (not MouseOverSelection) and - (LgrcDummy.X >= GRID_FIXED) and (LgrcDummy.Y >= GRID_FIXED) then - begin - ResetSelection(True); - if not (ssDouble in Shift) then - FIsSelecting := True; - end; - - if (Button = mbLeft) and MouseOverSelection then - begin - FMouseDownCol := x; - FMouseDownRow := y; - FMouseUpCanResetSel := True; - end; - - if (not lBoolInherited) and (Assigned(OnMouseDown)) and Focused then - OnMouseDown(self, Button, Shift, X, Y); -end; - -procedure TCustomMPHexEditor.InternalGetCurSel(var StartPos, EndPos, ACol, ARow: - integer); -begin - if FSelPosition = -1 then - begin - StartPos := GetPosAtCursor(Col, Row); - EndPos := StartPos + 1; - aCol := Col; - aRow := Row; - end - else - begin - StartPos := FSelStart; - EndPos := FSelEnd + 1; - with GetCursorAtPos(FSelStart, InCharField) do - begin - aCOL := X; - aROW := Y; - end; - end; - - if FModifiedBytes.Size > StartPos then - FModifiedBytes.Size := StartPos; -end; - -function TCustomMPHexEditor.CreateShift4BitStream(const StartPos: integer; var - FName: TFileName): TFileStream; -var - LByt1, - LByt2: byte; - LBytBuffer: array[0..511] of byte; - LIntLoop, - LIntRead: integer; -begin - Result := nil; - if StartPos >= DataSize then - Exit; - - FName := GetTempName; - Result := TFileStream.Create(FName, fmCreate); - Result.Position := 0; - FDataStorage.Position := StartPos; - LByt1 := 0; - while FDataStorage.Position < DataSize do - begin - FillChar(LBytBuffer[0], 512, 0); - LIntRead := FDataStorage.Read(LBytBuffer[0], 512); - for LIntLoop := 0 to Pred(LIntRead) do - begin - LByt2 := LBytBuffer[LIntLoop] and 15; - LBytBuffer[LIntLoop] := (LBytBuffer[LIntLoop] shr 4) or (LByt1 shl 4); - LByt1 := LByt2; - end; - Result.WriteBuffer(LBytBuffer[0], LIntRead); - end; - Result.Position := 0; -end; - -function TCustomMPHexEditor.InternalInsertNibble(const Pos: integer; const - HighNibble: boolean): boolean; -var - LfstNibbleStream: TFileStream; - LStrFName: TFileName; - LIntOldSize: integer; - LByteFirst, - LByteLast: byte; -begin - Result := False; - - if DataSize = 0 then - Exit; - - LIntOldSize := FDataStorage.Size; - - WaitCursor; - try - // nun zuerst alle restlichen bits verschieben - LByteFirst := Data[Pos]; - LByteLast := Data[Pred(DataSize)]; - - LfstNibbleStream := CreateShift4BitStream(Pos, LStrFName); - with LfstNibbleStream do - try - FDataStorage.Position := Pos; - FDataStorage.CopyFrom(LfstNibbleStream, LfstNibbleStream.Size); - finally - Free; - DeleteFile(LStrFName); - end; - - if HighNibble then - LByteFirst := LByteFirst shr 4 - else - LByteFirst := LByteFirst and 240; - Data[Pos] := LByteFirst; - FDataStorage.Size := LIntOldSize + 1; - Data[Pred(DataSize)] := LByteLast shl 4; - Result := True; - finally - OldCursor; - end; -end; - -function TCustomMPHexEditor.InsertNibble(const aPos: integer; const HighNibble: - boolean; const UndoDesc: string = ''): boolean; -const - L_BytAppend: byte = 0; -begin - Result := False; - - if DataSize < 1 then - begin - ResetSelection(False); - AppendBuffer(PChar(@L_BytAppend), 1); - Result := True; - Exit; - end; - - if (aPos >= DataSize) or (aPos < 0) then - Exit; - - CreateUndo(ufKindNibbleInsert, aPos, 0, 0, UndoDesc); - - ResetSelection(False); - Result := InternalInsertNibble(aPos, HighNibble); - - if Result and (FModifiedBytes.Size >= (aPos)) then - FModifiedBytes.Size := aPos; - - CalcSizes; - Changed; -end; - -function TCustomMPHexEditor.InternalDeleteNibble(const Pos: integer; const - HighNibble: boolean): boolean; -var - LfstNibbleStream: TFileStream; - LStrFName: TFileName; - LIntOldSize: integer; - LByt1: byte; -begin - Result := False; - if DataSize = 0 then - Exit; - - LIntOldSize := FDataStorage.Size; - WaitCursor; - try - // nun zuerst alle restlichen bits verschieben - LByt1 := Data[Pos]; - - LfstNibbleStream := CreateShift4BitStream(Pos, LStrFName); - with LfstNibbleStream do - try - FDataStorage.Position := Pos; - Position := 1; - FDataStorage.CopyFrom(LfstNibbleStream, LfstNibbleStream.Size - 1); - finally - Free; - DeleteFile(LStrFName); - end; - - if not HighNibble then - Data[Pos] := (LByt1 and 240) or (Data[Pos] and 15); - - Result := True; - FDataStorage.Size := LIntOldSize; - Data[Pred(DataSize)] := Data[Pred(DataSize)] shl 4; - finally - OldCursor; - end; -end; - -function TCustomMPHexEditor.DeleteNibble(const aPos: integer; const HighNibble: - boolean; const UndoDesc: string = ''): boolean; -begin - Result := False; - - if (aPos >= DataSize) or (aPos < 0) then - Exit; - - CreateUndo(ufKindNibbleDelete, aPos, 0, 0, UndoDesc); - - ResetSelection(False); - Result := InternalDeleteNibble(aPos, HighNibble); - - if Result and (FModifiedBytes.Size >= (aPos)) then - FModifiedBytes.Size := aPos; - - CalcSizes; - Changed; -end; - -procedure TCustomMPHexEditor.InternalConvertRange(const aFrom, aTo: integer; - const aTransFrom, aTransTo: TMPHTranslationKind); -var - LIntSize: integer; -begin - LIntSize := (aTo - aFrom) + 1; - WaitCursor; - try - FDataStorage.TranslateToAnsi(aTransFrom, aFrom, LIntSize); - FDataStorage.TranslateFromAnsi(aTransTo, aFrom, LIntSize); - finally - OldCursor; - end; -end; - -procedure TCustomMPHexEditor.ConvertRange(const aFrom, aTo: integer; const - aTransFrom, aTransTo: TMPHTranslationKind; const UndoDesc: string = ''); -begin - if aFrom > aTo then - Exit; - - if aTransFrom = aTransTo then - Exit; - - if (aTo >= DataSize) or (aFrom < 0) then - Exit; - - CreateUndo(ufKindConvert, aFrom, (aTo - aFrom) + 1, 0, UndoDesc); - - InternalConvertRange(aFrom, aTo, aTransFrom, aTransTo); - - Invalidate; - Changed; -end; - -procedure TCustomMPHexEditor.InternalDelete(StartPos, EndPos, ACol, ARow: - integer); -var - LgrdEndPos: TGridCoord; - LIntNewCol: integer; -begin - if EndPos <= (DataSize - 1) then - MoveFileMem(EndPos, StartPos, DataSize - EndPos); - - FDataStorage.Size := DataSize - (EndPos - StartPos); - EndPos := GetPosAtCursor(aCol, aRow); - - if DataSize < 1 then - begin - LIntNewCol := GRID_FIXED; - if FPosInCharField then - LIntNewCol := Max(GRID_FIXED, GetOtherFieldColCheck(LIntNewCol)); - MoveColRow(LIntNewCol, GRID_FIXED, True, True) - end - else if EndPos >= DataSize then - begin - if InsertMode then - LgrdEndPos := GetCursorAtPos(DataSize, FPosInCharField) - else - LgrdEndPos := GetCursorAtPos(DataSize - 1, FPosInCharField); - MoveColRow(LgrdEndPos.x, LgrdEndPos.y, True, True); - end - else if ACol > -1 then - MoveColRow(aCol, aRow, True, True); - - CalcSizes; - ResetSelection(False); - - Invalidate; -end; - -procedure TCustomMPHexEditor.DeleteSelection(const UndoDesc: string = ''); -var - LIntSelStart, - LIntSelEnd, - LIntCol, - LIntRow: integer; -begin - InternalGetCurSel(LIntSelStart, LIntSelEnd, LIntCol, LIntRow); - CreateUndo(ufKindByteRemoved, LIntSelStart, LIntSelEnd - LIntSelStart, - 0, UndoDesc); - - InternalDelete(LIntSelStart, LIntSelEnd, LIntCol, LIntRow); - Changed; -end; - -procedure TCustomMPHexEditor.CreateUndo(const aKind: TMPHUndoFlag; const aPos, - aCount, aReplCount: integer; const sDesc: string = ''); -begin - - if CanCreateUndo(aKind, aCount, aReplCount) then - begin - if FUndoStorage.UpdateCount = 0 then - FUndoStorage.CreateUndo(aKind, aPos, aCount, aReplCount, sDesc); - FModified := True; - //Changed; - end - else - raise EMPHexEditor.Create(ERR_NOUNDO); -end; - -procedure TCustomMPHexEditor.ResetUndo; -begin - FUndoStorage.Reset; -end; - -function TCustomMPHexEditor.GetCanUndo: boolean; -begin - Result := (not FReadOnlyView) and FUndoStorage.CanUndo; -end; - -function TCustomMPHexEditor.GetCanRedo: boolean; -begin - Result := (not FReadOnlyView) and FUndoStorage.CanRedo; -end; - -function TCustomMPHexEditor.GetUndoDescription: string; -begin - if not (csDestroying in ComponentState) then - begin - with FUndoStorage do - if CanUndo then - Result := Description - else - Result := UNDO_NOUNDO; - end - else - Result := UNDO_NOUNDO; -end; - -function TCustomMPHexEditor.GetSelStart: integer; -begin - if FSelPosition = -1 then - begin - Result := GetPosAtCursor(Col, Row); - end - else - Result := FSelPosition; -end; - -function TCustomMPHexEditor.GetSelEnd: integer; -begin - if FSelPosition = -1 then - Result := GetPosAtCursor(Col, Row) - else - begin - Result := FSelEnd; - if FSelPosition = FSelEnd then - Result := FSelStart; - end; -end; - -procedure TCustomMPHexEditor.SetSelStart(aValue: integer); -begin - if (aValue < 0) or (aValue >= DataSize) then - raise EMPHexEditor.Create(ERR_INVALID_SELSTART) - else - begin - ResetSelection(True); - with GetCursorAtPos(aValue, InCharField) do - MoveColRow(X, Y, True, True); - end; -end; - -procedure TCustomMPHexEditor.SetSelEnd(aValue: integer); -begin - if (aValue < -1) or (aValue >= DataSize) then - raise EMPHexEditor.Create(ERR_INVALID_SELEND) - else - begin - ResetSelection(True); - if aValue > -1 then - begin - with GetCursorAtPos(aValue, InCharField) do - Select(Col, Row, X, Y); - SelectionChanged; - end; - end; -end; - -procedure TCustomMPHexEditor.SetInCharField(const Value: boolean); -begin - if (DataSize < 1) then - Exit; - - if InCharField <> Value then - MoveColRow(GetOtherFieldCol(Col), Row, True, True); -end; - -function TCustomMPHexEditor.GetInCharField: boolean; -begin - Result := False; - if DataSize < 1 then - Exit; - - GetPosAtCursor(Col, Row); - Result := FPosInCharField; -end; - -procedure TCustomMPHexEditor.Loaded; -begin - inherited; - CreateEmptyFile(UNNAMED_FILE); -end; - -procedure TCustomMPHexEditor.CreateWnd; -begin - inherited; - if (csDesigning in ComponentState) or (FFileName = '---') then - CreateEmptyFile(UNNAMED_FILE); -end; - -procedure TCustomMPHexEditor.WMSetFocus(var Msg: TWMSetFocus); -begin - inherited; - CreateCaretGlyph; - CheckSetCaret; - Invalidate; -end; - -procedure TCustomMPHexEditor.WMKillFocus(var Msg: TWMKillFocus); -begin - inherited; - HideCaret(Handle); - DestroyCaret(); - FIsSelecting := False; - Invalidate; -end; - -procedure TCustomMPHexEditor.CMINTUPDATECARET(var Msg: TMessage); -begin - if Msg.WParam = 7 then - begin - CheckSetCaret; - end; -end; - -procedure TCustomMPHexEditor.SetTranslation(const Value: TMPHTranslationKind); -begin - if FTranslation <> Value then - begin - if (Value <> tkAsIs) and FUnicodeCharacters then - raise EMPHexEditor.Create(ERR_NO_TRANSLATION_IN_UNICODE_MODE); - FTranslation := Value; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetModified(const Value: boolean); -begin - FModified := Value; - if not Value then - begin - ResetUndo; - FModifiedBytes.Size := 0; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetBytesPerRow(const Value: integer); -var - LIntPos, - LIntSelPos, - LIntSelStart, - LIntSelEnd: integer; - LBoolInCharField, - LBool2ndCol: boolean; -begin - if ((Value < 1) or (Value > 256)) or - (FUnicodeCharacters and ((Value mod 2) <> 0)) then - raise EMPHexEditor.Create(ERR_INVALID_BYTESPERLINE) - else if FBytesPerRow <> Value then - begin - with FOffsetFormat do - if offCalcRow in Flags then - _BytesPerUnit := Value; - LIntSelPos := FSelPosition; - LIntSelStart := FSelStart; - LIntSelEnd := FSelEnd; - LIntPos := GetPosAtCursor(Col, Row); - LBoolInCharField := FPosInCharField; - LBool2ndCol := GetCursorAtPos(LIntPos, LBoolInCharField).x <> Col; - FBytesPerRow := Value; - FBytesPerRowDup := Value * 2; - FIntLastHexCol := (GRID_FIXED + FBytesPerRowDup - 1); - SetRulerString; - CalcSizes; - if (LIntPos >= DataSize) or (InsertMode and (LIntPos > DataSize)) then - LIntPos := DataSize - 1; - - with GetCursorAtPos(LIntPos, LBoolInCharField) do - begin - if LBool2ndCol then - Inc(x); - - MoveColRow(x, y, True, True); - end; - - SetSelection(LIntSelPos, LIntSelStart, LIntSelEnd); - end; -end; - -procedure TCustomMPHexEditor.InternalAppendBuffer(Buffer: PChar; const Size: - integer); -var - LIntSize: integer; -begin - if DataSize = 0 then - begin - FDataStorage.Position := 0; - FModifiedBytes.Size := 0; - end; - - LIntSize := DataSize; - FDataStorage.Size := LIntSize + Size; - WriteBuffer(Buffer^, LIntSize, Size); - CalcSizes; -end; - -procedure TCustomMPHexEditor.InternalInsertBuffer(Buffer: PChar; const Size, - Position: integer); -var - LIntSize: integer; -begin - if DataSize = 0 then - begin - FDataStorage.Position := 0; - FModifiedBytes.Size := 0; - end; - - LIntSize := DataSize; - FDataStorage.Size := LIntSize + Size; - if Position < LIntSize then - // nur, wenn nicht hinter streamende, dann platz schaffen - MoveFileMem(Position, Position + Size, DataSize - Position - Size); //+ 1); - - WriteBuffer(Buffer^, Position, Size); - CalcSizes; -end; - -procedure TCustomMPHexEditor.InsertBuffer(aBuffer: PChar; const aSize, aPos: - integer; const UndoDesc: string = ''; const MoveCursor: Boolean = True); -begin - CreateUndo(ufKindInsertBuffer, aPos, aSize, 0, UndoDesc); - - InternalInsertBuffer(aBuffer, aSize, aPos); - - if FModifiedBytes.Size >= (aPos) then - FModifiedBytes.Size := aPos; - - if Enabled then - begin - SetSelection(aPos, aPos, aPos + aSize - 1); - if MoveCursor then - begin - with GetCursorAtPos(FSelEnd, InCharField) do - MoveColRow(x, y, True, True); - SetSelection(aPos, aPos, aPos + aSize - 1); - end; - Invalidate; - end; - Changed; -end; - -procedure TCustomMPHexEditor.AppendBuffer(aBuffer: PChar; const aSize: integer; - const UndoDesc: string = ''; const MoveCursor: Boolean = True); -var - LIntSize: integer; -begin - if (not Assigned(aBuffer)) or (aSize = 0) then - Exit; - - CreateUndo(ufKindAppendBuffer, DataSize, aSize, 0, UndoDesc); - - if FModifiedBytes.Size >= (DataSize) then - FModifiedBytes.Size := DataSize; - - LIntSize := DataSize; - InternalAppendBuffer(aBuffer, aSize); - - if MoveCursor then - with GetCursorAtPos(LIntSize, InCharField) do - MoveColRow(x, y, True, True); - SetSelection(LIntSize, LIntSize, LIntSize + aSize - 1); - Invalidate; - Changed; -end; - -procedure TCustomMPHexEditor.ReplaceSelection(aBuffer: PChar; aSize: integer; - const UndoDesc: string = ''; const MoveCursor: Boolean = True); -var - LIntStart, - LIntEnd, - LIntCol, - LIntRow: integer; - LBoolInCharField: boolean; -begin - // auswahl berechnen - LBoolInCharField := GetInCharField; - if FSelPosition = -1 then - InsertBuffer(aBuffer, aSize, SelStart, UndoDesc, MoveCursor) - else - begin - if IsFileSizeFixed then - begin - if aSize > SelCount then - aSize := SelCount - else if SelCount > aSize then - begin - SelStart := Min(SelStart, SelEnd); - SelEnd := SelStart + aSize - 1; - end; - end; - - CreateUndo(ufKindReplace, FSelStart, aSize, SelCount, UndoDesc); - - // zuerst aktuelle auswahl löschen - InternalGetCurSel(LIntStart, LIntEnd, LIntCol, LIntRow); - InternalDelete(LIntStart, LIntEnd, LIntCol, LIntRow); - InternalInsertBuffer(aBuffer, aSize, LIntStart); - if FModifiedBytes.Size >= LIntStart then - FModifiedBytes.Size := Max(0, LIntStart); - - if MoveCursor then - begin - with GetCursorAtPos(LIntStart + aSize - 1, LBoolInCharField) do - MoveColRow(x, y, True, True); - SetSelection(LIntStart + aSize - 1, LIntStart, LIntStart + aSize - 1); - end; - Invalidate; - Changed; - end; -end; - -procedure TCustomMPHexEditor.SetChanged(DataPos: integer; const Value: boolean); -begin - if InsertMode then - FModifiedBytes.Size := 0; - - if not Value then - if FModifiedBytes.Size <= DataPos then - Exit; - - FModifiedBytes[DataPos] := Value; -end; - -procedure TCustomMPHexEditor.MoveFileMem(const aFrom, aTo, aCount: integer); -begin - FDataStorage.Move(aFrom, aTo, aCount); -end; - -function TCustomMPHexEditor.GetCursorPos: integer; -begin - Result := GetPosAtCursor(Col, Row); - if Result < 0 then - Result := 0; - - if Result > Max(0, DataSize - 1) then - Result := Max(0, DataSize - 1) -end; - -function TCustomMPHexEditor.GetSelCount: integer; -begin - if FSelPosition = -1 then - Result := 0 - else - Result := Max(FSelStart, FSelEnd) - Min(FSelStart, FSelEnd) + 1; -end; - -procedure TCustomMPHexEditor.SetReadOnlyFile(const Value: boolean); -begin - if Value and (not FIsFileReadonly) then - begin - FIsFileReadonly := True; - end; -end; - -function TCustomMPHexEditor.BufferFromFile(const aPos: integer; var aCount: - integer): PChar; -begin - if (aPos < 0) or (aPos >= DataSize) then - raise EMPHexEditor.Create(ERR_INVALID_BUFFERFROMFILE) - else - begin - if (aPos + aCount) > DataSize then - aCount := (DataSize - aPos) + 1; - - GetMem(Result, aCount); - try - FDataStorage.ReadBufferAt(Result^, aPos, aCount); - except - try - FreeMem(Result); - except - end; - Result := nil; - aCount := 0; - end; - end; -end; - -procedure TCustomMPHexEditor.WMVScroll(var Msg: TWMVScroll); -begin - inherited; - CheckSetCaret; -end; - -procedure TCustomMPHexEditor.WMHScroll(var Msg: TWMHScroll); -begin - inherited; - CheckSetCaret; -end; - -procedure TCustomMPHexEditor.CreateCaretGlyph; -begin - DestroyCaret(); - FCaretBitmap.Width := FCharWidth; - FCaretBitmap.Height := FCharHeight - 2; - FCaretBitmap.Canvas.Brush.Color := clBlack; - FCaretBitmap.Canvas.FillRect(Rect(0, 0, FCharWidth, FCharHeight - 2)); - FCaretBitmap.Canvas.Brush.Color := clWhite; - case FCaretKind of - ckFull: FCaretBitmap.Canvas.FillRect(Rect(0, 0, FCharWidth, FCharHeight - - 2)); - ckLeft: FCaretBitmap.Canvas.FillRect(Rect(0, 0, 2, FCharHeight - 2)); - ckBottom: FCaretBitmap.Canvas.FillRect(Rect(0, FCharHeight - 4, FCharWidth, - FCharHeight - 2)); - ckAuto: - begin - if FReadOnlyView then - FCaretBitmap.Canvas.FillRect(Rect(0, FCharHeight - 4, FCharWidth, - FCharHeight - 2)) - else - begin - if FInsertModeOn then - FCaretBitmap.Canvas.FillRect(Rect(0, 0, 2, FCharHeight - 2)) - else - FCaretBitmap.Canvas.FillRect(Rect(0, 0, FCharWidth, FCharHeight - - 2)); - end; - end; - end; - CreateCaret(Handle, FCaretBitmap.Handle, 0, 0); - ShowCaret(Handle); -end; - -procedure TCustomMPHexEditor.SetBytesPerColumn(const Value: integer); -begin - if ((Value < 1) or (Value > 256)) or - (FUnicodeCharacters and ((Value mod 2) <> 0)) then - raise EMPHexEditor.Create(ERR_INVALID_BYTESPERCOL) - else if FBytesPerCol <> (Value * 2) then - begin - with FOffsetFormat do - if offCalcColumn in Flags then - _BytesPerUnit := Value; - FBytesPerCol := Value * 2; - AdjustMetrics; - SetRulerString; - Invalidate; - end; -end; - -function TCustomMPHexEditor.GetBytesPerColumn: integer; -begin - Result := FBytesPerCol div 2; -end; - -function TCustomMPHexEditor.PrepareFindReplaceData(StrData: string; const - IgnoreCase, IsText: boolean): string; -var - LWStrTemp: WideString; - LIntLoop: Integer; - lChrTbl: Char; -begin - if Length(StrData) = 0 then - Result := '' - else - begin - if IgnoreCase then - StrData := AnsiLowerCase(StrData); - if IsText and (FTranslation <> tkAsIs) then - begin - UniqueString(StrData); - TranslateBufferFromAnsi(FTranslation, @StrData[1], @StrData[1], - Length(StrData)); - end; - if (not IsText) or (not FUnicodeCharacters) then - Result := StrData - else - begin - // create a unicode string - LWStrTemp := StrData; - if FUnicodeBigEndian then - for LIntLoop := 1 to Length(LWStrTemp) do - SwapWideChar(LWStrTemp[LIntLoop]); - SetLength(Result, Length(LWStrTemp) * 2); - Move(LWStrTemp[1], Result[1], Length(Result)); - end; - - // create compare tables - for LChrTbl := #0 to #255 do - begin - FFindTable[LChrTbl] := LChrTbl; - - FFindTableI[LChrTbl] := LChrTbl; - if FTranslation <> tkAsIs then - TranslateBufferToAnsi(FTranslation, @FFindTableI[LChrTbl], - @FFindTableI[LChrTbl], 1); - CharLowerBuff(@FFindTableI[LChrTbl], 1); - if FTranslation <> tkAsIs then - TranslateBufferFromAnsi(FTranslation, @FFindTableI[LChrTbl], - @FFindTableI[LChrTbl], 1); - end; - end; -end; - -function TCustomMPHexEditor.Find(aBuffer: PChar; aCount: integer; const aStart, - aEnd: integer; const IgnoreCase: boolean): integer; -var - LBoolDummy: Boolean; - LChrCurrent: char; - LIntCurPos, - LIntLoop, - LIntFound, - LIntEnd: integer; - cLoop, - cInc: Cardinal; - LPTblFind: PMPHFindTable; -begin - if Assigned(FOnFind) then - FOnFind(self, aBuffer, aCount, aStart, aEnd, IgnoreCase, #0, Result) - else - begin - Result := -1; - LIntEnd := aEnd; - cLoop := 0; - if LIntEnd >= DataSize then - LIntEnd := DataSize - 1; - - if aCount < 1 then - Exit; - - if aStart + aCount > (LIntEnd + 1) then - Exit; // will never be found, if search-part is smaller than searched data - - if IgnoreCase then - LPTblFind := @FFindTableI - else - LPTblFind := @FFindTable; - - cInc := DataSize div 500; - - WaitCursor; - try - - LIntCurPos := aStart; - LIntLoop := 0; - LIntFound := LIntCurPos + 1; - - repeat - if FFindProgress and Assigned(FOnProgress) then - begin - Inc(cLoop); - // changed in 12-28-2004 to avoid edivbyzero - if (cInc = 0) or ((cLoop mod cInc) = 0) then - FOnProgress(self, pkFind, FFileName, Round((LIntCurpos / DataSize) * - 100), LBoolDummy); - end; - - if LIntCurPos > LIntEnd then - Exit; - - LChrCurrent := LPTblFind^[char(Data[LIntCurPos])]; - - if (LChrCurrent = aBuffer[LIntLoop]) then - begin - if LIntLoop = (aCount - 1) then - begin - Result := LIntCurPos - aCount + 1; - Exit; - end - else - begin - if LIntLoop = 0 then - LIntFound := LIntCurPos + 1; - Inc(LIntCurPos); - Inc(LIntLoop); - end; - end - else - begin - LIntCurPos := LIntFound; - LIntLoop := 0; - LIntFound := LIntCurPos + 1; - end; - until False; - - finally - OldCursor; - end; - end; -end; - -procedure TCustomMPHexEditor.AddSelectionUndo(const AStart, - ACount: integer); -begin - CreateUndo(ufKindSelection, AStart, aCount, 0, ''); -end; - -function TCustomMPHexEditor.FindWithWildcard(aBuffer: PChar; - aCount: integer; const aStart, aEnd: integer; const IgnoreCase: boolean; - const Wildcard: char): integer; -var - LBoolDummy: boolean; - LChrCurrent: char; - LIntCurPos, - LIntLoop, - LIntFound, - LIntEnd: integer; - bFound: boolean; - cLoop, - cInc: cardinal; - LPTblFind: PMPHFindTable; -begin - if Assigned(FOnWildcardFind) then - FOnWildcardFind(self, aBuffer, aCount, aStart, aEnd, IgnoreCase, Wildcard, - Result) - else - begin - Result := -1; - LIntEnd := aEnd; - cLoop := 0; - if LIntEnd >= DataSize then - LIntEnd := DataSize - 1; - - if aCount < 1 then - Exit; - - if aStart + aCount > (LIntEnd + 1) then - Exit; // will never be found, if search-part is smaller than searched data - - if IgnoreCase then - LPTblFind := @FFindTableI - else - LPTblFind := @FFindTable; - - cInc := DataSize div 500; - - WaitCursor; - try - LIntCurPos := aStart; - LIntLoop := 0; - LIntFound := LIntCurPos + 1; - - repeat - if FFindProgress and Assigned(FOnProgress) then - begin - Inc(cLoop); - // changed in 12-28-2004 to avoid edivbyzero - if (cInc = 0) or ((cLoop mod cInc) = 0) then - FOnProgress(self, pkFind, FFileName, Round((LIntCurpos / DataSize) * - 100), LBoolDummy); - end; - - if LIntCurPos > LIntEnd then - Exit; - - bFound := aBuffer[LIntLoop] = WildCard; - if not bFound then - begin - LChrCurrent := LPTblFind^[char(Data[LIntCurPos])]; - bFound := (LChrCurrent = aBuffer[LIntLoop]); - end; - - if bFound then - begin - if LIntLoop = (aCount - 1) then - begin - Result := LIntCurPos - aCount + 1; - Exit; - end - else - begin - if LIntLoop = 0 then - LIntFound := LIntCurPos + 1; - Inc(LIntCurPos); - Inc(LIntLoop); - end; - end - else - begin - LIntCurPos := LIntFound; - LIntLoop := 0; - LIntFound := LIntCurPos + 1; - end; - until False; - - finally - OldCursor; - end; - end; -end; - -procedure TCustomMPHexEditor.SetOffsetDisplayWidth; -var - s: string; -begin - if Assigned(FOnGetOffsetText) and (not FOffsetHandler) then - begin - FOffsetHandler := True; - try - FIsMaxOffset := True; - FOnGetOffsetText(self, (RowCount - 3) * FBytesPerRow, s); - finally - FOffsetHandler := False; - end; - FOffsetDisplayWidth := Length(s) + 1; - end - else - begin - with FOffsetFormat do - if offCalcWidth in Flags then - MinWidth := Length(IntToRadix(((RowCount - 3) * FBytesPerRow) div - _BytesPerUnit, Radix)); - - FOffSetDisplayWidth := Length(GetOffsetString((RowCount - 3) * FBytesPerRow)) - + 1; - end; - if FGutterWidth = -1 then - DoSetCellWidth(0, FOffSetDisplayWidth * FCharWidth + 20 + 1) - else - DoSetCellWidth(0, FGutterWidth); -end; - -function TCustomMPHexEditor.Seek(const aOffset, aOrigin: integer): integer; -var - LIntPos: integer; -begin - Result := -1; - LIntPos := GetCursorPos; - case aOrigin of - soFromBeginning: LIntPos := aOffset; - soFromCurrent: LIntPos := GetCursorPos + aOffset; - soFromEnd: LIntPos := DataSize + aOffset - 1; - end; - - if DataSize < 1 then - Exit; - - LIntPos := Min(Max(0, LIntPos), DataSize - 1); - - SelStart := LIntPos; - Result := LIntPos; -end; - -procedure TCustomMPHexEditor.SetSwapNibbles(const Value: boolean); -begin - if integer(Value) <> FSwapNibbles then - begin - FSwapNibbles := integer(Value); - Invalidate; - end; -end; - -function TCustomMPHexEditor.GetSwapNibbles: boolean; -begin - Result := boolean(FSwapNibbles); -end; - -procedure TCustomMPHexEditor.SetColors(const Value: TMPHColors); -begin - FColors.Assign(Value); -end; - -procedure TCustomMPHexEditor.SetCaretKind(const Value: TMPHCaretKind); -begin - if FCaretKind <> Value then - begin - FCaretKind := Value; - if Focused then - begin - CreateCaretGlyph; - IntSetCaretPos(-50, -50, -1); - Invalidate; - end; - end; -end; - -procedure TCustomMPHexEditor.SetFocusFrame(const Value: boolean); -begin - if FFocusFrame <> Value then - begin - FFocusFrame := Value; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetMaskChar(const Value: char); -begin - if FReplaceUnprintableCharsBy <> Value then - begin - FReplaceUnprintableCharsBy := Value; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetAsText(const Value: string); -var - LpszBuffer: PChar; -begin - if DataSize > 0 then - begin - // alles selektieren - SelStart := 0; - SelEnd := DataSize - 1; - end; - // do translation (thanks to philippe chessa) dec 17 98 - GetMem(LpszBuffer, Length(Value)); - try - Move(Value[1], LpszBuffer^, Length(Value)); - TranslateBufferFromANSI(FTranslation, @Value[1], LpszBuffer, Length(Value)); - ReplaceSelection(LpszBuffer, Length(Value)); - finally - FreeMem(LpszBuffer); - end; -end; - -procedure TCustomMPHexEditor.SetAsHex(const Value: string); -var - LpszBuffer: PChar; - LIntAmount: integer; -begin - if DataSize > 0 then - begin - // alles selektieren - SelStart := 0; - SelEnd := DataSize - 1; - end; - - GetMem(LpszBuffer, Length(Value)); - try - ConvertHexToBin(@Value[1], LpszBuffer, Length(Value), SwapNibbles, - LIntAmount); - ReplaceSelection(LpszBuffer, LIntAmount); - finally - FreeMem(LpszBuffer); - end; -end; - -function TCustomMPHexEditor.GetAsText: string; -begin - if DataSize < 1 then - Result := '' - else - begin - SetLength(Result, DataSize); - ReadBuffer(Result[1], 0, DataSize); - end; -end; - -function TCustomMPHexEditor.GetAsHex: string; -begin - Result := FDataStorage.GetAsHex(0, DataSize, SwapNibbles) -end; - -function TCustomMPHexEditor.GetSelectionAsHex: string; -begin - if (DataSize < 1) or (SelCount < 1) then - Result := '' - else - Result := FDataStorage.GetAsHex(Min(SelStart, SelEnd), SelCount, - SwapNibbles); -end; - -function TCustomMPHexEditor.GetInsertMode: boolean; -begin - Result := FInsertModeOn and IsInsertModePossible; -end; - -procedure TCustomMPHexEditor.SetAllowInsertMode(const Value: boolean); -begin - if not Value then - begin - if FInsertModeOn then - InsertMode := False; - end; - FAllowInsertMode := Value; -end; - -procedure TCustomMPHexEditor.SetFixedFileSize(const Value: boolean); -begin - if Value <> FFixedFileSize then - begin - if Value then - InsertMode := False; - FFixedFileSize := Value; - end; -end; - -procedure TCustomMPHexEditor.InternalErase(const KeyWasBackspace: boolean; const - UndoDesc: string = ''); -var - LIntPos: integer; - LIntSavePos: integer; - LIntCount: integer; -begin - LIntPos := GetCursorPos div FBytesPerUnit * FBytesPerUnit; - LIntCount := FBytesPerUnit; - LIntSavePos := LIntPos; - if KeyWasBackspace then - begin // Delete previous byte(s) - if InsertMode and (SelCount = 0) then - begin - LIntPos := GetPosAtCursor(Col, Row); - if (LIntPos = DataSize) and ((DataSize mod FBytesPerUnit) <> 0) then - LIntCount := 1 - else - begin - LIntPos := LIntPos div FBytesPerUnit * FBytesPerUnit; - LIntCount := FBytesPerUnit; - end; - end; - - if LIntPos = 0 then - Exit; // Can't delete at offset -1 - - CreateUndo(ufKindByteRemoved, LIntPos - LIntCount, LIntCount, - 0, UndoDesc); - - InternalDelete(LIntPos - LIntCount, LIntPos, Col, Row); - if LIntSavePos = LIntPos then - Seek(LIntPos - LIntCount, soFromBeginning) // Move caret - else - begin - if (Col + 1) <= GetLastCharCol then - Col := Col + 1; - end; - Changed; - end - else - begin // Delete next byte - if LIntPos >= DataSize then - Exit; // Cant delete at EOF - while (LIntPos + LIntCount) > DataSize do - Dec(LIntCount); - CreateUndo(ufKindByteRemoved, LIntPos, LIntCount, 0, UndoDesc); - InternalDelete(LIntPos, LIntPos + LIntCount, Col, Row); - Changed; - end; -end; - -procedure TCustomMPHexEditor.WMGetDlgCode(var Msg: TWMGetDlgCode); -begin - inherited; - Msg.Result := Msg.Result or DLGC_WANTARROWS or DLGC_WANTCHARS or - DLGC_WANTALLKEYS; - if FWantTabs then - Msg.Result := Msg.Result or DLGC_WANTTAB - else - Msg.Result := Msg.Result and not DLGC_WANTTAB; -end; - -procedure TCustomMPHexEditor.CMFontChanged(var Message: TMessage); -begin - inherited; - if HandleAllocated then - begin - AdjustMetrics; - if Focused then - begin - CreateCaretGlyph; - end; - end; -end; - -procedure TCustomMPHexEditor.SetWantTabs(const Value: boolean); -begin - FWantTabs := Value; -end; - -procedure TCustomMPHexEditor.SetReadOnlyView(const Value: boolean); -begin - FReadOnlyView := Value; - - if (FCaretKind = ckAuto) and Focused then - CreateCaretGlyph; -end; - -procedure TCustomMPHexEditor.SetHideSelection(const Value: boolean); -begin - if FHideSelection <> Value then - begin - FHideSelection := Value; - if (not Focused) and (GetSelCount > 0) then - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetGraySelectionIfNotFocused(const Value: boolean); -begin - if FGraySelOnLostFocus <> Value then - begin - FGraySelOnLostFocus := Value; - if (not Focused) and (GetSelCount > 0) and (not FHideSelection) then - Invalidate; - end; -end; - -function TCustomMPHexEditor.CalcColCount: integer; -begin - if FUnicodeCharacters then - Result := (FBytesPerRow * 2) + (FBytesPerRow div 2) + 1 + GRID_FIXED - else - Result := FBytesPerRow * 3 + 1 + GRID_FIXED; -end; - -function TCustomMPHexEditor.GetLastCharCol: integer; -begin - Result := ColCount - 1; -end; - -function TCustomMPHexEditor.GetTopLeftPosition(var oInCharField: boolean): - integer; -begin - Result := GetPosAtCursor(Max(LeftCol, GRID_FIXED), TopRow); - oInCharField := InCharField; -end; - -procedure TCustomMPHexEditor.SetTopLeftPosition(const aPosition: integer; const - aInCharField: boolean); -begin - with GetCursorAtPos(aPosition, aInCharField) do - begin - TopRow := y; - LeftCol := x; - end; -end; - -function TCustomMPHexEditor.GetPropColCount: integer; -begin - Result := inherited ColCount; -end; - -function TCustomMPHexEditor.GetPropRowCount: integer; -begin - Result := inherited RowCount; -end; - -function TCustomMPHexEditor.ShowDragCell(const X, Y: integer): integer; -var - LRctCell: TRect; - LIntDragPos, - LIntMouseX, - LIntMouseY: integer; -begin - with MouseCoord(X, Y) do - begin - LIntMouseX := X; - LIntMouseY := Y; - if X < GRID_FIXED then - X := GRID_FIXED; - if Y >= RowCount then - Y := RowCount - 1; - if Y < GRID_FIXED then - Y := GRID_FIXED; - LIntDragPos := GetPosAtCursor(X, Y) - end; - - if LIntDragPos < 0 then - LIntDragPos := 0; - if LIntDragPos > DataSize then - LIntDragPos := DataSize; - if IsSelected(LIntDragPos) then - LIntDragPos := Min(SelStart, SelEnd); - CheckUnit(LIntDragPos); - Result := LIntDragPos; - FShowDrag := True; - - if (LIntMouseY <= TopRow) and (LIntMouseY > GRID_FIXED) then - begin - // nach oben scrollen - TopRow := TopRow - 1; - end - else if (LIntMouseY >= (TopRow + VisibleRowCount - 1)) and (LIntMouseY < - Pred(RowCount)) then - begin - // nach unten scrollen - TopRow := TopRow + 1; - end; - - if (LIntMouseX <= LeftCol) and (LIntMouseX > GRID_FIXED) then - begin - // nach links scrollen - LeftCol := LeftCol - 1; - end - else if (LIntMouseX >= (LeftCol + VisibleColCount - 1)) and - (LIntMouseX < GetLastCharCol) then - begin - // nach unten scrollen - LeftCol := LeftCol + 1; - end; - - with GetCursorAtPos(LIntDragPos, FPosInCharField) do - begin - if (x = FDropCol) and (y = FDropRow) then - Exit; - LRctCell := CellRect(FDropCol, FDropRow); - FDropCol := x; - FDropRow := y; - InvalidateRect(Handle, @LRctCell, True); - LRctCell := CellRect(X, Y); - InvalidateRect(Handle, @LRctCell, True); - end; -end; - -procedure TCustomMPHexEditor.HideDragCell; -begin - FShowDrag := False; - Invalidate; -end; - -procedure TCustomMPHexEditor.CombineUndo(const aCount: integer; const sDesc: - string = ''); -begin - CreateUndo(ufKindCombined, 0, aCount, 0, sDesc); -end; - -function TCustomMPHexEditor.GetMouseOverSelection: boolean; -var - LPntMouse: TPoint; -begin - Windows.GetCursorPos(LPntMouse); - LPntMouse := ScreenToClient(LPntMouse); - Result := CursorOverSelection(LPntMouse.x, LPntMouse.y); -end; - -function TCustomMPHexEditor.CursorOverSelection(const X, Y: integer): boolean; -var - LIntPos: integer; - LBoolInCharField: boolean; -begin - Result := False; - if SelCount * DataSize = 0 then - Exit; - - LBoolInCharField := FPosInCharField; - with MouseCoord(x, y) do - begin - if (x < GRID_FIXED) or (y < GRID_FIXED) then - Exit; - - LIntPos := GetPosAtCursor(X, Y); - FPosInCharField:=(LBoolInCharField); - if (LIntPos < 0) or (LIntPos >= DataSize) then - Exit; - end; - - Result := IsSelected(LIntPos); -end; - -function TCustomMPHexEditor.MouseOverFixed(const X, Y: integer): boolean; -begin - with MouseCoord(x, y) do - Result := (x < GRID_FIXED) or (y < GRID_FIXED); -end; - -procedure TCustomMPHexEditor.MouseMove(Shift: TShiftState; X, Y: integer); -var - LgrcCoords: TGridCoord; -begin - if Shift = [ssLeft] then - LgrcCoords := CheckMouseCoord(X, Y); - - inherited MouseMove(Shift, x, y); - - if FMouseUpCanResetSel then - begin - FMouseUpCanResetSel := (LgrcCoords.x = FMouseDownCol) and - (LgrcCoords.y = FMouseDownRow); - end; - - if (Shift = []) and (CursorOverSelection(X, Y) or MouseOverFixed(X, Y)) then - Cursor := crArrow - else - Cursor := crIBeam; -end; - -procedure TCustomMPHexEditor.WMTimer(var Msg: TWMTimer); -var - LPtMouse: TPoint; - LgrcCoord: TGridCoord; -begin - if FGridState <> gsSelecting then - Exit; - Windows.GetCursorPos(LPtMouse); - LPtMouse := ScreenToClient(LPtMouse); - LgrcCoord := CheckMouseCoord(LPtMouse.X, LPtMouse.Y); - if (LGrcCoord.X <> -1) and (LGrcCoord.Y <> -1) then - inherited; -end; - -function TCustomMPHexEditor.CheckMouseCoord(var X, Y: integer): TGridCoord; -var - LRctCell: TRect; -begin - Result := MouseCoord(X, Y); - if FInsertModeOn then - begin - // use the following cell if the mouse is over the second half of the cell - LRctCell := CellRect(Result.X, Result.Y); - if (LRctCell.Left + (FCharWidth div 2)) <= X then - begin - if not (Result.X in [GetLastCharCol, FBytesPerRowDup + GRID_FIXED - 1]) then - begin - X := LRctCell.Right+1; - Inc(Result.X); - LRctCell := CellRect(Result.X, Result.Y); - end; - end; - if (Result.X = GetLastCharCol) then - begin - if (X - LRctCell.Left) > (FCharWidth div 2) then - begin - Y := Y + RowHeight; - Result.Y := Result.Y + 1; - Result.X := FBytesPerRowDup + 1 + GRID_FIXED; - X := CellRect(Result.X, Result.Y - 1).Left; - //Dec(X, FCharWidth * FBytesPerRow); - end; - end - else if Result.X = (FBytesPerRowDup + GRID_FIXED - 1) then - begin - if (X - LRctCell.Left) > (FCharWidth div 2) then - begin - Y := Y + RowHeight; - Result.Y := Result.Y + 1; - Result.X := GRID_FIXED; - X := CellRect(Result.X, Result.Y - 1).Left; - //Dec(X, FCharWidth * FBytesPerRow); - end; - end; - end; -end; - -procedure TCustomMPHexEditor.MouseUP(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); -begin - CheckMouseCoord(X, Y); - inherited; - if FMouseUpCanResetSel then - begin - FMouseUpCanResetSel := False; - ResetSelection(True); - with MouseCoord(x, y) do - MoveColRow(x, y, True, True); - end; - if FShowDrag then - HideDragCell; -end; - -procedure TCustomMPHexEditor.AdjustBookmarks(const From, Offset: integer); -var - LIntLoop: integer; - LBoolChanged: boolean; -begin - LBoolChanged := False; - if From >= 0 then - for LIntLoop := 0 to 9 do - with FBookmarks[LIntLoop] do - if mPosition >= From then - begin - LBoolChanged := True; - Inc(mPosition, Offset); - if mPosition > DataSize then - mPosition := -1; - end; - if LBoolChanged then - BookMarkChanged; -end; - -procedure TCustomMPHexEditor.IntSetCaretPos(const X, Y, aCol: integer); -begin - if Focused then - begin - if aCol <> -1 then - begin - FPosInCharField := (aCol > (GRID_FIXED + FBytesPerRowDup)); - if FLastPosInCharField <> FPosInCharField then - begin - FLastPosInCharField := FPosInCharField; - Invalidate; - end; - end; - SetCaretPos(X, Y); - end; -end; - -procedure TCustomMPHexEditor.TruncMaxPosition(var DataPos: integer); -begin - if DataPos >= DataSize then - begin - DataPos := DataSize - 1; - if InsertMode then - DataPos := DataSize; - end; -end; - -function TCustomMPHexEditor.GetCurrentValue: integer; -var - LIntPos: integer; -begin - Result := -1; - LIntPos := GetPosAtCursor(Col, Row); - if (LIntPos >= DataSize) or (LIntPos < 0) then - Exit; - Result := Data[LIntPos] -end; - -procedure TCustomMPHexEditor.SetInsertMode(const Value: boolean); -var - LIntPos: integer; -begin - if Value = FInsertModeOn then - Exit; - if IsInsertModePossible then - begin - FInsertModeOn := Value; - if (FCaretKind = ckAuto) and Focused then - CreateCaretGlyph; - if DataSize < 1 then - Exit; - if not FInsertModeOn then - begin - if ((DataSize mod FBytesPerRow) = 0) and (DataSize > 0) then - RowCount := RowCount - 1; - LIntPos := GetPosAtCursor(Col, Row); - if LIntPos = DataSize then - SelStart := DataSize - 1; - end - else - begin - if ((DataSize mod FBytesPerRow) = 0) and (DataSize > 0) then - RowCount := RowCount + 1; - end; - FModifiedBytes.Size := 0; - Invalidate; - end; -end; - -function TCustomMPHexEditor.GetModified: boolean; -begin - Result := FModified and ((DataSize > 0) or FileExists(FileName)); -end; - -procedure TCustomMPHexEditor.SetSelection(DataPos, StartPos, EndPos: - integer); -begin - //CheckSelectUnit(StartPos, EndPos); - FSelEnd := Max(-1, Min(EndPos, DataSize - 1)); - FSelPosition := Max(-1, Min(DataPos, DataSize - 1)); - FSelStart := Max(-1, Min(StartPos, DataSize - 1)); -end; - -procedure TCustomMPHexEditor.Resize; -begin - PostMessage(Handle, CM_INTUPDATECARET, 7, 7); - inherited; -end; - -procedure TCustomMPHexEditor.WrongKey; -begin - if Assigned(FOnInvalidKey) then - FOnInvalidKey(self); -end; - -procedure TCustomMPHexEditor.TopLeftChanged; -begin - CheckSetCaret; - if Assigned(FOnTopLeftChanged) then - FOnTopLeftChanged(self); -end; - -function TCustomMPHexEditor.GetOffsetString(const Position: cardinal): string; -begin - Result := ''; - if Assigned(FOnGetOffsetText) and (not FOffsetHandler) then - begin - FOffsetHandler := True; - try - FIsMaxOffset := False; - FOnGetOffsetText(self, Position, Result) - finally - FOffsetHandler := False; - end; - end - else - begin - with FOffsetFormat do - begin - if Format <> '' then - begin - if (MinWidth <> 0) or (Position <> 0) then - begin - if FHexLowercase then - Result := LowerCase(IntToRadixLen(Position div _BytesPerUnit, Radix, - MinWidth)) - else - Result := Uppercase(IntToRadixLen(Position div _BytesPerUnit, Radix, - MinWidth)); - end; - Result := Prefix + Result + Suffix; - end; - end; - end; -end; - -function TCustomMPHexEditor.GetAnyOffsetString(const Position: integer): string; -begin - if FOffsetFormat.Format = '' then - Result := IntToRadix(Position, 16) - else - Result := GetOffsetString(Position); -end; - -function TCustomMPHexEditor.RowHeight: integer; -begin - Result := DefaultRowHeight; -end; - -function TCustomMPHexEditor.GetBookmark(Index: byte): TMPHBookmark; -begin - if Index > 9 then - raise EMPHexEditor.Create(ERR_INVALID_BOOKMARK); - - Result := FBookmarks[Index]; -end; - -procedure TCustomMPHexEditor.SetBookmark(Index: byte; const Value: - TMPHBookmark); -begin - SetBookmarkVals(Index, Value.mPosition, Value.mInCharField); -end; - -procedure TCustomMPHexEditor.SetBookmarkVals(const Index: byte; const Position: - integer; const InCharField: boolean); -begin - if Index > 9 then - raise EMPHexEditor.Create(ERR_INVALID_BOOKMARK); - - if (FBookmarks[Index].mPosition <> Position) or - (FBookmarks[Index].mInCharField <> InCharField) then - begin - FBookmarks[Index].mPosition := Position; - FBookmarks[Index].mInCharField := InCharField; - Invalidate; - end - else - begin - FBookmarks[Index].mPosition := -1; - FBookmarks[Index].mInCharField := InCharField; - Invalidate; - end; - BookmarkChanged; -end; - -{.$DEFINE TESTCOLOR}// check for unneeded drawings - -type - TestColor = TColor; - -procedure TCustomMPHexEditor.Paint; -type - TKindOfCell = (kocData, kocRuler, kocOffset, kocEmpty); -var - DrawInfo: TGridDrawInfo; - LIntCurCol, LIntCurRow: longint; - LRctWhere: TRect; - LBoolOddCol: boolean; - LBoolChanged: boolean; - LIntDataPos, LIntDataSize: integer; - LWStrOutput: WideString; - LColTextColor, LColTextBackColor, LColBackColor: TColor; - LIntPenWidthSave: integer; - LrecSize: TSize; - - LBoolDraw: Boolean; - - LBoolFocused: boolean; - LRect2: TRect; - LIntLastCol: integer; - - // get the width of a wide text - function GetTextWidthW: Integer; - begin - GetTextExtentPoint32W(Canvas.Handle, PWideChar(LWStrOutput), - Length(LWStrOutput), LrecSize); - Result := LRecSize.cx; - end; - - // render an offset/ruler/fixed cell - procedure _TextOut; - begin - with Canvas, LRctWhere do - begin - Brush.Color := TestColor(LColBackColor); - Font.Color := LColTextColor; - SetBKColor(Handle, ColorToRGB(TestColor(LColTextBackColor))); - LRect2 := LRctWhere;//Rect(Left, Top, Left + FCharWidth, Bottom); - LRect2.Right := Left + FCharWidth; - //SetTextColor(Handle, ColorToRGB(LColTextColor)); - - LBoolDraw:= True; - if Assigned(FOnDrawCell) then - begin - if LIntCurCol = 0 then - FOnDrawCell(self, Canvas, LIntCurCol, LIntCurRow, LWStrOutput, - LRctWhere, LBoolDraw) - else - FOnDrawCell(self, Canvas, LIntCurCol, LIntCurRow, LWStrOutput, LRect2, - LBoolDraw) - end; - if LBoolDraw then - begin - - FillRect(LRctWhere); - if LIntCurCol = 0 then - ExtTextOutW(Handle, Right - GetTextWidthW - 4, Top, - ETO_CLIPPED or ETO_OPAQUE, @LRctWhere, PWideChar(LWStrOutput), - Length(LWStrOutput), nil) - else - ExtTextOutW(Handle, Left, Top, - ETO_CLIPPED or ETO_OPAQUE, @LRect2, PWideChar(LWStrOutput), - Length(LWStrOutput), nil); - - end - else - LBoolDraw := True; - - end; - end; - - // render a data cell - procedure _TextOutData; - begin - with Canvas, LRctWhere do - begin - Brush.Color := TestColor(LColBackColor); - Font.Color := LColTextColor; - SetBKColor(Handle, ColorToRGB(TestColor(LColTextBackColor))); - LRect2 := LRctWhere;//Rect(Left, Top, Left + FCharWidth, Bottom); - LRect2.Right := Left + FCharWidth; - //SetTextColor(Handle, ColorToRGB(LColTextColor)); - - LBoolDraw:= True; - if Assigned(FOnDrawCell) then - begin - FOnDrawCell(self, Canvas, LIntCurCol, LIntCurRow, LWStrOutput, LRect2, - LBoolDraw) - end; - if LBoolDraw then - begin - - FillRect(LRctWhere); - ExtTextOutW(Handle, Left, Top, - ETO_CLIPPED or ETO_OPAQUE, @LRect2, PWideChar(LWStrOutput), - Length(LWStrOutput), nil); - - end - else - LBoolDraw := True; - - if FShowDrag and (LIntCurCol = FDropCol) and (LIntCurRow = FDropRow) then - begin - LIntPenWidthSave := Pen.Width; - try - Pen.Width := 2; - Pen.Color := LColTextColor; - MoveTo(Left + 1, Top + 1); - LineTo(Left + 1, Bottom - 1) - finally - Pen.Width := LIntPenWidthSave; - end; - end - end; - end; - - // draw an offset cell - procedure DrawOffsetCell; - var - LIntLoop: integer; - begin - if (LIntCurRow = Row) then - begin - LColBackColor := FColors.CurrentOffsetBackground; - LColTextColor := FColors.CurrentOffset; - end - else - begin - LColBackColor := FColors.OffsetBackground; - LColTextColor := Colors.Offset; - end; - LColTextBackColor := LColBackColor; - - (* text ausgeben *) - LWStrOutput := GetOffsetString((LIntCurRow - GRID_FIXED) * FBytesPerRow); - _TextOut; - - (* auf bookmark prüfen *) - for LIntLoop := 0 to 9 do - with FBookmarks[lIntLoop] do - if (mPosition > -1) and ((mPosition div FBytesPerRow) = (LIntCurRow - - GRID_FIXED)) then - with LRctWhere do - FBookmarkImageList.Draw(Canvas, Left + 3, ((Bottom - Top - 10) div 2) - + Top, lIntLoop + (10 * integer(mInCharField))); - end; - - // draw a ruler cell - procedure DrawRulerCell; - begin - if LIntCurCol <> (GRID_FIXED + FBytesPerRowDup) then - begin - if LIntCurCol > (GRID_FIXED + FBytesPerRowDup) then - begin - LIntDataPos := (LIntCurCol - (GRID_FIXED + FBytesPerRowDup + 1)); - LWStrOutput := FRulerCharString[LIntDataPos + 1]; - end - else - LWStrOutput := FRulerString[LIntCurCol - GRID_FIXED + 1]; - end - else - LWStrOutput := ' '; - LColBackColor := FColors.OffsetBackGround; - if Col = LIntCurCol then - begin - LColTextBackColor := FColors.CurrentOffsetBackGround; - LColTextColor := FColors.CurrentOffset; - end - else - begin - LColTextBackColor := FColors.OffsetBackGround; - LColTextColor := FColors.Offset; - end; - _TextOut; - end; - - // draw a hex/char cell - procedure DrawDataCell(const bIsCharCell, bIsCurrentField: boolean); - begin - (*// caret setzen - if (LIntCurRow = Row) and (LIntCurCol = Col) then - IntSetCaretPos(LRctWhere.Left, LRctWhere.Top);*) - - LIntDataPos := GetPosAtCursor(LIntCurCol, LIntCurRow); - FDrawDataPosition := LIntDataPos; - if bIsCurrentField and (LIntCurCol < LIntLastCol) and - (LIntCurCol <> FIntLastHexCol) then - LColBackColor := FColors.FActiveFieldBackground - else - LColBackColor := FColors.FBackground; - - // nicht zeichnen, falls keine daten - if (LIntDataPos < LIntDataSize) then - begin - if not bIsCharCell then - begin // partie hexadecimale - if ((LIntCurCol - GRID_FIXED) mod 2) = FSwapNibbles then - LWStrOutput := FHexChars[Data[LIntDataPos] shr 4] - else - LWStrOutput := FHexChars[Data[LIntDataPos] and 15] - end - else - begin - if FUnicodeCharacters then - begin - SetLength(LWStrOutput, 1); - LWStrOutput[1] := #0; - ReadBuffer(LWStrOutput[1], LIntDataPos, Min(2, LIntDataSize - - LIntDataPos)); - if FUnicodeBigEndian then - SwapWideChar(LWStrOutput[1]); - if (LWStrOutput[1] < #256) and (Char(LWStrOutput[1]) in FMaskedChars) then - LWStrOutput[1] := WideChar(FReplaceUnprintableCharsBy); - end - else - LWStrOutput := TranslateToAnsiChar(Data[LIntDataPos]); - end; - - // testen ob byte geändert - LBoolChanged := (HasChanged(LIntDataPos)) or ((FUnicodeCharacters and - bIsCharCell) and HasChanged(LIntDataPos + 1)); - LBoolOddCol := (((LIntCurCol - GRID_FIXED) div FBytesPerCol) mod 2) = 0; - - if LBoolChanged then - begin - LColTextColor := FColors.FChangedText; - LColTextBackColor := FColors.FChangedBackground; - end - else - begin - if bIsCurrentField then - LColTextBackColor := FColors.FActiveFieldBackground - else - LColTextBackColor := FColors.FBackground; - - if not FPosInCharField then - begin - if LBoolOddCol then - LColTextColor := Colors.FOddColumn - else - LColTextColor := Colors.FEvenColumn; - end - else - LColTextColor := Font.Color; - end; - - if (FSelPosition <> -1) and IsSelected(LIntDataPos) then - begin - - FIsDrawDataSelected := True; - - if (not FHideSelection) or LBoolFocused then - begin - if (LIntCurCol < LIntLastCol) and (LIntCurCol <> FIntLastHexCol) - and (LIntDataPos <> Max(FSelStart, FSelEnd)) then - LColBackColor := Invert(LColBackColor); - LColTextBackColor := Invert(LColTextBackColor); - LColTextColor := Invert(LColTextColor); - - if FGraySelOnLostFocus and (not LBoolFocused) then - begin - LColTextBackColor := FadeToGray(LColTextBackColor); - LColTextColor := FadeToGray(LColTextColor); - end; - end; - end - - else - FIsDrawDataSelected := False -; - - _TextOutData - end; - - // focus frame auf der anderen seite - if (LIntCurRow = Row) and LBoolFocused and (GetOtherFieldColCheck(Col) = - LIntCurCol) then - begin - with LRctWhere do - if FFocusFrame then - Canvas.DrawFocusRect(Rect(Left, Top, Left + FCharWidth, Bottom - 1)) - else - begin - Canvas.Pen.Color := FColors.CursorFrame; - Canvas.Brush.Style := bsClear; - Canvas.Rectangle(Left, Top, Left + FCharWidth, Bottom - 1); - end; - end; - - // possibly draw a mark at the current position when not focused - if FShowPositionIfNotFocused and (LIntCurRow = Row) and (Col = LIntCurCol) - and (not LBoolFocused) then - begin - with LRctWhere do - if FFocusFrame then - Canvas.DrawFocusRect(Rect(Left, Top, Left + FCharWidth, Bottom - 1)) - else - begin - Canvas.Pen.Color := FColors.NonFocusCursorFrame; - Canvas.Brush.Style := bsClear; - Canvas.Rectangle(Left, Top, Left + FCharWidth, Bottom - 1); - end; - end; - - if FDrawGridLines and (LIntCurCol = LIntLastCol) then - with Canvas, LRctWhere do - begin - Pen.Color := FColors.FGrid; - MoveTo(Right - 1, Top); - LineTo(Right - 1, Bottom - 1); - end; - - end; - - // draw - procedure DrawCells(ACol, ARow: longint; StartX, StartY, StopX, StopY: - integer; - Kind: TKindOfCell); - begin - LIntCurRow := ARow; - LRctWhere.Top := StartY; - while (LRctWhere.Top < StopY) and (LIntCurRow < RowCount) do - begin - LIntCurCol := ACol; - LRctWhere.Left := StartX; - LRctWhere.Bottom := LRctWhere.Top + RowHeights[LIntCurRow]; - while (LRctWhere.Left < StopX) and (LIntCurCol <= LIntLastCol) do - begin - LRctWhere.Right := LRctWhere.Left + ColWidths[LIntCurCol]; - if (LRctWhere.Right > LRctWhere.Left) (*and RectVisible(Canvas.Handle, - LRctWhere) slows down, removed *) then - begin - case Kind of - kocData: - begin - if LIntCurCol < (GRID_FIXED + FBytesPerRowDup) then - DrawDataCell(False, not FLastPosInCharField) - else if LIntCurCol > (GRID_FIXED + FBytesPerRowDup) then - DrawDataCell(True, FLastPosInCharField) - else if FDrawGridLines then - with Canvas do - begin - Pen.Color := FColors.FGrid; - MoveTo(LRctWhere.Left, LRctWhere.Top); - LineTo(LRctWhere.Left, LRctWhere.Bottom - 1); - end; - - if FDrawGridLines then - with Canvas do - begin - Pen.Color := FColors.FGrid; - MoveTo(LRctWhere.Left, LRctWhere.Bottom - 1); - LineTo(LRctWhere.Right, LRctWhere.Bottom - 1); - end; - end; - kocEmpty: - begin - FDrawDataPosition := -1; - LColTextBackColor := FColors.OffsetBackGround; - LColTextColor := FColors.Offset; - LWStrOutput := ''; - _TextOut; - end; - kocRuler: - begin - FDrawDataPosition := -1; - DrawRulerCell; - end; - kocOffset: - begin - FDrawDataPosition := -1; - if LIntCurCol = 1 then - begin - if FDrawGridLines then - with Canvas do - begin - Pen.Color := FColors.FGrid; - MoveTo(LRctWhere.Left, LRctWhere.Bottom - 1); - LineTo(LRctWhere.Right, LRctWhere.Bottom - 1); - end; - end - else - DrawOffsetCell; - end; - end; - end; - LRctWhere.Left := LRctWhere.Right; - Inc(LIntCurCol); - end; - LRctWhere.Top := LRctWhere.Bottom; - Inc(LIntCurRow); - end; - end; -var - LIntTop: integer; -begin - -{$IFDEF DELPHI6UP} - if UseRightToLeftAlignment then - ChangeGridOrientation(True); -{$ENDIF} - - CalcDrawInfo(DrawInfo); - LBoolFocused := Focused; - LIntDataSize := DataSize; - LIntLastCol := GetLastCharCol; - with DrawInfo do - begin - if FShowRuler then - begin - // oben links, fixed - DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, kocEmpty); - // oben, fixed - DrawCells(LeftCol, 0, Horz.FixedBoundary, 0, Horz.GridBoundary, - Vert.FixedBoundary, kocRuler); - end; - // links, fixed - DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary, - Vert.GridBoundary, kocOffset); - // daten - DrawCells(LeftCol, TopRow, Horz.FixedBoundary, Vert.FixedBoundary, - Horz.GridBoundary, Vert.GridBoundary, kocData); - - // paint unoccupied space on the right - if Horz.GridBoundary < Horz.GridExtent then - begin - Canvas.Brush.Color := TestColor(Color); - Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, - Vert.GridBoundary)); - - // fixed (ruler) - Canvas.Brush.Color := TestColor(FColors.OffsetBackGround); - Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, RowHeights[0] - + RowHeights[1])); - end; - - // paint unoccupied space on bottom - if Vert.GridBoundary < Vert.GridExtent then - begin - // hex + chars - Canvas.Brush.Color := TestColor(Color); - Canvas.FillRect(Rect(ColWidths[0] + 1, Vert.GridBoundary, Horz.GridExtent, - Vert.GridExtent)); - - // fixed (position gutter) - Canvas.Brush.Color := TestColor(FColors.OffsetBackGround); - Canvas.FillRect(Rect(0, Vert.GridBoundary, ColWidths[0], - Vert.GridExtent)); - end; - - LIntTop := RowHeights[0] + RowHeights[1]; - - // draw bevel on the right of the offset gutter - if (ColWidths[0] <> 0) then - begin - if FDrawGutter3D then - begin - Canvas.MoveTo(ColWidths[0], LIntTop); - Canvas.Pen.Color := TestColor(clBtnShadow); - Canvas.LineTo(ColWidths[0], Vert.GridExtent); - Canvas.MoveTo(ColWidths[0] - 1, LIntTop); - Canvas.Pen.Color := TestColor(clBtnHighlight); - Canvas.LineTo(ColWidths[0] - 1, Vert.GridExtent); - end - else if FDrawGridLines then - begin - Canvas.MoveTo(ColWidths[0] - 1, LIntTop); - Canvas.Pen.Color := TestColor(FColors.Grid); - Canvas.LineTo(ColWidths[0] - 1, Vert.GridExtent); - end; - end; - - if (FShowRuler) then - begin - if FDrawGutter3D then - begin - Canvas.MoveTo(ColWidths[0] - 1, LIntTop - 1); - Canvas.Pen.Color := TestColor(clBtnShadow); - Canvas.LineTo(Horz.GridExtent, LIntTop - 1); - Canvas.MoveTo(ColWidths[0] - 1, LIntTop - 2); - Canvas.Pen.Color := TestColor(clBtnHighlight); - Canvas.LineTo(Horz.GridExtent, LIntTop - 2); - end - else if FDrawGridLines then - begin - Canvas.MoveTo(ColWidths[0] - 1, LIntTop - 1); - Canvas.Pen.Color := TestColor(FColors.Grid); - Canvas.LineTo(Horz.GridExtent, LIntTop - 1); - end; - end; - end; - -{$IFDEF DELPHI6UP} - if UseRightToLeftAlignment then - ChangeGridOrientation(False); -{$ENDIF} -end; - -procedure TCustomMPHexEditor.SetSelectionAsHex(const s: string); -var - LStrData: string; - LIntAmount: integer; -begin - if s <> '' then - begin - SetLength(LStrData, Length(s)); - ConvertHexToBin(@s[1], @LStrData[1], Length(s), SwapNibbles, LIntAmount); - SetLength(LStrData, LIntAmount); - SetSelectionAsText(LStrData); - end; -end; - -function TCustomMPHexEditor.GetSelectionAsText: string; -begin - if (DataSize < 1) or (SelCount < 1) then - Result := '' - else - begin - SetLength(Result, SelCount); - FDataStorage.ReadBufferAt(Result[1], Min(SelStart, SelEnd), SelCount); - end; -end; - -procedure TCustomMPHexEditor.SetSelectionAsText(const s: string); -begin - if s <> '' then - ReplaceSelection(@s[1], Length(s)); -end; - -procedure TCustomMPHexEditor.SetDrawGridLines(const Value: boolean); -begin - if Value <> FDrawGridLines then - begin - FDrawGridLines := Value; - Invalidate; - end; -end; - -function TCustomMPHexEditor.UndoBeginUpdate: integer; -begin - Result := FUndoStorage.BeginUpdate; -end; - -function TCustomMPHexEditor.UndoEndUpdate: integer; -begin - Result := FUndoStorage.EndUpdate; -end; - -function TCustomMPHexEditor.Undo: boolean; -begin - Result := FUndoStorage.Undo; -end; - -function TCustomMPHexEditor.Redo: boolean; -begin - Result := FUndoStorage.Redo; -end; - -procedure TCustomMPHexEditor.SetGutterWidth(const Value: integer); -begin - if FGutterWidth <> Value then - begin - FGutterWidth := Value; - SetOffsetDisplayWidth; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.BookmarkBitmapChanged(Sender: TObject); -var - LRctBox: TRect; -begin - // spalte 1 invalidieren - FBookmarkImageList.Clear; - FBookmarkImageList.AddMasked(FBookmarkBitmap, FBookmarkBitmap.Canvas.Pixels[0, - 0]); - if HandleAllocated then - begin - LRctBox := BoxRect(0, TopRow, 0, TopRow + VisibleRowCount); - InvalidateRect(Handle, @LRctBox, False); - end; -end; - -procedure TCustomMPHexEditor.SetBookmarkBitmap(const Value: TBitmap); -begin - if Value = nil then - FBookmarkBitmap.LoadFromResourceName(HINSTANCE, 'BOOKMARKICONS') - else - begin - if (Value.Width <> 200) or (Value.Height <> 10) then - raise EMPHexEditor.Create(ERR_INVALID_BOOKMARKBMP); - FBookmarkBitmap.Assign(Value); - end; - FHasCustomBMP := Value <> nil; -end; - -procedure TCustomMPHexEditor.SelectAll; -var - LgrcPosition: TGridCoord; -begin - if DataSize > 0 then - begin - // position auf ende stzen - if (not InsertMode) then - LgrcPosition := GetCursorAtPos(DataSize - 1, InCharField) - else - LgrcPosition := GetCursorAtPos(DataSize, InCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - - // alles wählen - NewSelection(0, Pred(DataSize)); - end; -end; - -function TCustomMPHexEditor.GetVersion: string; -begin - Result := MPH_VERSION; -end; - -procedure TCustomMPHexEditor.SetVersion(const Value: string); -begin - // readonly property -end; - -procedure TCustomMPHexEditor.FreeStorage(FreeUndo: boolean = False); -begin - if not FreeUndo then - FDataStorage.Size := 0 - else - FUndoStorage.Size := 0; -end; - -procedure TCustomMPHexEditor.OldCursor; -begin - if Length(FCursorList) > 0 then - begin - Cursor := FCursorList[Pred(Length(FCursorList))]; - SetLength(FCursorList, PRed(Length(FCursorList))); - end; -end; - -procedure TCustomMPHexEditor.WaitCursor; -begin - SetLength(FCursorList, Succ(Length(FCursorList))); - FCursorList[Pred(Length(FCursorList))] := Cursor; - Cursor := crHourGlass; -end; - -function TCustomMPHexEditor.HasCustomBookmarkBitmap: boolean; -begin - Result := FHasCustomBMP; -end; - -procedure TCustomMPHexEditor.PrepareOverwriteDiskFile; -begin - if FIsFileReadonly then - raise EFOpenError.CreateFmt(ERR_FILE_READONLY, [FileName]); -end; - -procedure TCustomMPHexEditor.Changed; -begin - if Assigned(FOnChange) then - FOnChange(self); - SelectionChanged; -end; - -procedure TCustomMPHexEditor.SetDrawGutter3D(const Value: boolean); -begin - if FDrawGutter3D <> Value then - begin - FDrawGutter3D := Value; - Repaint; - end; -end; - -procedure TCustomMPHexEditor.SetShowRuler(const Value: boolean); -begin - if (FShowRuler <> Value) or (csLoading in ComponentState) then - begin - FShowRuler := Value; - AdjustMetrics; - end; -end; - -function TCustomMPHexEditor.DisplayEnd: integer; -begin - if DataSize < 1 then - Result := -1 - else - Result := Min((DataSize - 1), (DisplayStart - 1) + (VisibleRowCount * - BytesPerRow)); -end; - -function TCustomMPHexEditor.DisplayStart: integer; -begin - if DataSize < 1 then - Result := -1 - else - Result := GetPosAtCursor(GRID_FIXED, TopRow); -end; - -procedure TCustomMPHexEditor.SetBytesPerUnit(const Value: integer); -begin - if FBytesPerUnit <> Value then - begin - if FUnicodeCharacters and (Value <> 2) then - raise EMPHexEditor.Create(ERR_INVALID_BPU_U); - if not (Value in [1, 2, 4, 8]) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_BPU, [Value]); - FBytesPerUnit := Value; - if FRulerBytesPerUnit = -1 then - FUsedRulerBytesPerUnit := Value; - with FOffsetFormat do - if offBytesPerUnit in Flags then - _BytesPerUnit := FUsedRulerBytesPerUnit; - AdjustMetrics; - SetRulerString; - if (SelCount mod FBytesPerUnit) <> 0 then - ResetSelection(False); - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetRulerString; -var - intLoop, intLen: Integer; - sLoop: string; -begin - FRulerString := ''; - intLen := 2 * FUsedRulerBytesPerUnit; - for intLoop := 0 to Pred(FBytesPerRow div FUsedRulerBytesPerUnit) do - begin - sLoop := IntToRadixLen(intLoop, FRulerNumberBase, intLen); - if Length(sLoop) > intLen then - Delete(sLoop, 1, Length(sLoop) - intLen); - FRulerString := FRulerString + sLoop; - end; - if FHexLowerCase then - FRulerString := LowerCase(FRulerString) - else - FRulerString := UpperCase(FRulerString); - FRulerCharString := ''; - if FUnicodeCharacters then - intLen := FUsedRulerBytesPerUnit div 2 - else - intLen := FUsedRulerBytesPerUnit; - for intLoop := 0 to Pred(FBytesPerRow div FUsedRulerBytesPerUnit) do - begin - sLoop := IntToRadix(intLoop, FRulerNumberBase); - if Length(sLoop) > intLen then - Delete(sLoop, 1, Length(sLoop) - intLen) - else - while Length(sLoop) < intLen do - sLoop := ' ' + sLoop; - FRulerCharString := FRulerCharString + sLoop; - end; - if FHexLowerCase then - FRulerCharString := LowerCase(FRulerCharString) - else - FRulerCharString := UpperCase(FRulerCharString); -end; - -procedure TCustomMPHexEditor.CheckSelectUnit(var AStart, AEnd: Integer); -begin - // assure that the selection covers a whole unit - if AStart <= AEnd then - begin - CheckUnit(AStart); - CheckUnit(AEnd); - Inc(AEnd, FBytesPerUnit - 1); - if (AEnd >= DataSize) then - AEnd := Pred(DataSize); - end - else - begin - CheckUnit(AEnd); - CheckUnit(AStart); - Inc(AStart, FBytesPerUnit - 1); - if (AStart >= DataSize) then - AStart := Pred(DataSize); - end; -end; - -// make sure the value is a multiple of FBytesPerUnit - -procedure TCustomMPHexEditor.CheckUnit(var AValue: Integer); -begin - AValue := AValue div FBytesPerUnit * FBytesPerUnit; -end; - -procedure TCustomMPHexEditor.SelectionChanged; -begin - if FSelectionChangedCount = 0 then - PostMessage(Handle, CM_SELECTIONCHANGED, 0, 0); - Inc(FSelectionChangedCount); -end; - -procedure TCustomMPHexEditor.SyncView(Source: TCustomMPHexEditor; - SyncOffset: integer = 0); -var - curPos, SelS, SelE: integer; - coord: TGridCoord; -begin - if (Source.BytesPerRow = BytesPerRow) and (Source.BytesPerColumn = - BytesPerColumn) and (Source.BytesPerUnit = BytesPerUnit) and (Source.DataSize - = DataSize) and (SyncOffset = 0) then - begin - TopRow := Source.TopRow; - LeftCol := Source.LeftCol; - MoveColRow(Source.Col, Source.Row, True, False); - end - else - begin - // get the current view - curPos := Source.GetCursorPos; - coord := Source.GetCursorAtPos(curPos, Source.InCharField); - with Source.CellRect(coord.X, coord.Y) do - if Left + Bottom = 0 then - begin - curPos := Source.GetPositionAtCursor(Source.LeftCol, Source.TopRow) + - SyncOffset; - if curPos >= DataSize then - curPos := Pred(DataSize); - if curPos < 0 then - curPos := 0; - coord := GetCursorAtPos(curPos, Source.InCharField); - LeftCol := coord.X; - TopRow := coord.Y; - end - else - begin - // use this value if visible, left/top otherwise (when wheeling or scrolling) - curPos := curPos + SyncOffset; - if curPos >= DataSize then - curPos := Pred(DataSize); - if curPos < 0 then - curPos := 0; - coord := GetCursorAtPos(curPos, Source.InCharField); - MoveColRow(coord.X, coord.Y, True, True); - end; - end; - if (Source.SelCount = 0) then - begin - if (SelCount <> 0) then - ResetSelection(True) - end - else - begin - SelS := Source.FSelStart + SyncOffset; - SelE := Source.FSelEnd + SyncOffset; - if SelE >= DataSize then - SelE := DataSize - 1; - if SelS >= DataSize then - SelS := DataSize - 1; - if SelE < 0 then - SelE := 0; - if SelS < 0 then - SelS := 0; - NewSelection(SelS, SelE); - end; -end; - -procedure TCustomMPHexEditor.CMSelectionChanged(var Msg: TMessage); -begin - if (FSelectionChangedCount <> 0) and Assigned(FOnSelectionChanged) then - try - FOnSelectionChanged(self); - finally - FSelectionChangedCount := 0; - end; -end; - -procedure TCustomMPHexEditor.SetRulerBytesPerUnit(const Value: integer); -begin - if FRulerBytesPerUnit <> Value then - begin - if (not (Value in [1, 2, 4, 8])) and (Value <> -1) then - raise EMPHexEditor.CreateFmt(ERR_INVALID_RBPU, [Value]); - FRulerBytesPerUnit := Value; - if Value = -1 then - FUsedRulerBytesPerUnit := FBytesPerUnit - else - FUsedRulerBytesPerUnit := Value; - with FOffsetFormat do - if offBytesPerUnit in Flags then - _BytesPerUnit := FUsedRulerBytesPerUnit; - AdjustMetrics; - SetRulerString; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetShowPositionIfNotFocused(const Value: Boolean); -begin - if FShowPositionIfNotFocused <> Value then - begin - FShowPositionIfNotFocused := Value; - Invalidate; - end; -end; - -function TCustomMPHexEditor.GetDataAt(Index: integer): Byte; -begin -{$IFDEF FASTACCESS} - //FDataStorage.CheckBounds(Index+1); -{$R-} - Result := GetFastPointer^[Index]; -{$ELSE} - ReadBuffer(Result, Index, sizeof(Result)); -{$ENDIF} -end; - -procedure TCustomMPHexEditor.SetDataAt(Index: integer; const Value: Byte); -begin -{$IFDEF FASTACCESS} - //FDataStorage.CheckBounds(Index+1); - GetFastPointer^[Index] := Value; -{$ELSE} - WriteBuffer(Value, Index, sizeof(Value)); -{$ENDIF} -end; - -procedure TCustomMPHexEditor.ReadBuffer(var Buffer; const Index, Count: - Integer); -begin -{$IFDEF FASTACCESS} - //FDataStorage.CheckBounds(Index+Count); - Move(GetFastPointer^[Index], Buffer, Count); -{$ELSE} - FDataStorage.ReadBufferAt(Buffer, Index, Count); -{$ENDIF} -end; - -procedure TCustomMPHexEditor.WriteBuffer(const Buffer; const Index, Count: - Integer); -begin -{$IFDEF FASTACCESS} - //FDataStorage.CheckBounds(Index+Count); - Move(Buffer, GetFastPointer^[Index], Count); -{$ELSE} - FDataStorage.WriteBufferAt(Buffer, Index, Count); -{$ENDIF} -end; - -// fire OnBookmarkChanged - -procedure TCustomMPHexEditor.BookmarkChanged; -begin - if Assigned(FOnBookmarkChanged) then - FOnBookmarkChanged(self); -end; - -procedure TCustomMPHexEditor.DoSetCellWidth(const Index: integer; - Value: integer); -begin - ColWidths[Index] := Value; -end; - -// legacy, do not use - -function TCustomMPHexEditor.GetMemory(const Index: Integer): char; -begin - Result := Char(Data[Index]) -end; - -// legacy, do not use - -procedure TCustomMPHexEditor.SetMemory(const Index: integer; const Value: char); -begin - Data[Index] := Ord(Value); -end; - -procedure TCustomMPHexEditor.SetUnicodeCharacters(const Value: Boolean); -begin - if FUnicodeCharacters <> Value then - begin - if Value then - begin - if (BytesPerRow mod 2) <> 0 then - raise EMPHexEditor.Create(ERR_INVALID_BYTESPERLINE); - if (BytesPerColumn mod 2) <> 0 then - raise EMPHexEditor.Create(ERR_INVALID_BYTESPERCOL); - if (DataSize mod 2) <> 0 then - raise EMPHexEditor.Create(ERR_ODD_FILESIZE_UNICODE); - FTranslation := tkAsIs; - end; - FUnicodeCharacters := Value; - ColCount := CalcColCount; - if Value then - BytesPerUnit := 2 - else - BytesPerUnit := 1; - - CalcSizes; - SetRulerString; - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetUnicodeBigEndian(const Value: Boolean); -begin - if FUnicodeBigEndian <> Value then - begin - FUnicodeBigEndian := Value; - if FUnicodeCharacters then - Invalidate; - end; -end; - -function TCustomMPHexEditor.GetPositionAtCursor(const ACol, - ARow: integer): integer; -var - LBoolInCharField: Boolean; -begin - LBoolInCharField := FPosInCharField; - try - Result := GetPosAtCursor(ACol, ARow); - finally - FPosInCharField:=(LBoolInCharField); - end; -end; - -function TCustomMPHexEditor.GetIsCharFieldCol( - const ACol: integer): Boolean; -begin - Result := ACol > (GRID_FIXED + FBytesPerRowDup); -end; - -function TCustomMPHexEditor.IsFileSizeFixed: boolean; -begin - if FFixedFileSizeOverride then - Result := False - else - Result := FFixedFileSize; -end; - -function TCustomMPHexEditor.IsInsertModePossible: boolean; -begin - Result := (not IsFileSizeFixed) and FAllowInsertMode and (not FReadOnlyView) -end; - -function TCustomMPHexEditor.Replace(aBuffer: PChar; aPosition, aOldCount, - aNewCount: integer; - const UndoDesc: string = ''; const MoveCursor: Boolean = False): integer; -var - LBoolInCharField: boolean; -begin - // auswahl berechnen - LBoolInCharField := GetInCharField; - if DataSize - APosition < aOldCount then - begin - if aNewCount = aOldCount then - aNewCount := DataSize - APosition; - aOldCount := DataSize - APosition; - end; - if IsFileSizeFixed then - begin - if aOldCount < aNewCount then - aNewCount := aOldCount - else - aOldCount := aNewCount; - end; - - CreateUndo(ufKindReplace, APosition, aNewCount, aOldCount, UndoDesc); - - if not MoveCursor then - FUndoStorage.AddSelection(APosition, aOldCount); - - if aOldCount = aNewCount then - WriteBuffer(aBuffer^, APosition, aOldCount) - else - begin - if aOldCount > 0 then - InternalDelete(APosition, APosition + aOldCount, Col, Row); - if aNewCount > 0 then - InternalInsertBuffer(aBuffer, aNewCount, APosition); - end; - Result := aNewCount; - if FModifiedBytes.Size >= APosition then - FModifiedBytes.Size := Max(0, APosition); - - if MoveCursor then - begin - with GetCursorAtPos(APosition, LBoolInCharField) do - MoveColRow(x, y, True, True); - end; - Invalidate; - Changed; -end; - -function TCustomMPHexEditor.GotoBookmark(const Index: integer): boolean; -var - LIntRow: integer; - LgrcPosition: TGridCoord; -begin - Result := False; - if FBookmarks[Index].mPosition > -1 then - begin - ResetSelection(True); - LIntRow := FBookmarks[Index].mPosition; - if (LIntRow < DataSize) or ((LIntRow = DataSize) and InsertMode) then - begin - LgrcPosition := GetCursorAtPos(LIntRow, FBookmarks[Index].mInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True); - Result := True; - end - else - SetBookmarkVals(Index, -1, False); - end; -end; - -procedure TCustomMPHexEditor.UpdateGetOffsetText; -begin - SetOffsetDisplayWidth; - Invalidate; -end; - -{$IFDEF FASTACCESS} - -function TCustomMPHexEditor.GetFastPointer: PByteArray; -begin - Result := FDataStorage.Memory; -end; -{$ENDIF} - -procedure TCustomMPHexEditor.SeekToEOF; -var - LgrcPosition: TGridCoord; -begin - InCharField; - if (not InsertMode) then - LgrcPosition := GetCursorAtPos(DataSize - 1, FPosInCharField) - else - LgrcPosition := GetCursorAtPos(DataSize, FPosInCharField); - MoveColRow(LgrcPosition.x, LgrcPosition.y, True, True) -end; - -function TCustomMPHexEditor.CanCreateUndo(const aKind: TMPHUndoFlag; const - aCount, - aReplCount: integer): Boolean; -begin - Result := False; - if DataSize > 0 then - Result := True; - - if not Result then - if aKind in [ufKindInsertBuffer, ufKindAppendBuffer, ufKindAllData] then - Result := True; - - // check for NoSizeChange - if IsFileSizeFixed and Result then - if (aKind in [ufKindByteRemoved, ufKindInsertBuffer, ufKindAppendBuffer, - ufKindNibbleInsert, - ufKindNibbleDelete]) or - ((aKind = ufKindReplace) and (aCount <> aReplCount)) then - Result := False; - - if (not Result) and ((aKind = ufKindCombined) and (FUndoStorage.Count >= - aCount)) then - Result := True; - -end; - -procedure TCustomMPHexEditor.SetDataSize(const Value: integer); -var - iPos: Integer; - iSize: integer; -begin - iSize := DataSize; - if Value <> iSize then - begin - iPos := GetCursorPos; - - // new in 12-16-2003: don't allow change of datasize if nosizechange - // and (new datasize <> 0 and old datasize <> 0) - if (Value <> 0) and (iSize <> 0) and IsFileSizeFixed then - raise EMPHexEditor.Create(ERR_FIXED_FILESIZE); - - FFixedFileSizeOverride := True; - try - // new in 12-16-2003: generate undo - if Value < iSize then - // create a 'bytes deleted' undo - CreateUndo(ufKindByteRemoved, Value, DataSize - Value, 0) - else - // create a 'append buffer' undo - CreateUndo(ufKindAppendBuffer, DataSize, Value - DataSize, 0); - FDataStorage.Size := Value; -{$IFDEF FASTACCESS} - if Value > iSize then - // fill the new data block - FillChar(FastPointer^[iSize], Value - iSize, FSetDataSizeFillByte); -{$ENDIF} - FModified := True; - CalcSizes; - if iPos > DataSize then - begin - ResetSelection(True); - if (DataSize = 0) and (not InsertMode) then - begin - with GetCursorAtPos(0, InCharField) do - MoveColRow(X, Y, True, True); - end - else - SeekToEOF; - end; - finally - FFixedFileSizeOverride := False; - end; - end; -end; - -procedure TCustomMPHexEditor.SetBlockSize(const Value: Integer); -begin - if FBlockSize <> Value then - begin - FBlockSize := Value; - AdjustMetrics; - end; -end; - -procedure TCustomMPHexEditor.SetSepCharBlocks(const Value: boolean); -begin - if FSepCharBlocks <> Value then - begin - FSepCharBlocks := Value; - if Value and (FBlockSize > 1) then - AdjustMetrics; - end; -end; - -procedure TCustomMPHexEditor.SetFindProgress(const Value: boolean); -begin - FFindProgress := Value; -end; - -procedure TCustomMPHexEditor.DefineProperties(Filer: TFiler); -begin - inherited; - Filer.DefineProperty('MaskChar', ReadMaskChar, nil, False); - Filer.DefineProperty('MaskChar_AsInteger', ReadMaskChar_I, WriteMaskChar_I, - FReplaceUnprintableCharsBy <> '.'); -end; - -procedure TCustomMPHexEditor.ReadMaskChar(Reader: TReader); -var - s: string; -begin - s := Reader.ReadString; - if Length(s) <> 1 then - FReplaceUnprintableCharsBy := '.' - else - try - FReplaceUnprintableCharsBy := s[1]; - except - FReplaceUnprintableCharsBy := '.'; - end; -end; - -procedure TCustomMPHexEditor.ReadMaskChar_I(Reader: TReader); -begin - try - Byte(FReplaceUnprintableCharsBy) := Reader.ReadInteger; - except - FReplaceUnprintableCharsBy := '.'; - end; -end; - -procedure TCustomMPHexEditor.WriteMaskChar_I(Writer: TWriter); -begin - Writer.WriteInteger(Byte(FReplaceUnprintableCharsBy)); -end; - -function TCustomMPHexEditor.DoMouseWheelDown(Shift: TShiftState; - MousePos: TPoint): boolean; -begin - if Shift <> [] then - Result := inherited DoMouseWheelDown(Shift, MousePos) - else - begin - // scroll down one page - TopRow := Min(Max(GRID_FIXED, RowCount - VisibleRowCount), - TopRow + VisibleRowCount - 1); - CheckSetCaret; - Result := True; - end; -end; - -function TCustomMPHexEditor.DoMouseWheelUp(Shift: TShiftState; - MousePos: TPoint): boolean; -begin - if Shift <> [] then - Result := inherited DoMouseWheelUp(Shift, MousePos) - else - begin - // scroll up one page - TopRow := Max(GRID_FIXED, TopRow - VisibleRowCount + 1); - CheckSetCaret; - Result := True; - end; -end; - -procedure TCustomMPHexEditor.CheckSetCaret; -begin - with CellRect(Col, Row) do - begin - if Left + Bottom = 0 then - IntSetCaretPos(-50, -50,-1) - else - IntSetCaretPos(Left, Top, Col); - end; -end; - -function TCustomMPHexEditor.CanFocus: Boolean; -var - Form: TCustomForm; -begin - Result := {$IFDEF DELPHI5UP}inherited CanFocus{$ELSE}True{$ENDIF}; - if Result and not (csDesigning in ComponentState) then - begin - Form := GetParentForm(Self); - Result := (not Assigned(Form)) or (Form.Enabled and Form.Visible); - end; -end; - -procedure TCustomMPHexEditor.SetRulerNumberBase(const Value: byte); -begin - if FRulerNumberBase <> Value then - begin - // force number that can be represented using '0'-'9','A'-'F' - if not (Value in [2..16]) then - FRulerNumberBase := 16 - else - FRulerNumberBase := Value; - SetRulerString; - if FShowRuler then - Invalidate; - end; -end; - -procedure TCustomMPHexEditor.SetMaskedChars(const Value: TSysCharSet); -begin - if FMaskedChars <> Value then - begin - FMaskedChars := Value; - Invalidate; - end; -end; - -{ TMPHColors } - -procedure TMPHColors.Assign(Source: TPersistent); -begin - if Source is TMPHColors then - begin - Background := TMPHColors(Source).Background; - ChangedText := TMPHColors(Source).ChangedText; - CursorFrame := TMPHColors(Source).CursorFrame; - NonFocusCursorFrame := TMPHColors(Source).NonFocusCursorFrame; - Offset := TMPHColors(Source).Offset; - OddColumn := TMPHColors(Source).OddColumn; - EvenColumn := TMPHColors(Source).EvenColumn; - ChangedBackground := TMPHColors(Source).ChangedBackground; - CurrentOffsetBackground := TMPHColors(Source).CurrentOffsetBackground; - CurrentOffset := TMPHColors(Source).CurrentOffset; - OffsetBackground := TMPHColors(Source).OffsetBackground; - ActiveFieldBackground := TMPHColors(Source).ActiveFieldBackground; - Grid := TMPHColors(Source).Grid; - end; -end; - -constructor TMPHColors.Create(Parent: TControl); -begin - inherited Create; - FBackground := clWindow; - FActiveFieldBackground := clWindow; - FChangedText := clMaroon; - FCursorFrame := clNavy; - FNonFocusCursorFrame := clAqua; - FOffset := clBlack; - FOddColumn := clBlue; - FEvenColumn := clNavy; - FChangedBackground := $00A8FFFF; - FCurrentOffsetBackground := clBtnShadow; - FCurrentOffset := clBtnHighLight; - FOffsetBackground := clBtnFace; - FGrid := clBtnFace; - FParent := Parent; -end; - -procedure TMPHColors.SetBackground(const Value: TColor); -begin - if FBackground <> Value then - begin - FBackground := Value; - if Assigned(fParent) then - begin - TCustomMPHexEditor(FParent).Color := Value; - fParent.Invalidate; - end; - end; -end; - -procedure TMPHColors.SetChangedBackground(const Value: TColor); -begin - if FChangedBackground <> Value then - begin - FChangedBackground := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetCurrentOffsetBackground(const Value: TColor); -begin - if FCurrentOffsetBackground <> Value then - begin - FCurrentOffsetBackground := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetNonFocusCursorFrame(const Value: TColor); -begin - if FNonFocusCursorFrame <> Value then - begin - FNonFocusCursorFrame := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetChangedText(const Value: TColor); -begin - if FChangedText <> Value then - begin - FChangedText := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetCursorFrame(const Value: TColor); -begin - if FCursorFrame <> Value then - begin - FCursorFrame := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetEvenColumn(const Value: TColor); -begin - if FEvenColumn <> Value then - begin - FEvenColumn := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetOddColumn(const Value: TColor); -begin - if FOddColumn <> Value then - begin - FOddColumn := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetOffset(const Value: TColor); -begin - if FOffset <> Value then - begin - FOffset := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetOffsetBackGround(const Value: TColor); -begin - if FOffsetBackGround <> Value then - begin - FOffsetBackGround := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetCurrentOffset(const Value: TColor); -begin - if FCurrentOffset <> Value then - begin - FCurrentOffset := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetParent(const Value: TControl); -begin - FParent := Value; - Assign(self); -end; - -procedure TMPHColors.SetGrid(const Value: TColor); -begin - if FGrid <> Value then - begin - FGrid := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -procedure TMPHColors.SetActiveFieldBackground(const Value: TColor); -begin - if FActiveFieldBackground <> Value then - begin - FActiveFieldBackground := Value; - if Assigned(fParent) then - fParent.Invalidate; - end; -end; - -{ TMPHUndoStorage } - -type - - // undo storage - - PUndoSelRec = ^TUndoSelRec; - TUndoSelRec = packed record - SelStart, - SelEnd, - SelPos: integer; - end; - -constructor TMPHUndoStorage.Create(AEditor: TCustomMPHexEditor); -begin - inherited Create; - FEditor := AEditor; - FRedoPointer := nil; - FLastUndo := nil; - FLastUndoSize := 0; - Reset; -end; - -destructor TMPHUndoStorage.Destroy; -begin - Reset; - inherited; -end; - -function TMPHUndoStorage.BeginUpdate: integer; -begin - Inc(FUpdateCount); - Result := FUpdateCount; -end; - -function TMPHUndoStorage.CanUndo: boolean; -begin - Result := (FCount > 0) and (FUpdateCount < 1) and (Size > 0); -end; - -procedure TMPHUndoStorage.CreateUndo(aKind: TMPHUndoFlag; APosition, ACount, - AReplaceCount: integer; const SDescription: string); -var - LPurUndoRec: PMPHUndoRec; - - procedure NewFillBuffer(ASize: integer); - var - i: integer; - begin - i := Position; - (*if FEditor.FSelPosition > -1 then - ASize := ASize+sizeof(TUndoSelRec);*) - - Size := Size + sizeof(TMPHUndoRec) + ASize; - LPurUndoRec := PMPHUndoRec(@(PChar(Memory)[i])); - - FillChar(LPurUndoRec^, SizeOf(TMPHUndoRec) + ASize, 0); - with LPurUndoRec^ do - begin - Flags := [aKind]; - CurPos := FEditor.GetPosAtCursor(FEditor.Col, FEditor.Row); - if not FEditor.FPosInCharField then - with FEditor.GetCursorAtPos(CurPos, FEditor.FPosInCharField) do - if (FEditor.Col - x) <> 0 then - Include(Flags, ufFlag2ndByteCol); - if FEditor.FPosInCharField then - Include(Flags, ufFlagInCharField); - if FEditor.FInsertModeOn then - Include(Flags, ufFlagInsertMode); - Pos := aPosition; - Count := aCount; - ReplCount := aReplaceCount; - CurTranslation := FEditor.FTranslation; - if FEditor.UnicodeChars then - Include(Flags, ufFlagIsUnicode); - if FEditor.UnicodeBigEndian then - Include(Flags, ufFlagIsUnicodeBigEndian); - CurBPU := FEditor.BytesPerUnit; - if FEditor.FModified then - Include(Flags, ufFlagModified); - if FEditor.FSelPosition > -1 then - Include(Flags, ufFlagHasSelection); - if SDescription <> '' then - Include(Flags, ufFlagHasDescription); - end; - end; - - procedure DeleteOldestUndoRec; - var - LintRecSize: integer; - begin - begin - if Size < 4 then - begin - Size := 0; - FCount := 0; - end - else - begin - Seek(0, soFromBeginning); - Read(LIntRecSize, sizeof(integer)); - if LIntRecSize < sizeof(TMPHUndoRec) then - begin - Size := 0; - FCount := 0; - end - else - begin - Move(PChar(Memory)[LIntRecSize], Memory^, Size - LIntRecSize); - Size := Size - LIntRecSize; - Dec(FCount); - end; - end; - end; - end; - - procedure UpdateUndoRecord(Length: integer = 0); - var - LRecSelection: TUndoSelRec; - i: integer; - begin - LPurUndoRec^.DataLen := SizeOf(TMPHUndoRec) + Length + 4; - if ufFlagHasSelection in LPurUndoRec^.Flags then - Inc(LPurUndoRec^.DataLen, sizeof(TUndoSelRec)); - if ufFlagHasDescription in LPurUndoRec^.Flags then - Inc(LPurUndoRec^.DataLen, system.Length(SDescription) + sizeof(i)); - - Position := Size; - if ufFlagHasDescription in LPurUndoRec^.Flags then - begin - write(Sdescription[1], system.Length(SDescription)); - i := system.Length(sDescription); - write(i, sizeof(i)); - Length := Length + i + sizeof(i); - end; - - if ufFlagHasSelection in LPurUndoRec^.Flags then - begin - with LRecSelection do - begin - SelStart := FEditor.FSelStart; - SelEnd := FEditor.FSelEnd; - SelPos := FEditor.FSelPosition; - end; - Write(LRecSelection, sizeof(LRecSelection)); - Length := Length + sizeof(LRecSelection); - end; - - Length := SizeOf(TMPHUndoRec) + 4 + Length; - Write(Length, 4); - end; - -var - LPtrBytes: PByteArray; - LSStDesc: shortstring; -begin - if FUpdateCount < 1 then - begin - ResetRedo; - - if sDescription <> '' then - FDescription := sDescription - else - FDescription := STRS_UNDODESC[aKind]; - - while (FEditor.FMaxUndo > 0) and (FCount > 0) and (Size > FEditor.FMaxUndo) - do - DeleteOldestUndoRec; - - Position := Size; - - Inc(FCount); - - case aKind of - ufKindBytesChanged: - begin - NewFillBuffer(aCount - 1); - LPtrBytes := PByteArray(@LPurUndoRec.Buffer); - FEditor.ReadBuffer(LPtrBytes^, aPosition, aCount); - if FEditor.HasChanged(aPosition) then - Include(LPurUndoRec.Flags, ufFlagByte1Changed); - if (aCount = 2) and FEditor.HasChanged(aPosition + 1) then - Include(LPurUndoRec.Flags, ufFlagByte2Changed); - UpdateUndoRecord(aCount - 1); - end; - ufKindByteRemoved: - begin - NewFillBuffer(aCount - 1); - LPtrBytes := PByteArray(@LPurUndoRec.Buffer); - FEditor.ReadBuffer(LPtrBytes^, aPosition, aCount); - FEditor.AdjustBookmarks(aPosition + aCount, -aCount); - UpdateUndoRecord(aCount - 1); - end; - ufKindInsertBuffer: - begin - NewFillBuffer(0); - FEditor.AdjustBookmarks(aPosition, aCount); - UpdateUndoRecord; - end; - ufKindReplace: - begin - NewFillBuffer(aReplaceCount - 1); - LPtrBytes := PByteArray(@LPurUndoRec.Buffer); - FEditor.ReadBuffer(LPtrBytes^, aPosition, aReplaceCount); - FEditor.AdjustBookmarks(aPosition + aCount, aCount - aReplaceCount); - UpdateUndoRecord(aReplaceCount - 1); - end; - ufKindAppendBuffer: - begin - NewFillBuffer(0); - UpdateUndoRecord; - end; - ufKindNibbleInsert: - begin - NewFillBuffer(0); - LPurUndoRec.Buffer := FEditor.Data[aPosition]; - if FEditor.HasChanged(aPosition) then - Include(LPurUndoRec.Flags, ufFlagByte1Changed); - UpdateUndoRecord; - end; - ufKindNibbleDelete: - begin - NewFillBuffer(0); - LPurUndoRec.Buffer := FEditor.Data[aPosition]; - if FEditor.HasChanged(aPosition) then - Include(LPurUndoRec.Flags, ufFlagByte1Changed); - UpdateUndoRecord; - end; - ufKindConvert: - begin - NewFillBuffer(aCount - 1); - LPtrBytes := PByteArray(@LPurUndoRec.Buffer); - FEditor.ReadBuffer(LPtrBytes^, aPosition, aCount); - UpdateUndoRecord(aCount - 1); - end; - ufKindSelection: - begin - NewFillBuffer(0); - LPurUndoRec^.CurPos := APosition; - UpdateUndoRecord; - AddSelection(APosition, ACount); - end; - ufKindAllData: - begin - aCount := FEditor.DataSize; - if aCount = 0 then - NewFillBuffer(0) - else - NewFillBuffer(aCount - 1); - LPtrBytes := PByteArray(@LPurUndoRec.Buffer); - if aCount > 0 then - FEditor.ReadBuffer(LPtrBytes^, 0, aCount); - if aCount = 0 then - UpdateUndoRecord - else - UpdateUndoRecord(aCount - 1); - end; - ufKindCombined: - begin - LSStDesc := sDescription; - NewFillBuffer(Length(LSStDesc)); - LPurUndoRec.Buffer := aCount; - if FEditor.HasChanged(aPosition) then - Include(LPurUndoRec.Flags, ufFlagByte1Changed); - Move(LSStDesc[0], LPurUndoRec^.Buffer, Length(LSStDesc) + 1); - UpdateUndoRecord(Length(LSStDesc)); - end; - end; - end; -end; - -function TMPHUndoStorage.EndUpdate: integer; -begin - Dec(FUpdateCount); - if FUpdateCount < 0 then - FUpdateCount := 0; - Result := FUpdateCount; -end; - -function TMPHUndoStorage.Undo: boolean; - - procedure PopulateUndo(const aBuffer: TMPHUndoRec); - var - LRecSel: TUndoSelRec; - begin - with FEditor.GetCursorAtPos(aBuffer.CurPos, ufFlagInCharField in - aBuffer.Flags) do - begin - if not (ufFlagInCharField in aBuffer.Flags) then - if FEditor.DataSize > 0 then - if ufFlag2ndByteCol in aBuffer.Flags then - x := x + 1; - - FEditor.MoveColRow(x, y, True, True); - end; - FEditor.FModified := ufFlagModified in aBuffer.Flags; - FEditor.InsertMode := (ufFlagInsertMode in aBuffer.Flags); - if ufFlagHasSelection in aBuffer.Flags then - begin - Position := Size - 4 - sizeof(LRecSel); - Read(LRecSel, sizeof(LRecSel)); - with LRecSel do - begin - if SelEnd = -1 then - FEditor.Seek(SelStart, FILE_BEGIN) - else - FEditor.SetSelection(SelPos, SelStart, SelEnd); - end; - end; - FEditor.UnicodeChars := (ufFlagIsUnicode in aBuffer.Flags); - FEditor.UnicodeBigEndian := (ufFlagIsUnicodeBigEndian in aBuffer.Flags); - if not FEditor.UnicodeChars then - FEditor.Translation := aBuffer.CurTranslation - else - FEditor.FTranslation := aBuffer.CurTranslation; - FEditor.BytesPerUnit := aBuffer.CurBPU; - FEditor.Invalidate; - FEditor.Changed; - end; - -var - LEnumUndo: TMPHUndoFlag; - LRecUndo: TMPHUndoRec; - LIntLoop: integer; - s: string; -begin - Result := False; - if not CanUndo then - begin - Reset(False); - Exit; - end; - - if Size >= sizeof(TMPHUndoRec) then - begin - // letzten eintrag lesen - LEnumUndo := ReadUndoRecord(LRecUndo, s); - // redo erstellen - CreateRedo(LRecUndo); - case LEnumUndo of - ufKindBytesChanged: - begin - FEditor.WriteBuffer(PChar(Memory)[Position - 1], LRecUndo.Pos, - LRecUndo.Count); - FEditor.SetChanged(LRecUndo.Pos, ufFlagByte1Changed in - LRecUndo.Flags); - if LRecUndo.Count = 2 then - FEditor.SetChanged(LRecUndo.Pos + 1, ufFlagByte2Changed in - LRecUndo.Flags); - PopulateUndo(LRecUndo); - FEditor.RedrawPos(LRecUndo.Pos, LRecUndo.Pos + LRecUndo.Count - 1); - RemoveLastUndo; - end; - ufKindByteRemoved: - begin - FEditor.InternalInsertBuffer(Pointer(integer(Memory) + Position - 1), - LRecUndo.Count, LRecUndo.Pos); - PopulateUndo(LRecUndo); - FEditor.AdjustBookmarks(LRecUndo.Pos - LRecUndo.Count, - LRecUndo.Count); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindInsertBuffer: - begin - FEditor.InternalDelete(LRecUndo.Pos, LRecUndo.Pos + LRecUndo.Count, - -1, 0); - PopulateUndo(LRecUndo); - FEditor.AdjustBookmarks(LRecUndo.Pos, -LRecUndo.Count); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindSelection: - begin - PopulateUndo(LRecUndo); - RemoveLastUndo; - end; - ufKindAllData: - begin - FEditor.FDataStorage.Size := LRecUndo.Count; - FEditor.FDataStorage.WriteBufferAt(Pointer(integer(Memory) + Position - - 1)^, 0, - LRecUndo.Count); - FEditor.CalcSizes; - PopulateUndo(LRecUndo); - RemoveLastUndo; - end; - ufKindReplace: - begin - FEditor.InternalDelete(LRecUndo.Pos, LRecUndo.Pos + LRecUndo.Count, - -1, 0); - FEditor.InternalInsertBuffer(Pointer(integer(Memory) + Position - 1), - LRecUndo.ReplCount, LRecUndo.Pos); - PopulateUndo(LRecUndo); - FEditor.AdjustBookmarks(LRecUndo.Pos + LRecUndo.ReplCount, - LRecUndo.ReplCount - LRecUndo.Count); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - // was: - // FEditor.FModifiedBytes.Size := Max(0, LRecUndo.Pos - 1); - // line above might lead to an integer overflow - begin - if LRecUndo.Pos > 0 then - FEditor.FModifiedBytes.Size := LRecUndo.Pos - 1 - else - FEditor.FModifiedBytes.Size := 0; - end; - - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindAppendBuffer: - begin - FEditor.Col := GRID_FIXED; - FEditor.FDataStorage.Size := LRecUndo.Pos; - FEditor.CalcSizes; - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - PopulateUndo(LRecUndo); - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindNibbleInsert: - begin - FEditor.InternalDeleteNibble(LRecUndo.Pos, False); - FEditor.Data[LRecUndo.Pos] := LRecUndo.Buffer; - FEditor.SetChanged(LRecUndo.Pos, ufFlagByte1Changed in - LRecUndo.Flags); - PopulateUndo(LRecUndo); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - FEditor.FDataStorage.Size := FEditor.FDataStorage.Size - 1; - FEditor.CalcSizes; - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindNibbleDelete: - begin - FEditor.InternalInsertNibble(LRecUndo.Pos, False); - FEditor.Data[LRecUndo.Pos] := LRecUndo.Buffer; - FEditor.SetChanged(LRecUndo.Pos, ufFlagByte1Changed in - LRecUndo.Flags); - PopulateUndo(LRecUndo); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - FEditor.FDataStorage.Size := FEditor.FDataStorage.Size - 1; - FEditor.CalcSizes; - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindConvert: - begin - FEditor.WriteBuffer(PChar(Memory)[Position - 1], LRecUndo.Pos, - LRecUndo.Count); - PopulateUndo(LRecUndo); - if DWORD(FEditor.FModifiedBytes.Size) >= (LRecUndo.Pos) then - FEditor.FModifiedBytes.Size := LRecUndo.Pos; - FEditor.Invalidate; - RemoveLastUndo; - end; - ufKindCombined: - begin - LIntLoop := LRecUndo.Count; - RemoveLastUndo; - for LIntLoop := 1 to LIntLoop do - Undo; - ResetRedo; - end; - end; - end - else - Reset; -end; - -procedure TMPHUndoStorage.RemoveLastUndo; -var - LRecUndo: TMPHUndoRec; - LSStDesc: shortstring; - LIntRecOffs: integer; -begin - if Size < sizeof(TMPHUndoRec) then - Reset(False) - else - begin - Position := Size - 4; - Read(LIntRecOffs, 4); - // restore record in case of a redo - Seek(-LIntRecOffs, soFromCurrent); - ReAllocMem(FLastUndo, LIntRecOffs); - Read(FLastUndo^, LIntRecOffs); - FLastUndoSize := LIntRecOffs; - FLastUndoDesc := FDescription; - - // delete last undo record - SetSize(Max(0, Size - LIntRecOffs)); - Dec(FCount); - if Size < sizeof(TMPHUndoRec) then - begin - Reset(False); - end - else - begin - if ReadUndoRecord(LRecUndo, FDescription) <> ufKindCombined then - begin - if FDescription = '' then - FDescription := STRS_UNDODESC[GetUndoKind(LRecUndo.Flags)] - end - else - begin - if LRecUndo.Buffer = 0 then - LSStDesc := '' - else - begin - Read(LSStDesc[1], LRecUndo.Buffer); - LSStDesc[0] := char(LRecUndo.Buffer); - end; - if LSStDesc = '' then - FDescription := STRS_UNDODESC[GetUndoKind(LRecUndo.Flags)] - else - FDescription := LSStDesc; - end; - end; - end; -end; - -procedure TMPHUndoStorage.SetSize(NewSize: integer); -begin - inherited; - if NewSize < sizeof(TMPHUndoRec) then - FCount := 0; -end; - -procedure TMPHUndoStorage.Reset(AResetRedo: boolean = True); -begin - Size := 0; - FCount := 0; - FUpdateCount := 0; - FDescription := ''; - if AResetRedo then - ResetRedo; -end; - -procedure TMPHUndoStorage.SetCount(const Value: integer); -begin - FCount := Value; - if FCount < 1 then - Reset(False); -end; - -function TMPHUndoStorage.CanRedo: boolean; -begin - Result := Assigned(FRedoPointer); -end; - -function TMPHUndoStorage.Redo: boolean; - - procedure SetEditorStateFromRedoRec(const _2Bytes: Boolean = False); - begin - with FRedoPointer^ do - begin - Move(PChar(FRedoPointer)[FRedoPointer^.DataLen], FEditor.FBookmarks, - sizeof(TMPHBookmarks)); - - with FEditor.GetCursorAtPos(CurPos, ufFlagInCharField in Flags) do - begin - if not (ufFlagInCharField in Flags) then - if FEditor.DataSize > 0 then - if ufFlag2ndByteCol in Flags then - x := x + 1; - - FEditor.MoveColRow(x, y, True, True); - end; - FEditor.FModified := ufFlagModified in Flags; - FEditor.InsertMode := (ufFlagInsertMode in Flags); - - with PUndoSelRec(@(PChar(FRedoPointer)[FRedoPointer^.DataLen + - sizeof(TMPHBookmarks)]))^ do - FEditor.SetSelection(SelPos, SelStart, SelEnd); - - FEditor.Translation := CurTranslation; - FEditor.FTranslation := CurTranslation; - FEditor.UnicodeChars := (ufFlagIsUnicode in Flags); - FEditor.UnicodeBigEndian := (ufFlagIsUnicodeBigEndian in Flags); - FEditor.BytesPerUnit := CurBPU; - - FEditor.InCharField := ufFlagInCharField in Flags; - - FEditor.SetChanged(Pos, ufFlagByte1Changed in Flags); - if _2Bytes then - FEditor.SetChanged(Pos + 1, ufFlagByte2Changed in Flags); - - // restore last undo record - if Assigned(FLastUndo) then - begin - Seek(0, soFromEnd); - Write(FLastUndo^, FLastUndoSize); - Inc(FCount); - FreeMem(FLastUndo); - FLastUndo := nil; - FLastUndoSize := 0; - end; - FDescription := FLastUndoDesc; - - FEditor.Invalidate; - FEditor.BookmarkChanged; - end; - end; -begin - Result := CanRedo; - if Result then - begin - case GetUndoKind(FRedoPointer^.Flags) of - ufKindBytesChanged: - begin - FEditor.WriteBuffer(FRedoPointer^.Buffer, - FRedoPointer^.Pos, FRedoPointer^.Count); - SetEditorStateFromRedoRec(FRedoPointer^.Count = 2); - end; - ufKindByteRemoved: - begin - FEditor.InternalDelete(FRedoPointer^.Pos, - FRedoPointer^.Pos + FRedoPointer^.Count, -1, 0); - SetEditorStateFromRedoRec; - end; - ufKindInsertBuffer: - begin - FEditor.InternalInsertBuffer(PChar(@(FRedoPointer^.Buffer)), - FRedoPointer^.Count, FRedoPointer^.Pos); - SetEditorStateFromRedoRec; - end; - ufKindSelection: - begin - SetEditorStateFromRedoRec; - end; - ufKindAllData: - begin - FEditor.FDataStorage.Size := FRedoPointer^.Count; - FEditor.FDataStorage.WriteBufferAt(FRedoPointer^.Buffer, 0, - FRedoPointer^.Count); - FEditor.CalcSizes; - SetEditorStateFromRedoRec; - end; - ufKindReplace: - begin - FEditor.InternalDelete(FRedoPointer^.Pos, - FRedoPointer^.Pos + FRedoPointer^.ReplCount, -1, 0); - FEditor.InternalInsertBuffer(PChar(@(FRedoPointer^.Buffer)), - FRedoPointer^.Count, FRedoPointer^.Pos); - SetEditorStateFromRedoRec; - end; - ufKindConvert: - begin - FEditor.InternalDelete(FRedoPointer^.Pos, - FRedoPointer^.Pos + FRedoPointer^.Count, -1, 0); - FEditor.InternalInsertBuffer(PChar(@(FRedoPointer^.Buffer)), - FRedoPointer^.Count, FRedoPointer^.Pos); - SetEditorStateFromRedoRec; - end; - ufKindAppendBuffer: - begin - FEditor.InternalAppendBuffer(PChar(@(FRedoPointer^.Buffer)), - FRedoPointer^.Count); - SetEditorStateFromRedoRec; - end; - ufKindNibbleInsert, - ufKindNibbleDelete: - begin - FEditor.FDataStorage.Size := FRedoPointer^.Count; - FEditor.FDataStorage.WriteBufferAt(FRedoPointer^.Buffer, 0, - FRedoPointer^.Count); - FEditor.CalcSizes; - SetEditorStateFromRedoRec; - end; - end; - ResetRedo; - FEditor.Changed; - end; -end; - -procedure TMPHUndoStorage.ResetRedo; -begin - if Assigned(FRedoPointer) then - FreeMem(FRedoPointer); - FRedoPointer := nil; - if Assigned(FLastUndo) then - FreeMem(FLastUndo); - FLastUndo := nil; - FLastUndoSize := 0; - FLastUndoDesc := ''; -end; - -procedure TMPHUndoStorage.CreateRedo(const Rec: TMPHUndoRec); -var - LIntDataSize: integer; - - procedure AllocRedoPointer; - begin - GetMem(FRedoPointer, sizeof(TMPHUndoRec) + sizeof(TMPHBookMarks) + - sizeof(TUndoSelRec) + LIntDataSize); - FRedoPointer^.Flags := [GetUndoKind(Rec.Flags)]; - FRedoPointer^.DataLen := sizeof(TMPHUndoRec) + LIntDataSize; - end; - - procedure FinishRedoPointer; - begin - with FRedoPointer^ do - begin - CurPos := FEditor.GetPosAtCursor(FEditor.Col, FEditor.Row); - if not FEditor.FPosInCharField then - with FEditor.GetCursorAtPos(CurPos, FEditor.FPosInCharField) do - if (FEditor.Col - x) <> 0 then - Include(Flags, ufFlag2ndByteCol); - if FEditor.FPosInCharField then - Include(Flags, ufFlagInCharField); - if FEditor.FInsertModeOn then - Include(Flags, ufFlagInsertMode); - Pos := Rec.pos; - Count := Rec.Count; - ReplCount := Rec.ReplCount; - CurTranslation := FEditor.FTranslation; - if FEditor.UnicodeChars then - Include(Flags, ufFlagIsUnicode); - if FEditor.UnicodeBigEndian then - Include(Flags, ufFlagIsUnicodeBigEndian); - CurBPU := FEditor.BytesPerUnit; - if FEditor.FModified then - Include(Flags, ufFlagModified); - end; - Move(FEditor.FBookmarks, PChar(FRedoPointer)[FRedoPointer^.DataLen], - sizeof(TMPHBookmarks)); - with PUndoSelRec(@(PChar(FRedoPointer)[FRedoPointer^.DataLen + - sizeof(TMPHBookmarks)]))^ do - begin - SelStart := FEditor.FSelStart; - SelPos := FEditor.FSelPosition; - SelEnd := FEditor.FSelEnd; - end; - end; -begin - ResetRedo; - // simple redo, store bookmarks, selection, insertmode, col, row, charfield... - // and bytes to save - - case GetUndoKind(Rec.Flags) of - ufKindBytesChanged: - begin - LIntDataSize := Rec.Count - 1; - AllocRedoPointer; - if FEditor.HasChanged(Rec.Pos) then - Include(FRedoPointer^.Flags, ufFlagByte1Changed); - if Rec.Count = 2 then - if FEditor.HasChanged(Rec.Pos + 1) then - Include(FRedoPointer^.Flags, ufFlagByte2Changed); - FEditor.ReadBuffer(FRedoPointer^.Buffer, Rec.Pos, Rec.Count); - FinishRedoPointer; - end; - ufKindByteRemoved: - begin - LIntDataSize := 0; - AllocRedoPointer; - FinishRedoPointer; - end; - ufKindInsertBuffer, - ufKindReplace, - ufKindConvert: - begin - LIntDataSize := Rec.Count; - AllocRedoPointer; - FEditor.ReadBuffer(FRedoPointer^.Buffer, Rec.Pos, Rec.Count); - FinishRedoPointer; - end; - ufKindSelection: - begin - LIntDataSize := 0; - AllocRedoPointer; - FinishRedoPointer; - end; - ufKindAllData: - begin - LIntDataSize := FEditor.DataSize; - AllocRedoPointer; - FEditor.ReadBuffer(FRedoPointer^.Buffer, 0, FEditor.DataSize); - FinishRedoPointer; - FRedoPointer^.Count := FEditor.DataSize; - end; - ufKindAppendBuffer: - begin - LIntDataSize := FEditor.DataSize - integer(Rec.Pos); - AllocRedoPointer; - FEditor.ReadBuffer(FRedoPointer^.Buffer, Rec.Pos, FEditor.DataSize - - integer(Rec.Pos)); - FinishRedoPointer; - end; - ufKindNibbleInsert, - ufKindNibbleDelete: - begin - LIntDataSize := FEditor.DataSize; - AllocRedoPointer; - FEditor.ReadBuffer(FRedoPointer^.Buffer, 0, FEditor.DataSize); - FinishRedoPointer; - FRedoPointer^.Count := LIntDataSize; - end; - end; - //FEditor.Changed; -end; - -function TMPHUndoStorage.GetUndoKind(const Flags: TMPHUndoFlags): TMPHUndoFlag; -begin - for Result := ufKindBytesChanged to ufKindAllData do - if Result in Flags then - Break; -end; - -procedure TMPHUndoStorage.AddSelection(const APos, ACount: integer); -var - P: PMPHUndoRec; - PSel: PUndoSelRec; - LIntRecOffset: integer; -begin - if CanUndo then - begin - Position := Size - 4; - Read(LIntRecOffset, 4); - Seek(-LIntRecOffset, soFromCurrent); - P := Pointer(Integer(Memory) + Position); - if not (ufFlagHasSelection in P^.Flags) then - begin - Size := Size + SizeOf(TUndoSelRec); - P := Pointer(Integer(Memory) + Position); - Include(P^.Flags, ufFlagHasSelection); - Inc(P^.DataLen, sizeof(TUndoSelRec)); - Inc(LIntRecOffset, sizeof(TUndoSelRec)); - Seek(-4, soFromEnd); - WriteBuffer(LIntRecOffset, 4); - end; - P^.CurPos := APos; - PSel := Pointer(Integer(Memory) + size - 4 - sizeof(TUndoSelRec)); - PSel^.SelStart := APos; - if aCount = 0 then - PSel^.SelEnd := -1 - else - PSel^.SelEnd := APos + Acount - 1; - PSel^.SelPos := PSel^.SelStart; - end; -end; - -function TMPHUndoStorage.ReadUndoRecord( - var aUR: TMPHUndoRec; var SDescription: string): TMPHUndoFlag; -var - LIntRecOffs: integer; - LIntPos: integer; -begin - Position := Size - 4; - Read(LIntRecOffs, 4); - Seek(-LIntRecOffs, soFromCurrent); - Read(aUR, SizeOf(TMPHUndoRec)); - Result := GetUndoKind(aUr.Flags); - if ufFlagHasDescription in aUr.Flags then - begin - LIntPos := Position; - try - Position := size - 4 - sizeof(integer); - if ufFlagHasSelection in aUr.Flags then - Seek(-sizeof(TUndoSelRec), soFromCurrent); - Read(LIntRecOffs, sizeof(integer)); - Seek(-(LIntRecOffs + sizeof(integer)), soFromCurrent); - SetLength(SDescription, LIntRecOffs); - Read(SDescription[1], LIntRecOffs); - finally - Position := LIntPos; - end; - end - else - SDescription := ''; -end; - -function TMPHUndoStorage.GetLastUndoKind: TMPHUndoFlag; -var - recUndo: TMPHUndoRec; - s: string; -begin - Result := ReadUndoRecord(recUndo, s); -end; - -// initialize tkCustom translation tables - -procedure InitializeCustomTables; -var - LBytLoop: byte; -begin - for LBytLoop := 0 to 255 do - begin - MPHCustomCharConv[cctFromAnsi][LBytLoop] := char(LBytLoop); - MPHCustomCharConv[cctToAnsi][LBytLoop] := char(LBytLoop); - end; -end; - -{ TMPHMemoryStream } - -const - MAX_PER_BLOCK = $F000; - -procedure TMPHMemoryStream.CheckBounds(const AMax: Integer); -begin - if (AMax) > Size then - raise EMPHexEditor.Create(ERR_DATA_BOUNDS); -end; - -function TMPHMemoryStream.GetAsHex(const APosition, ACount: integer; - const SwapNibbles: Boolean): string; -begin - CheckBounds(APosition + ACount); - SetLength(Result, ACount * 2); - if ACount > 0 then - ConvertBinToHex(PointerAt(APosition), @Result[1], ACount, SwapNibbles); -end; - -procedure TMPHMemoryStream.Move(const AFromPos, AToPos, ACount: Integer); -begin - MoveMemory(PointerAt(AToPos), PointerAt(AFromPos), ACount); -end; - -function TMPHMemoryStream.PointerAt(const APosition: Integer): Pointer; -begin - Result := Pointer(LongInt(Memory) + APosition); -end; - -procedure TMPHMemoryStream.ReadBufferAt(var Buffer; const APosition, - ACount: Integer); -var - LIntPos: Integer; -begin - CheckBounds(APosition + ACount); - LIntPos := Position; - try - Position := APosition; - ReadBuffer(Buffer, ACount); - finally - Position := LIntPos; - end; -end; - -procedure TMPHMemoryStream.TranslateFromAnsi(const ToTranslation: - TMPHTranslationKind; const APosition, ACount: integer); -begin - if ToTranslation = tkAsIs then - Exit; // no translation needed - CheckBounds(APosition + ACount); - if ACount > 0 then - TranslateBufferFromAnsi(ToTranslation, PointerAt(APosition), - PointerAt(APosition), ACount); -end; - -procedure TMPHMemoryStream.TranslateToAnsi(const FromTranslation: - TMPHTranslationKind; const APosition, ACount: integer); -begin - if FromTranslation = tkAsIs then - Exit; // no translation needed - CheckBounds(APosition + ACount); - if ACount > 0 then - TranslateBufferToAnsi(FromTranslation, PointerAt(APosition), - PointerAt(APosition), ACount); -end; - -procedure TMPHMemoryStream.WriteBufferAt(const Buffer; const APosition, - ACount: Integer); -var - LIntPos: Integer; -begin - CheckBounds(APosition + ACount); - LIntPos := Position; - try - Position := APosition; - WriteBuffer(Buffer, ACount); - finally - Position := LIntPos; - end; -end; - -initialization - - // initialize custom tables - - InitializeCustomTables; - -end. - diff --git a/hexcontrol/mphexeditorex.pas b/hexcontrol/mphexeditorex.pas deleted file mode 100644 index 06e40e3..0000000 --- a/hexcontrol/mphexeditorex.pas +++ /dev/null @@ -1,3928 +0,0 @@ -(* - - TMPHexEditorEx v 12-29-2004
- - @author((C) markus stephany, merkes@mirkes.de, all rights reserved.) - @abstract(TMPHexEditorEx, an enhanced TMPHexEditor: print and preview, ole drag and drop, - ole clipboard handling, file backups...) - @lastmod(12-29-2004) - - credits to :

- - John Hamm, http://users.snapjax.com/john/

- - - Christophe Le Corfec for introducing the EBCDIC format and the nice idea about - half byte insert/delete

- - - Philippe Chessa for his suggestions about AsText, AsHex and better support for - the french keyboard layout

- - - Daniel Jensen for octal offset display and the INS-key recognition stuff

- - - Shmuel Zeigerman for introducing more flexible offset display formats

- - - Vaf, http://carradio.al.ru for reporting missing delver.inc and suggesting OnChange

- - - Eugene Tarasov for reporting that setting the BytesPerColumn value to 4 at design - time didn't work

- - - FuseBurner for BytesPerUnit/RulerBytesPerUnit related suggestions

- - - Motzi for SyncView/ShowPositionIfNotFocused related suggestions

- - - Martin Hsiao for bcb compatibility and reporting some bugs when moving cursor beyond eof

- - - Miyu for delphi 7 defines

- - - Nils Hoyer for bcb testing and his help on creating a BCB6 package

- - - Skamnitsly S.V for reporting a bug when doubleclicking the ruler bar

- - - Pete Fraser for reporting problems with array properties under BCB

- - - Andrew Novikov for bug reports and suggestions

- - - Al for bug reports

- - - Dieter Köhler for reporting the delphi vcl related CanFocus bug

- - - Piotr Likus for reporting a cardinal<->integer related bug in the Undo method

- - - Marc Girod for bug reports

- -

history:

-

    -
  • v 12-29-2004: december 29, 2004

    - - initialized Result to '' in some string functions/methods to avoid - non empty Result vars at function startup due to compiler - optimizations (particularly on d4), e.g. printing did not work - correctly under d4
    - - updated some of the sample projects (fixed the broken bcb6 sample, - added printing to the hex viewer and the bcb6 editor sample)

    • - -
  • v 12-28-2004: december 28, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 12-21-2004: december 21, 2004

    - - changes in the base class (@link(TCustomMPHexEditor))
    - - support for CF_HTML clipboard format

    • - -
  • v 11-12-2004: november 12, 2004

    - - changes in the base class (@link(TCustomMPHexEditor))
    - - ole drag and drop move operation is now disabled if the editor's - ReadOnlyView property is set to True

    • - -
  • v 10-26-2004: october 26, 2004

    - - changes in the base class (@link(TCustomMPHexEditor))/unit (@link(mphexeditor)) only

    • - -
  • v 08-29-2004: august 29, 2004

    - - changes in the base class (@link(TCustomMPHexEditor))
    - - added pfIncludeRuler to @link(TMPHPrintFlag)

    • - -
  • v 08-14-2004: august 14, 2004

    - - changed printing (color handling, pfSelectionBold meaning)

    • - -
  • v 06-15-2004: june 15, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) and some more inherited - published properties

    • - -
  • v 06-10-2004: june 10, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 06-07-2004: june 07, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 05-27-2004: may 27, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 05-13-2004: may 13, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 04-18-2004: april 18, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 01-08-2004: january 08, 2004

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 12-16-2003: december 16, 2003

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 12-10-2003: december 10, 2003

    - - changes in the base class (@link(TCustomMPHexEditor)) only

    • - -
  • v 09-24-2003: september 24, 2003

    - - modified the BCB6 package

    • - -
  • v 09-09-2003: september 09, 2003

    - - changed @link(UndoBeginUpdate) and @link(UndoEndUpdate) behaviour to automatically create an undo record - on UndoBeginUpdate and check it on UndoEndUpdate, see also @link(CreateUndoOnUndoUpdate)
    - - added property @link(CreateUndoOnUndoUpdate)
    - - added defines for delphi7, renamed delver.inc to mpdelver.inc
    - - @link(PasteData) method added

    • - -
  • v 07-05-2003: july 05, 2003

    - - added support for pasting clipboard data in fixed filesize mode
    - - added RegEdit_HexData clipboard support

    • - -
  • v 05-25-2003-b: may 25, 2003

    - - fixed a bug (moving the cursor beyond eof)

    • - -
  • v 05-25-2003: may 25, 2003

    - - no ':' is printed when offset display is not used
    - - added hpp generating statements for bcb compatibility

    • - -
  • v 05-20-2003: may 20, 2003

    - - added unicode support in printing

    • - -
  • v 05-17-2003: may 17, 2003

    - - moved some property related functions to protected
    - - corrected bottom margin handling when printing
    - - corrected upper/lowercase hex chars in printing
    - - the current unit is selected now when doubleclicking data
    - - added flags pfCurrentViewOnly (just print the currently - visible data) to @link(PrintOptions).Flags

    • - -
  • v 08-18-2002: august 18, 2002

    - - first release
    • -

- -*) - -{$IFDEF BCB} -{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDropTarget)'} -{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDropSource)'} -{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IEnumFORMATETC)'} -{$ENDIF} - -unit MPHexEditorEx; - -{$IFNDEF PASDOC} -{$I MPDELVER.INC} -{$ENDIF} - -interface - -uses - Windows, Messages, SysUtils, Classes, Controls, Forms, - MPHexEditor, ActiveX, Graphics, Printers, - ShlObj, Menus; - -type - //@exclude - // is data dropped or pasted - TMPHOLEOperation = (oleDrop, oleClipboard); - - // @exclude(available clipboard / IDataObject formats) - TClipFormats = array of TClipFormat; - - // @exclude(ole drop handler class) - TMPHDropTarget = class; - - // @exclude(persistent print options) - TMPHPrintOptions = class; - - (* print option flags:

- - pfSelectionOnly: only print data currently selected
- - pfSelectionBold: render the current selection using either a bold font or inverted colors (if pfSelectionOnly isn't set)
- - pfMonochrome: don't use colors, print/preview black on white
- - pfUseBackgroundColor: fill the margin rect with the editor's background color (if pfMonochrome isn't set)
- - pfCurrentViewOnly: just print the data currently displayed
- - pfIncludeRuler: draw the ruler at every page's top
- *) - TMPHPrintFlag = (pfSelectionOnly, pfSelectionBold, pfMonochrome, - pfUseBackgroundColor, pfCurrentViewOnly, pfIncludeRuler); - // @exclude() - TMPHPrintFlags = set of TMPHPrintFlag; - - // @exclude(print header/footer) - TMPHPrintHeaders = array[0..1] of string; - - (* this event is called when @link(PropertiesAsString) is read or written. TMPHexEditorEx - has a fixed list of properties that can be read/written using PropertiesAsString. - you can exclude some of the properties by setting IsPublic to False. - *) - TMPHQueryPublicPropertyEvent = procedure(Sender: TObject; const PropertyName: - string; - var IsPublic: boolean) of object; - - // enhanced hex editor - TMPHexEditorEx = class(TCustomMPHexEditor) - private - { Private-Deklarationen } - FCreateBackups: boolean; - FBackupFileExt: string; - FOleDragDrop: boolean; - FDropTarget: TMPHDropTarget; - FOleFormat: array[TMPHOLEOperation] of TClipFormat; - FOleDragging, FOleStartDrag: boolean; - FOleDragX, FOleDragY: integer; - FOleWasTarget: boolean; - FPrintOptions: TMPHPrintOptions; - FPrintPages: integer; - FPrintFont: TFont; - FUseEditorFontForPrinting: boolean; - FClipboardAsHexText: boolean; - FClipData: IDataObject; - FFlushClipboardAtShutDown: boolean; - FSupportsOtherClipFormats: boolean; - FOffsetPopupMenu: TPopupMenu; - FZoomOnWheel: boolean; - FPaintUpdateCounter: integer; - FOnQueryPublicProperty: TMPHQueryPublicPropertyEvent; - FHasDoubleClicked: boolean; - FBookmarksNoChange: boolean; - FCreateUndoOnUndoUpdate: boolean; - FModifiedNoUndo: boolean; - procedure SetOleDragDrop(const Value: boolean); - function OLEHasSupportedFormat(const dataObj: IDataObject; - const Formats: array of TClipFormat; var Format: TClipFormat): boolean; - function GetMyOLEFormats: TClipFormats; - procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; - procedure SetPrintOptions(const Value: TMPHPrintOptions); - function PrintToCanvas(ACanvas: TCanvas; const APage: integer; - const AMargins: TRect): integer; - function PrinterMarginRect: TRect; - procedure SetPrintFont(const Value: TFont); - procedure SetOffsetPopupMenu(const Value: TPopupMenu); - function GetOffsetPopupMenu: TPopupMenu; - function GetBookmarksAsString: string; - procedure SetBookMarksAsString(Value: string); - protected - { Protected-Deklarationen } - function CanCreateUndo(const aKind: TMPHUndoFlag; const aCount, aReplCount: - integer): Boolean; override; -{$IFDEF DELPHI6UP} - // @exclude() - function GetPropertiesAsString: string; virtual; - // @exclude() - procedure SetPropertiesAsString(const Value: string); virtual; - // @exclude() - function IsPropPublic(const PropName: string): boolean; virtual; -{$ENDIF} - // @exclude(check if in offset col, if yes, popup offsetcontextmenu) - procedure Notification(AComponent: TComponent; Operation: TOperation); - override; -{$IFDEF DELPHI6UP} - // @exclude() - procedure DoContextPopup(MousePos: TPoint; var Handled: boolean); override; -{$ENDIF} - // @exclude(parse control keys) - procedure KeyDown(var Key: word; Shift: TShiftState); override; - // @exclude(overwrite mouse wheel for zooming) - function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): boolean; - override; - // @exclude(overwrite mouse wheel for zooming) - function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): boolean; - override; - // @exclude(create backups in savefile) - procedure PrepareOverwriteDiskFile; override; - // @exclude(overwrite mouse handling for ole drag and drop) - procedure MouseMove(Shift: TShiftState; X, Y: integer); override; - // @exclude(overwrite mouse handling for ole drag and drop) - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); - override; - // @exclude(overwrite mouse handling for ole drag and drop) - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: - integer); - override; - // @exclude(reset drop target's HWND) - procedure CreateWnd; override; - // @exclude(supported dnd/clipboard data available?) - function SupportsOLEData(const dataObj: IDataObject; const grfKeyState: - longint; const pt: TPoint; var dwEffect: longint; const Operation: - TMPHOLEOperation): HRESULT; - // @exclude(insert ole-dropped data) - function InsertOLEData(const dataObj: IDataObject; const grfKeyState: - longint; const pt: TPoint; var dwEffect: longint; const Operation: - TMPHOLEOperation): HRESULT; - // @exclude(modify drageffect depending on key states and data format) - function ModifyOLEDropEffect(const grfKeyState: longint; const pt: TPoint; - var dwEffect: longint): HRESULT; - // @exclude(paint handler) - procedure Paint; override; - // @exclude(doubleclick handler for unit selection) - procedure DblClick; override; - // @exclude(override to avoid much updates when using setbookmarksasstring); - procedure BookmarkChanged; override; - public - { Public-Deklarationen } - // @exclude(Init) - constructor Create(AOwner: TComponent); override; - // @exclude(Done) - destructor Destroy; override; - // see inherited @inherited - procedure WriteBuffer(const Buffer; const Index, Count: Integer); override; - (* if set to True (default is False), an undo record is automatically created on calling - @link(UndoBeginUpdate) and on calling @link(UndoEndUpdate) the record is deleted if the - data has not been changed between UndoBegin- and UndoEndUpdate *) - property CreateUndoOnUndoUpdate: boolean read FCreateUndoOnUndoUpdate write - FCreateUndoOnUndoUpdate; - (* each call to BeginUpdate increments an internal counter that prevents from repainting - (see also @link(EndUpdate)) - *) - function BeginUpdate: integer; - (* each call to EndUpdate decrements an internal counter that prevents from repainting. - the return value is the value of this counter. if the counter is reset to zero, - repainting is permitted again (see also @link(BeginUpdate)) - *) - function EndUpdate: integer; - (* each call to UndoBeginUpdate increments an internal counter that prevents using - undo storage and also disables undo functionality (see also @link(UndoEndUpdate)) - *) - function UndoBeginUpdate(const StrUndoDesc: string = ''): integer; - reintroduce; - (* each call to UndoEndUpdate decrements an internal counter that prevents using - undo storage and also disables undo functionality. the return value is the value - of this counter. if the counter is reset to zero, undo creation is permitted again - (see also @link(UndoBeginUpdate)) - *) - function UndoEndUpdate: integer; override; - // create an undo for a range of bytes - procedure CreateRangeUndo(const aStart, aCount: integer; sDesc: string); - // is pasting from clipboard possible? - function CanPaste: boolean; - // is copying to clipboard possible? - function CanCopy: boolean; - // is cutting to clipboard possible? - function CanCut: boolean; - // copy selection to clipboard - function CBCopy: boolean; - // cut selection to clipboard - function CBCut: boolean; - // paste clipboard's contents over current selection - function CBPaste: boolean; - // do we own the clipboard data? - function OwnsClipBoard: boolean; - // flush or empty the clipboard (if we own the IDataObject) - procedure ReleaseClipboard(const Flush: boolean); - // save to file (overwrite) - procedure Save; - // @exclude(dump undo storage) - function DumpUndoStorage(const FileName: string): boolean; - (* creates a TMetaFile object and renders the specified page - on its canvas. Freeing of the TMetaFile is up to the caller! - *) - function PrintPreview(const Page: integer): TMetaFile; - (* print the given page to the default printer. - Printer.BeginDoc, Printer.NewPage and Printer.EndDoc must be issued by the caller! - *) - procedure Print(const Page: integer); - // get the number of pages to print - function PrintNumPages: integer; - // paste data (in clipboardmanner: check current selection and so on) - procedure PasteData(P: Pointer; const ACount: integer; const UndoDesc: string - = ''); - // get/set bookmarks as text (for storing in registry, ini-file) - property BookMarksAsString: string read GetBookmarksAsString write - SetBookMarksAsString; -{$IFDEF DELPHI6UP} - // get set properties as text (for storing in registry, ini-file); - property PropertiesAsString: string read GetPropertiesAsString write - SetPropertiesAsString; -{$ENDIF} - published - { Published-Deklarationen } - // create a backup on save ? (see also @link(BackupExtension)) - property CreateBackup: boolean read FCreateBackups write FCreateBackups - default True; - // add this extension to the file if making backups, see @link(CreateBackup) - property BackupExtension: string read FBackupFileExt write FBackupFileExt; - (* if set To True, OLE drag and drop will used automatically when dragging starts - or supported OLE data has been dropped on the hex editor - *) - property OleDragDrop: boolean read FOleDragDrop write SetOleDragDrop default - False; - // if set to True, CF_TEXT on the clipboard will be treated as hex formatted text - property ClipboardAsHexText: boolean read FClipboardAsHexText write - FClipboardAsHexText default False; - // flush or empty clipboard at shutdown - property FlushClipboardAtShutDown: boolean read FFlushClipboardAtShutDown - write FFlushClipboardAtShutDown default False; - // do we support other formats than CF_MPHEXEDITOR and CF_HDROP? - property SupportsOtherClipFormats: boolean read FSupportsOtherClipFormats - write FSupportsOtherClipFormats default True; - // print/preview options, see @link(TMPHPrintOptions) - property PrintOptions: TMPHPrintOptions read FPrintOptions write - SetPrintOptions; - // print using this font - property PrintFont: TFont read FPrintFont write SetPrintFont; - // if set to True, the editor's font will be used for printing - property UseEditorFontForPrinting: boolean read FUseEditorFontForPrinting - write FUseEditorFontForPrinting default True; - (* if this property is assigned to a TPopupMenu, it will be shown on right clicking - the offset display pane. then the normal PopupMenu will open on right - clicking the character and hex pane. - *) - property OffsetPopupMenu: TPopupMenu read GetOffsetPopupMenu write - SetOffsetPopupMenu; - // auto-zoom on mouse wheel? - property ZoomOnWheel: boolean read FZoomOnWheel write FZoomOnWheel default - True; - (* this event is called when @link(PropertiesAsString) is read or written. - (see @link(TMPHQueryPublicPropertyEvent)) - *) - property OnQueryPublicProperty: TMPHQueryPublicPropertyEvent read - FOnQueryPublicProperty write FOnQueryPublicProperty; - // @exclude(inherited) - property Align; - // @exclude(inherited) - property Anchors; - // @exclude(inherited) - property BiDiMode; - // @exclude(inherited) - property BorderStyle; - // @exclude(inherited) - property Constraints; - // @exclude(inherited) - property Ctl3D; - // @exclude(inherited) - property DragCursor; - // @exclude(inherited) - property DragKind; - // @exclude(inherited) - property DragMode; - // @exclude(inherited) - property Enabled; - // @exclude(inherited) - property Font; - // @exclude(inherited) - property ImeMode; - // @exclude(inherited) - property ImeName; - // @exclude(inherited) - property OnClick; - // @exclude(inherited) - property OnDblClick; - // @exclude(inherited) - property OnDragDrop; - // @exclude(inherited) - property OnDragOver; - // @exclude(inherited) - property OnEndDock; - // @exclude(inherited) - property OnEndDrag; - // @exclude(inherited) - property OnEnter; - // @exclude(inherited) - property OnExit; - // @exclude(inherited) - property OnKeyDown; - // @exclude(inherited) - property OnKeyPress; - // @exclude(inherited) - property OnKeyUp; - // @exclude(inherited) - property OnMouseDown; - // @exclude(inherited) - property OnMouseMove; - // @exclude(inherited) - property OnMouseUp; - // @exclude(inherited) - property OnMouseWheel; - // @exclude(inherited) - property OnMouseWheelDown; - // @exclude(inherited) - property OnMouseWheelUp; - // @exclude(inherited) - property OnStartDock; - // @exclude(inherited) - property OnStartDrag; - // @exclude(inherited) - property ParentBiDiMode; - // @exclude(inherited) - property ParentCtl3D; - // @exclude(inherited) - property ParentFont; - // @exclude(inherited) - property ParentShowHint; - // @exclude(inherited) - property PopupMenu; - // @exclude(inherited) - property ScrollBars; - // @exclude(inherited) - property ShowHint; - // @exclude(inherited) - property TabOrder; - // @exclude(inherited) - property TabStop; - // @exclude(inherited) - property Visible; - - // see inherited @inherited - property BytesPerRow; - // see inherited @inherited - property BytesPerColumn; - // see inherited @inherited - property Translation; - // see inherited @inherited - property OffsetFormat; - // see inherited @inherited - property CaretKind; - // see inherited @inherited - property Colors; - // see inherited @inherited - property FocusFrame; - // see inherited @inherited - property SwapNibbles; - // see inherited @inherited - property MaskChar; - // see inherited @inherited - property NoSizeChange; - // see inherited @inherited - property AllowInsertMode; - // see inherited @inherited - property DrawGridLines; - // see inherited @inherited - property WantTabs; - // see inherited @inherited - property ReadOnlyView; - // see inherited @inherited - property HideSelection; - // see inherited @inherited - property GraySelectionIfNotFocused; - // see inherited @inherited - property GutterWidth; - // see inherited @inherited - property BookmarkBitmap; - - // see inherited @inherited - property Version; - - // see inherited @inherited - property MaxUndo; - // see inherited @inherited - property InsertMode; - // see inherited @inherited - property HexLowerCase; - // see inherited @inherited - property OnProgress; - // see inherited @inherited - property OnInvalidKey; - // see inherited @inherited - property OnTopLeftChanged; - // see inherited @inherited - property OnChange; - // see inherited @inherited - property DrawGutter3D; - // see inherited @inherited - property ShowRuler; - // see inherited @inherited - property BytesPerUnit; - // see inherited @inherited - property RulerBytesPerUnit; - // see inherited @inherited - property ShowPositionIfNotFocused; - // see inherited @inherited - property OnSelectionChanged; - // see inherited @inherited - property UnicodeChars; - // see inherited @inherited - property UnicodeBigEndian; - - // see inherited @inherited - property OnDrawCell; - - // see inherited @inherited - property OnBookmarkChanged; - // see inherited @inherited - property OnGetOffsetText; - // see inherited @inherited - property BytesPerBlock; - // see inherited @inherited - property SeparateBlocksInCharField; - // see inherited @inherited - property FindProgress; - // see inherited @inherited - property RulerNumberBase; - end; - - // @exclude(ole drop target class) - TMPHDropTarget = class(TInterfacedObject, IDropTarget) - private - FEditor: TMPHexEditorEx; - FEditorHandle: THandle; - FActive: boolean; - procedure SetActive(const Value: boolean); - public - constructor Create(Editor: TMPHexEditorEx); - procedure BeforeDestruction; override; - function DragEnter(const dataObj: IDataObject; grfKeyState: longint; pt: - TPoint; var dwEffect: longint): HResult; stdcall; - function DragOver(grfKeyState: longint; pt: TPoint; var dwEffect: longint): - HResult; stdcall; - function DragLeave: HResult; stdcall; - function Drop(const dataObj: IDataObject; grfKeyState: longint; pt: TPoint; - var dwEffect: longint): HResult; stdcall; - property Active: boolean read FActive write SetActive; - end; - - // print / preview options - TMPHPrintOptions = class(TPersistent) - private - FMargins: TRect; - FHeaders: TMPHPrintHeaders; - FFlags: TMPHPrintFlags; - function GetHeader(const Index: integer): string; - function GetMargin(const Index: integer): integer; - procedure SetHeader(const Index: integer; const Value: string); - procedure SetMargin(const Index, Value: integer); - public - // @exclude(Init) - constructor Create; - // @exclude() - procedure Assign(Source: TPersistent); override; - published - // left margin in Millimeters - property MarginLeft: integer index 1 read GetMargin write SetMargin; - // top margin in Millimeters - property MarginTop: integer index 2 read GetMargin write SetMargin; - // right margin in Millimeters - property MarginRight: integer index 3 read GetMargin write SetMargin; - // bottom margin in Millimeters - property MarginBottom: integer index 4 read GetMargin write SetMargin; - (* this line will be rendered on top of the printed page, some characters have special meanings:

- - the string may contain three parts separated by a "|" (pipe) character (left|center|right)
- - each part knows some special variables: -
    -
  • %f: substituted with the filename part of the editor's filename
    • -
  • %F: substituted with the expanded name of the editor's filename
    • -
  • %p: substituted with the number of the current page
    • -
  • %P: substituted with the number of pages
    • -
  • %t: substituted with the current time
    • -
  • %d: substituted with the current date
    • -
  • %>: substituted with the long description of the editor's current @link(Translation)
    • -
  • %<: substituted with the short description of the editor's current @link(Translation)
    • -
- *) - property PageHeader: string index 0 read GetHeader write SetHeader; - // this line will be rendered on the bottom of the printed page (see @link(PageHeader)) - property PageFooter: string index 1 read GetHeader write SetHeader; - (* printing flags:

- - pfSelectionOnly: only print data currently selected
- - pfSelectionBold: render the current selection using either a bold font or inverted colors (if pfSelectionOnly isn't set)
- - pfMonochrome: don't use colors, print/preview black on white
- - pfUseBackgroundColor: fill the margin rect with the editor's background color (if pfMonochrome isn't set)
- - pfCurrentViewOnly: just print the data currently displayed - *) - property Flags: TMPHPrintFlags read FFlags write FFlags; - end; - - // default print margins -const - MPH_DEF_PRINT_MARGINS: TRect = (Left: 20; Top: 15; Right: 25; Bottom: 25); - -implementation - -uses - Consts, StdCtrls, ShellAPI, ComObj, TypInfo; - -resourcestring - - // error messages - ERR_NOFILE = 'No Filename specified'; - ERR_INVALID_PAGE = 'Invalid Page Index'; - ERR_PRINTING_FAILED = 'Printing Failed'; - ERR_BACKUP_DELETE = 'Cannot delete previous backup %s. (%s)'; - ERR_BACKUP_CREATE = 'Cannot create backup %s. (%s)'; - ERR_INVALID_BOOKFMT = 'Invalid Bookmark Format'; - - // additional undo descriptions - UNDO_PASTECB = 'Paste from Clipboard'; - UNDO_CUTCB = 'Cut to Clipboard'; - UNDO_DROPPED = 'Data Dropped'; - UNDO_MOVED = 'Data Moved'; - - // select clipb/ole format dialog strings - SELECT_FORMAT_CAPTION = 'Select Data Format'; - SELECT_FORMAT_ASHEX = 'Hex Text'; - - // when data dropped to explorer, give it this filename; first %s filename w/o ext, (second %s original file ext) - STR_SCRAPFILE = 'Dump of %s.bin'; - - // native clipboard format name - MPTH_CF = 'TMPHexeditorEx Clipboard Format'; - - // predefined clipboard format names - STR_CF_TEXT = 'Text'; - STR_CF_BITMAP = 'Bitmap Picture'; - STR_CF_METAFILEPICT = 'Metafile Picture'; - STR_CF_SYLK = 'Microsoft Symbolic Link (SYLK) data'; - STR_CF_DIF = 'Software Arts'' Data Interchange Format'; - STR_CF_TIFF = 'Tagged Image File Format (TIFF) Picture'; - STR_CF_OEMTEXT = 'OEM Text'; - STR_CF_DIB = 'Device Independent Bitmap Picture'; - STR_CF_PALETTE = 'Color Palete'; - STR_CF_PENDATA = 'Pen Data'; - STR_CF_RIFF = 'RIFF Audio Data'; - STR_CF_WAVE = 'Wave Audio'; - STR_CF_UNICODETEXT = 'Unicode Text'; - STR_CF_ENHMETAFILE = 'Enhanced Metafile Picture'; - STR_CF_HDROP = 'File List'; - STR_CF_LOCALE = 'Text Locale'; - -type - // my clipboard data struct - PClipData = ^TClipData; - TClipData = packed record - Signature: DWORD; - Version: DWORD; - Size: integer; - Data: array[0..0] of char; - end; - - PRegEditHexData = ^TRegEditHexData; - TRegEditHexData = packed record - Size: integer; - Data: array[0..0] of char; - end; - -const - // signature of own format clipboard data - CLIP_SIG = $4854504D; // MPTH; - // version of own format clipboard data - CLIP_VER = $00010001; - - // initial file extension of backups - BACKUP_EXT = '.bak'; - - // not so predefined common/known clipboard format names - CFSTR_RTF = 'Rich Text Format'; - CFSTR_LOGICALPERFORMEDDROPEFFECT = 'Logical Performed DropEffect'; - CFSTR_REGEDIT_HEXDATA = 'RegEdit_HexData'; - CFSTR_HTML = 'HTML Format'; - -var - // custom/ shell CF format - CF_MPHEXEDITOR, - CF_RTF, - CF_FILECONTENTS, - CF_PERFORMEDDROPEFFECT, - CF_LOGICALPERFORMEDDROPEFFECT, - CF_FILEDESCRIPTOR, - CF_HTML, - CF_REGEDIT_HEXDATA: TClipFormat; - -type - // private idataobject format enumerator - TFormatEnum = class - private - FFormats: array of TFormatETC; - public - constructor Create(const dataObject: IDataObject); - destructor Destroy; override; - function HasFormat(const cfFormat: TClipFormat): boolean; - function GetFormatETC(const cfFormat: TClipFormat): TFormatETC; - end; - -const - // number of clip formats that we can provide - MY_SUPPORTED_FORMATS = 4; - -type - // ole "public" format enumerator for own data - TMPHEnumFormatETC = class(TInterfacedObject, IEnumFormatETC) - private - FFormats: packed array[0..MY_SUPPORTED_FORMATS - 1] of TFormatETC; - FIndex: integer; - public - constructor Create; - function Next(celt: longint; out elt; pceltFetched: PLongint): HResult; - stdcall; - function Skip(celt: longint): HResult; stdcall; - function Reset: HResult; stdcall; - function Clone(out Enum: IEnumFormatEtc): HResult; stdcall; - end; - - // ole drop source - TMPHDropSource = class(TInterfacedObject, IDropSource) - public - function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: longint): - HResult; stdcall; - function GiveFeedback(dwEffect: longint): HResult; stdcall; - end; - - // ole data container - TMPHDataObject = class(TInterfacedObject, IDataObject) - private - FData: Pointer; - FDataSize: integer; - FFileName: ShortString; - FHasDropEffect: boolean; - FDropEffect: cardinal; - FTextAsHex: boolean; - FSwapNibbles: boolean; - public - constructor Create(Data: Pointer; DataSize: integer; ScrapFileName: - ShortString; TextAsHex, SwapNibbles: boolean); - constructor CreateFromStream(Stream: TStream; Position, DataSize: integer; - ScrapFileName: ShortString; TextAsHex, SwapNibbles: boolean); - procedure BeforeDestruction; override; - function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): - HResult; stdcall; - function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): - HResult; stdcall; - function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall; - function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out - formatetcOut: TFormatEtc): HResult; stdcall; - function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; - fRelease: BOOL): HResult; stdcall; - function EnumFormatEtc(dwDirection: longint; out enumFormatEtc: - IEnumFormatEtc): HResult; stdcall; - function DAdvise(const formatetc: TFormatEtc; advf: longint; const advSink: - IAdviseSink; out dwConnection: longint): HResult; stdcall; - function DUnadvise(dwConnection: longint): HResult; stdcall; - function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall; - end; - - // draw hex on canvas - TMPHCanvasPrinter = class(TObject) - private - FMargins: TRect; - FHeaders, - FPrintHeaders: TMPHPrintHeaders; - FLinesPerPage: integer; - FFlags: TMPHPrintFlags; - FPages: integer; - FEditor: TMPHexEditorEx; - FCanvas: TCanvas; - function GetLinesPerPage: integer; - function BuildHeader(const S: string; const Page: integer): string; - protected - function DrawOrCalc(const JustCalc: boolean; const Page: integer): integer; - public - constructor Create(AEditor: TMPHexEditorEx; ACanvas: TCanvas; AFlags: - TMPHPrintFlags; AMargins: TRect; AHeaders: TMPHPrintHeaders); - procedure Draw(const Page: integer); - property LinesPerPage: integer read GetLinesPerPage; - property Pages: integer read FPages; - end; - -var - // most recent selected clip format - LAST_USED_CF: integer = -1; - - // returns the stgmedium struct for a given idataobject/format specification - -function GetIDataObjectData(const dataObj: IDataObject; const Format: - TClipFormat; out Medium: TStgMedium): HRESULT; -var - LobjEnum: TFormatEnum; -begin - LobjEnum := TFormatEnum.Create(dataObj); - try - if not LobjEnum.HasFormat(Format) then - Result := E_FAIL - else - Result := dataObj.GetData(LobjEnum.GetFormatETC(Format), Medium); - finally - LobjEnum.Free; - end; -end; - -// cast/copy hglobal to data structure depending on the format - -function GetSomeData(const PData: Pointer; const HGlobal: THandle; Format: - TClipFormat; const DataSize: integer; const UnicodeBigEndian: Boolean): - string; -var - LWStrTemp: widestring; - LRecBmpHeader: TBitmapFileheader; - LRecPalette: TMaxLogPalette; - LIntTemp: integer; - LbmpTemp: TBitmap; - LmefTemp: TMetaFile; - LmstData: TMemoryStream; - LIntLoop: integer; -begin - Result := ''; - - // to use case..of (cf_rtf is not a constant) - if (Format = CF_RTF) or (Format = CF_HTML) then - Format := CF_TEXT; - - if Format = CF_MPHEXEDITOR then - begin - with PClipData(PData)^ do - if (Signature = CLIP_SIG) and (Version = CLIP_VER) then - SetString(Result, Data, Size) - end - else if Format = CF_REGEDIT_HEXDATA then - begin - with PRegEditHexData(PData)^ do - SetString(Result, Data, Size); - end - else - case Format of - CF_TEXT, - CF_OEMTEXT: Result := PChar(PData); - CF_UNICODETEXT: - begin - LWStrTemp := PWideChar(PData); - if UnicodeBigEndian then - begin - for LIntLoop := 1 to Length(LWstrTemp) do - SwapWideChar(LWstrTemp[LIntLoop]); - end; -{$WARNINGS OFF} - // don't convert, get wide data as is - SetString(Result, PChar(LWStrTemp), Length(LWStrTemp) * - (sizeof(widechar) div sizeof(char))); -{$WARNINGS ON} - end; - CF_LOCALE: - begin - // locale id , word pointed to by the global handle - SetLength(Result, sizeof(word)); - Move(PWord(PData)^, Result[1], sizeof(word)); - end; - CF_DIB: - begin - // stored as bitmap without header, so prefix a bmp header - FillChar(LRecBMPHeader, sizeof(LRecBMPHeader), #0); - LRecBMPHeader.bfType := $4D42; // BM - SetLength(Result, sizeof(LRecBMPHeader) + DataSize); - Move(LRecBMPHeader, Result[1], sizeof(LRecBmpHeader)); - Move(PData^, Result[1 + sizeof(LRecBMPHeader)], DataSize); - end; - CF_PALETTE: - begin - // copy palette entries - LIntTemp := 0; - if (GetObject(HGlobal, sizeof(LIntTemp), @LIntTemp) <> 0) and (LIntTemp - > 0) then - begin - with LRecPalette do - begin - palVersion := $0300; - palNumEntries := LIntTemp; - GetPaletteEntries(HGlobal, 0, LIntTemp, palPalEntry); - end; - SetLength(Result, sizeof(TLogPalette) + ((LintTemp - 1) * - sizeof(TPaletteEntry))); - Move(LRecPalette, Result[1], Length(Result)); - end; - end; - CF_BITMAP: - begin - // data not stored in global mem, but as a bitmap handle - LbmpTemp := TBitmap.Create; - try - LbmpTemp.Handle := CopyImage(HGlobal, IMAGE_BITMAP, 0, 0, - LR_COPYRETURNORG); - LmstData := TMemoryStream.Create; - try - LbmpTemp.SaveToStream(LmstData); - SetString(Result, PChar(LmstData.Memory), LmstData.Size); - finally - LmstData.Free; - end; - finally - LbmpTemp.Free; - end; - end; - CF_METAFILEPICT: - begin - // global mem contains mf struct - LIntTemp := GetMetaFileBitsEx(PMetafilePict(PData)^.hMF, 0, nil); - if LIntTemp > 0 then - begin - SetLength(Result, LIntTemp); - GetMetaFileBitsEx(PMetafilePict(PData)^.hMF, LIntTemp, @Result[1]); - end; - end; - CF_ENHMETAFILE: - begin - // emf handle - LmefTemp := TMetaFile.Create; - try - LmefTemp.Handle := CopyEnhMetafile(HGlobal, nil); - LmstData := TMemoryStream.Create; - try - LmefTemp.SaveToStream(LmstData); - SetString(Result, PChar(LmstData.Memory), LmstData.Size); - finally - LmstData.Free; - end; - finally - LmefTemp.Free; - end; - end; - else - // format not yet known - SetString(Result, PChar(PData), DataSize); - end; -end; - -type - // special dialog for format selection - TFormatSelDialog = class(TForm) - private - LbtnOK: TButton; - LbtnCancel: TButton; - LlbxFormats: TListBox; - LcbxTextAsHex: TCheckBox; - procedure ListDoubleClick(Sender: TObject); - procedure ListSelect(Sender: TObject); - end; - - // select a format out of an array of available formats - -function SelectClipFormat(const Formats: array of TClipFormat; var Format: - TClipFormat; var TextIsHexData: boolean): boolean; -var - LfrmDialog: TFormatSelDialog; - LIntLoop: integer; - LWrdCurrent: TClipFormat; - LStrFormatName: string; - LszBuffer: array[0..511] of char; -begin - Result := False; - - // create and show a dialog for clipboard format selection - LfrmDialog := TFormatSelDialog.CreateNew(Application); - with lfrmDialog do - try - BorderStyle := bsDialog; - Width := Screen.Width div 4; - Height := Screen.Height div 4; -{$IFDEF DELPHI6UP} - Position := poOwnerFormCenter; -{$ELSE} - Position := poScreenCenter; -{$ENDIF} - Caption := SELECT_FORMAT_CAPTION; - - LbtnOK := TButton.Create(LfrmDialog); - LbtnCancel := TButton.Create(LfrmDialog); - LcbxTextAsHex := TCheckBox.Create(LfrmDialog); - LlbxFormats := TListBox.Create(LfrmDialog); - try - with lbtnOK do - begin - Parent := LfrmDialog; - ModalResult := mrOk; - Caption := SOKButton; - Default := True; - Width := (LfrmDialog.Width div 2) - 32; - Top := LfrmDialog.ClientHeight - Height - 8; - Left := 16; - Enabled := False; - end; - - with LbtnCancel do - begin - Parent := LfrmDialog; - ModalResult := mrCancel; - Cancel := True; - Caption := SCancelButton; - Width := (LfrmDialog.Width div 2) - 32; - Top := LfrmDialog.ClientHeight - Height - 8; - Left := LfrmDialog.ClientWidth - Width - 16; - end; - - with LcbxTextAsHex do - begin - Parent := LfrmDialog; - Enabled := False; - Caption := SELECT_FORMAT_ASHEX; - Top := LbtnCancel.Top - Height - 8; - Left := LbtnOK.Left; - Width := LfrmDialog.ClientWidth - Left; - Checked := TextIsHexData; - end; - - with LlbxFormats do - begin - Parent := LfrmDialog; - Align := alTop; - Height := LfrmDialog.ClientHeight - 16 - LbtnCancel.Height - 8 - - LcbxTextAsHex.Height; - OnDblClick := ListDoubleClick; - OnClick := ListSelect; - - for LIntLoop := Low(Formats) to High(Formats) do - begin - LWrdCurrent := Formats[LIntLoop]; - case LWrdCurrent of - CF_TEXT: LStrFormatName := STR_CF_TEXT; - CF_BITMAP: LStrFormatName := STR_CF_BITMAP; - CF_METAFILEPICT: LStrFormatName := STR_CF_METAFILEPICT; - CF_SYLK: LStrFormatName := STR_CF_SYLK; - CF_DIF: LStrFormatName := STR_CF_DIF; - CF_TIFF: LStrFormatName := STR_CF_TIFF; - CF_OEMTEXT: LStrFormatName := STR_CF_OEMTEXT; - CF_DIB: LStrFormatName := STR_CF_DIB; - CF_PALETTE: LStrFormatName := STR_CF_PALETTE; - CF_PENDATA: LStrFormatName := STR_CF_PENDATA; - CF_RIFF: LStrFormatName := STR_CF_RIFF; - CF_WAVE: LStrFormatName := STR_CF_WAVE; - CF_UNICODETEXT: LStrFormatName := STR_CF_UNICODETEXT; - CF_ENHMETAFILE: LStrFormatName := STR_CF_ENHMETAFILE; - CF_HDROP: LStrFormatName := STR_CF_HDROP; - CF_LOCALE: LStrFormatName := STR_CF_LOCALE; - else - SetString(LStrFormatName, LszBuffer, - GetClipboardFormatName(LWrdCurrent, LszBuffer, - sizeof(LszBuffer))); - LStrFormatName := Trim(LStrFormatName); - end; - if LStrFormatName = '' then - LStrFormatName := '(' + IntToRadix(LWrdCurrent, 10) + ')'; - Items.AddObject(LStrFormatName, Pointer(LWrdCurrent)); - LbtnOK.Enabled := True; - ItemIndex := Items.IndexOfObject(Pointer(LAST_USED_CF)); - if ItemIndex = -1 then - ItemIndex := 0; - end; - end; - - // enable hextext checkbox depending on selected format - ListSelect(nil); - - if (ShowModal = mrOk) and (LlbxFormats.ItemIndex > -1) then - begin - Format := TClipFormat(LlbxFormats.Items.Objects[LlbxFormats.ItemIndex]); - if Format in [CF_TEXT, CF_OEMTEXT] then - TextIsHexData := LcbxTextAsHex.Checked; - Result := True; - LAST_USED_CF := Format; - end; - finally - // not sure if they automatically get freed? - LbtnOK.Free; - LbtnCancel.Free; - LcbxTextAsHex.Free; - LlbxFormats.Free; - end; - finally - Free; - end; -end; - -// query a data object's supported formats and check if we can "paste" them - -function QueryOLEFormat(const SupportedFormats: array of TClipFormat; const - dataObj: IDataObject; var Format: TClipFormat; var TextIsHexData: boolean): - boolean; -var - LWrdFormats: array of TClipFormat; - LIntLoop: integer; - LobjEnum: TFormatEnum; -begin - Result := False; - LWrdFormats := nil; - LobjEnum := TFormatEnum.Create(dataObj); - try - // enum all available formats - if Length(SupportedFormats) > 0 then - begin - for LIntLoop := Low(SupportedFormats) to High(SupportedFormats) do - if LObjEnum.HasFormat(SupportedFormats[LIntLoop]) then - begin - SetLength(LWrdFormats, Succ(Length(LWrdFormats))); - LWrdFormats[Pred(Length(LWrdFormats))] := SupportedFormats[LIntLoop]; - end; - case Length(LWrdFormats) of - 0: Exit; - 1: - begin - Format := LWrdFormats[0]; - Result := True; - Exit; - end; - else - // show a dialog for data format selection - Result := SelectClipFormat(LWrdFormats, Format, TextIsHexData); - end; - end; - finally - LObjEnum.Free; - LWrdFormats := nil; - end; -end; - -{ TMPHexEditorEx } - -// constructor - -constructor TMPHexEditorEx.Create(AOwner: TComponent); -begin - inherited; - FModifiedNoUndo := False; - FCreateUndoOnUndoUpdate := False; - FBookmarksNoChange := False; - FHasDoubleClicked := False; - FPaintUpdateCounter := 0; - FClipData := nil; - FZoomOnWheel := True; - FCreateBackups := True; - FBackupFileExt := BACKUP_EXT; - FOleDragDrop := False; - FOleStartDrag := False; - FOleDragging := False; - FClipboardAsHexText := False; - FFlushClipboardAtShutDown := False; - FSupportsOtherClipFormats := True; - FPrintOptions := TMPHPrintOptions.Create; - FPrintFont := TFont.Create; - FPrintFont.Assign(Font); - FUseEditorFontForPrinting := True; - FOffsetPopupMenu := nil; - if not (csDesigning in ComponentState) then - FDropTarget := TMPHDropTarget.Create(self); // not in delphi ide -end; - -// destructor - -destructor TMPHexEditorEx.Destroy; -begin - // empty or flush clipboard - ReleaseClipboard(FFlushClipboardAtShutDown); - FPrintOptions.Free; - FPrintFont.Free; - if not (csDesigning in ComponentState) then - FDropTarget.Free; - inherited; -end; - -// cb copy possible - -function TMPHexEditorEx.CanCopy: boolean; -begin - Result := (DataSize > 0) and (SelCount > 0); -end; - -// cb cut possible - -function TMPHexEditorEx.CanCut: boolean; -begin - Result := CanCopy and not (ReadOnlyView or NoSizeChange); -end; - -// cb paste possible - -function TMPHexEditorEx.CanPaste: boolean; -var - LifData: IDataObject; - LIntEffect: integer; -begin - LIntEffect := DROPEFFECT_COPY; - Result := (not (ReadOnlyView (*or NoSizeChange*))) and - Succeeded(OLEGetClipboard(LifData)) and (SupportsOLEData(LifData, 0, - Point(0, - 0), LintEffect, oleClipboard) = S_OK); - if Result and NoSizeChange then - Result := DataSize > 0; -end; - -// copy to clipboard - -function TMPHexEditorEx.CBCopy: boolean; -begin - Result := CanCopy; - if Result then - begin - WaitCursor; - try - FClipData := TMPHDataObject.CreateFromStream(DataStorage, Min(SelStart, - SelEnd), SelCount, ExtractFileName(FileName), FClipboardAsHexText, - SwapNibbles); - OleCheck(OleSetClipboard(FClipData)); - finally - OldCursor; - end; - end; -end; - -// cut to clipboard - -function TMPHexEditorEx.CBCut: boolean; -begin - Result := CanCut and CBCopy; - if Result then - begin - WaitCursor; - try - DeleteSelection(UNDO_CUTCB); - finally - OldCursor; - end; - end; -end; - -// paste from clipboard - -function TMPHexEditorEx.CBPaste: boolean; -var - LifData: IDataObject; - LIntEffect: integer; -begin - LIntEffect := DROPEFFECT_COPY; - Result := CanPaste and Succeeded(OLEGetClipboard(LifData)) and - Succeeded(InsertOLEData(LifData, 0, Point(0, 0), LIntEffect, oleClipboard)); -end; - -// create an undo for a range of bytes - -procedure TMPHexEditorEx.CreateRangeUndo(const aStart, aCount: integer; - sDesc: string); -var - bMod: boolean; -begin - bMod := FModified; - try - if aCount < 1 then - CreateUndo(ufKindAllData, 0, 0, 0, sDesc) - else - CreateUndo(ufKindReplace, aStart, aCount, aCount, sDesc); - finally - FModified := bMod; - end; -end; - -function TMPHexEditorEx.BeginUpdate: integer; -begin - Inc(FPaintUpdateCounter); - Result := FPaintUpdateCounter; -end; - -function TMPHexEditorEx.EndUpdate: integer; -begin - Dec(FPaintUpdateCounter); - if FPaintUpdateCounter < 0 then - FPaintUpdateCounter := 0; - if FPaintUpdateCounter = 0 then - Invalidate; - Result := FPaintUpdateCounter; -end; - -// mouse wheel overriding for zooming (font size) if CTRL/SHIFT is pressed, -// or bytes per line changing if CTRL pressed - -function TMpHexEditorEx.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): - boolean; -begin - if FZoomOnWheel and (Shift = [ssCtrl]) and (BytesPerRow > 1) then - begin - Result := True; - BytesPerRow := BytesPerRow - 1; - Invalidate; - end - else if FZoomOnWheel and (Shift = [ssShift, ssCtrl]) and (Font.Size > 2) then - begin - Result := True; - Font.Size := Font.Size - 1; - end - else - Result := inherited DoMouseWheelDown(Shift, MousePos); -end; - -function TMpHexEditorEx.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): - boolean; -begin - if FZoomOnWheel and (Shift = [ssCtrl]) and (BytesPerRow < 256) then - begin - Result := True; - BytesPerRow := BytesPerRow + 1; - Invalidate; - end - else if FZoomOnWheel and (Shift = [ssShift, ssCtrl]) then - begin - Result := True; - Font.Size := Font.Size + 1; - end - else - Result := inherited DoMouseWheelUp(Shift, MousePos); -end; - -// overwrite key handling - -procedure TMPHexEditorEx.KeyDown(var Key: word; Shift: TShiftState); -begin - inherited; - case Key of - // CTRL+A: select all - Ord('A'): if Shift = [ssCtrl] then - begin - SelectAll; - end; - - // CTRL+C: copy to clipboard - Ord('C'): if (Shift = [ssCtrl]) and CanCopy then - begin - CBCopy; - end; - - // CTRL+X: cut to clipboard - Ord('X'): if (Shift = [ssCtrl]) and CanCut then - begin - CBCut; - end; - - // CTRL+V: paste from clipboard - Ord('V'): if (Shift = [ssCtrl]) and CanPaste then - begin - CBPaste; - end; - - // CTRL+T/CTRL*SHIFT+Z: undo, redo - Ord('Z'): - begin - // undo - if (Shift = [ssCtrl]) and CanUndo then - begin - Undo; - end - // redo - else if (Shift = [ssShift, ssCtrl]) and CanRedo then - begin - Redo; - end - end; - end; -end; - -// handle backup creation - -procedure TMPHexEditorEx.PrepareOverwriteDiskFile; -var - LStrBackup: string; -begin - inherited; - - if (FCreateBackups and Modified) and FileExists(FileName) then - begin - LStrBackup := FileName + FBackupFileExt; - if FileExists(LStrBackup) and not DeleteFile(LStrBackup) then - raise EMPHexEditor.CreateFmt(ERR_BACKUP_DELETE, - [LStrBackup, SysErrorMessage(GetLastError)]); - - if not MoveFile(PChar(FileName), PChar(LStrBackup)) then - raise EMPHexEditor.CreateFmt(ERR_BACKUP_CREATE, - [LStrBackup, SysErrorMessage(GetLastError)]); - end; -end; - -// save to file (overwrite) - -procedure TMPHexEditorEx.Save; -begin - if not HasFile then - raise EMPHexEditor.Create(ERR_NOFILE); - SaveToFile(FileName); -end; - -// prepare ole dragging - -procedure TMPHexEditorEx.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: integer); -begin - inherited; - if FOleDragDrop and (Button = mbLeft) and MouseOverSelection and (not - IsSelecting) then - begin - FOleStartDrag := True; - FOleDragging := False; - FOleDragX := X; - FOleDragY := Y; - end -end; - -// check and eventually do ole dragging - -procedure TMPHexEditorEx.MouseMove(Shift: TShiftState; X, Y: integer); -var - LHrsOperation: HRESULT; - LIntEffect: integer; - LobjData: TMPHDataObject; -begin - inherited; - - if FOleDragDrop and (ssLeft in Shift) and (not FOleDragging) and FOleStartDrag - and MouseOverSelection and (not IsSelecting) and ((Abs(X - FOleDragX) >= - Mouse.DragThreshold) or (Abs(Y - FOleDragY) >= Mouse.DragThreshold)) then - begin - FOleStartDrag := False; - FOleDragging := True; - FoleWasTarget := False; - // start ole dragging - try - LobjData := TMPHDataObject.CreateFromStream(DataStorage, Min(SelStart, - SelEnd), SelCount, ExtractFileName(FileName), FClipboardAsHexText, - SwapNibbles); - if not ReadOnlyView then - LHrsOperation := DoDragDrop(LobjData, TMPHDropSource.Create, - DROPEFFECT_COPY or DROPEFFECT_MOVE, LIntEffect) - else - LHrsOperation := DoDragDrop(LobjData, TMPHDropSource.Create, - DROPEFFECT_COPY, LIntEffect); - // if feedback has given via idataobject.setdata - if LObjData.FHasDropEffect then - LIntEffect := LObjData.FDropEffect; - // unexcpected result - if (LHrsOperation <> DRAGDROP_S_CANCEL) and (LHrsOperation <> - DRAGDROP_S_DROP) then - OLECheck(LHrsOperation) - else if (LHrsOperation = DRAGDROP_S_DROP) and (LIntEffect = - DROPEFFECT_MOVE) then - begin - // dragged to an other window - if not FOleWasTarget then - DeleteSelection - else - // dragged to me, so on move, selection is already deleted, create a move undo - CombineUndo(2, UNDO_MOVED); - end; - finally - FOleDragging := False; - FOleWasTarget := False; - HideDragCell; - end; - end; -end; - -// cancel dragging and flags - -procedure TMPHexEditorEx.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: - integer); -begin - if FHasDoubleClicked then - begin - MouseUpCanResetSel := False; - FHasDoubleClicked := False; - end; - inherited; - if FOleDragging then - begin - FOleDragging := False; - FOleStartDrag := False; - end; -end; - -// don't allow ole dnd in ide or while loading - -procedure TMPHexEditorEx.SetOleDragDrop(const Value: boolean); -begin - if Value <> FOleDragDrop then - begin - FOleDragDrop := Value; - if ComponentState * [csLoading, csDesigning] = [] then - FDropTarget.Active := Value; - end; -end; - -// if ole dnd allowed, set new window handle in the drop target - -procedure TMPHexEditorEx.CreateWnd; -begin - inherited; - if not (csDesigning in ComponentState) then - begin - FDropTarget.Active := FOleDragDrop; - end; -end; - -// insert idataobject data - -function TMPHexEditorEx.InsertOLEData(const dataObj: IDataObject; const - grfKeyState: longint; const pt: TPoint; var dwEffect: longint; const - Operation: - TMPHOLEOperation): HRESULT; -var - LRecStg: TStgMedium; - LStrData, LStrBin: string; - LIntData, LIntPos, LIntLoop: integer; - LszBuf: array[0..MAX_PATH] of char; - LfstFile: TFileStream; - LPtrLock: Pointer; - LIntGlobalSize: integer; -begin - Result := E_FAIL; - LStrData := ''; - LIntData := 0; - WaitCursor; - try - // haupt-format? - if ((FOLEFormat[Operation] = CF_MPHEXEDITOR) or (FOLEFormat[Operation] = - CF_HDROP)) or QueryOLEFormat(GetMyOLEFormats, dataObj, - FOLEFormat[Operation], FClipboardAsHexText) then - begin - // je nach format daten konvertieren - case FOLEFormat[Operation] of - CF_HDROP: if Succeeded(GetIDataObjectData(dataObj, - FOLEFormat[Operation], LRecStg)) then - try - // link: -> put all filenames - // copy: -> copy contents of first file - LIntLoop := DragQueryFile(LRecStg.hGlobal, cardinal(-1), nil, 0); - if LintLoop > 0 then - begin - for LIntLoop := 0 to Pred(LIntLoop) do - begin - DragQueryFile(LRecStg.hGlobal, LIntLoop, LszBuf, - sizeof(LszBuf)); - Result := S_OK; - if dwEffect = DROPEFFECT_LINK then - begin - LStrData := LStrData + StrPas(LszBuf) + #0; - LIntData := Length(LStrData); - end - else - begin - Result := E_FAIL; - LfstFile := TFileStream.Create(LszBuf, fmOpenRead or - fmShareDenyNone); - try - SetLength(LStrData, LfstFile.Size); - LfstFile.ReadBuffer(LStrData[1], LfstFile.Size); - Result := S_OK; - LIntData := Length(LStrData); - Break; // just 1st file - finally - LfstFile.Free; - end; - end; - end; - end; - finally - ReleaseStgMedium(LRecStg); - end; - else - // format other than CF_HDROP (=files dropped), retrieve data - if Succeeded(GetIDataObjectData(dataObj, FOLEFormat[Operation], LRecStg)) - then - try - if LRecStg.tymed in [TYMED_HGLOBAL, TYMED_MFPICT] then - begin - LPtrLock := GlobalLock(LRecStg.hGlobal); - LIntGlobalSize := GlobalSize(LRecStg.hGlobal); - end - else - begin - LPtrLock := nil; - LIntGlobalSize := 0; - end; - try - LStrData := GetSomeData(LPtrLock, LRecStg.hGlobal, - FOLEFormat[Operation], LIntGlobalSize, UnicodeBigEndian); - if LStrData <> '' then - begin - LIntData := Length(LStrData); - if (FOLEFormat[Operation] in [CF_TEXT, CF_OEMTEXT]) and (Operation - = oleClipboard) and FClipBoardAsHexText then - begin - // convert hex text to data - SetLength(LStrBin, Length(LStrData)); - ConvertHexToBin(@LStrData[1], @LStrBin[1], LIntData, - SwapNibbles, LIntData); - LStrData := Copy(LStrBin, 1, LIntData); - end; - Result := S_OK; - end; - finally - if Assigned(LPtrLock) then - GlobalUnlock(LRecStg.hGlobal); - end; - finally - ReleaseStgMedium(LRecStg); - end - end; - - CheckUnit(LIntData); - - if (LStrData <> '') and (LIntData > 0) then - begin - // insert the data - case Operation of - oleDrop: - begin - LIntPos := DropPosition; - if LIntPos < 0 then - Result := E_FAIL - else - begin - if FOleDragging and (dwEffect = DROPEFFECT_MOVE) then - begin - FFixedFileSizeOverride := True; - try - // delete selection if we have moved data within ourself - FOleWasTarget := True; - if LIntPos > Min(SelStart, SelEnd) then - Dec(LIntPos, SelCount); - DeleteSelection; - if LIntPos >= DataSize then - Appendbuffer(@LStrData[1], LIntData, UNDO_DROPPED) - else - InsertBuffer(@LStrData[1], LIntData, LIntPos, - UNDO_DROPPED); - finally - FFixedFileSizeOverride := False; - end; - end - else - begin - if LIntPos >= DataSize then - begin - if not NoSizeChange then - Appendbuffer(@LStrData[1], LIntData, UNDO_DROPPED) - end - else - begin - if not NoSizeChange then - begin - if IsSelected(LIntPos) then - ReplaceSelection(@LStrData[1], LIntData, UNDO_DROPPED) - else - InsertBuffer(@LStrData[1], LIntData, LIntPos, - UNDO_DROPPED) - end - else - begin - if (SelCount = 0) or (not IsSelected(LIntPos)) then - Replace(@LStrData[1], LIntPos, LIntData, LIntData, - UNDO_DROPPED) - else - ReplaceSelection(@LStrData[1], LIntData, UNDO_DROPPED) - end; - end; - end; - end; - end; - oleClipboard: PasteData(PChar(LStrData), LIntData, UNDO_PASTECB); - end; - end - else - Result := E_FAIL; - end; - - finally - LStrData := ''; - OldCursor; - end; - if Result <> S_OK then - dwEffect := DROPEFFECT_NONE; -end; - -// do we support one of the provided idataobject formats? - -function TMPHexEditorEx.SupportsOLEData(const dataObj: IDataObject; const - grfKeyState: integer; const pt: TPoint; var dwEffect: integer; const - Operation: - TMPHOLEOperation): HRESULT; -begin - Result := S_FALSE; - if (not ReadOnlyView) and OLEHasSupportedFormat(dataObj, GetMyOLEFormats, - FOLEFormat[Operation]) then - Result := S_OK; - if FOLEFormat[Operation] = CF_HDROP then - if dwEffect = DROPEFFECT_MOVE then - dwEffect := DROPEFFECT_LINK; -end; - -function TMPHexEditorEx.OLEHasSupportedFormat(const dataObj: IDataObject; const - Formats: array of TClipFormat; var Format: TClipFormat): boolean; -var - LIntLoop: integer; - LObjEnum: TFormatEnum; -begin - Result := False; - LObjEnum := TFormatEnum.Create(dataObj); - try - if Length(Formats) > 0 then - for LIntLoop := Low(Formats) to High(Formats) do - if LObjEnum.HasFormat(Formats[LIntLoop]) then - begin - Format := Formats[LIntLoop]; - Result := True; - Break; - end; - finally - LObjEnum.Free; - end; -end; - -// modify effect (move/copy/link) depending on key state and data format - -function TMPHexEditorEx.ModifyOLEDropEffect(const grfKeyState: integer; const - pt: TPoint; var dwEffect: integer): HRESULT; -begin - Result := S_OK; - if FOleDragging then - begin - if ReadOnlyView then - dwEffect := DROPEFFECT_COPY - else - begin - if Bool(grfKeyState and MK_CONTROL) then - dwEffect := DROPEFFECT_COPY - else - dwEffect := DROPEFFECT_MOVE; - end; - end - else - begin - if Bool(grfKeyState and MK_SHIFT) and (not ReadOnlyView) then - dwEffect := DROPEFFECT_MOVE - else - dwEffect := DROPEFFECT_COPY; - - if FOLEFormat[oleDrop] = CF_HDROP then - if dwEffect = DROPEFFECT_MOVE then - dwEffect := DROPEFFECT_LINK; - end; -end; - -// return a clipformat array with all supported formats - -function TMPHexEditorEx.GetMyOLEFormats: TClipFormats; -begin - if FSupportsOtherClipFormats then - SetLength(Result, 17) - else - SetLength(Result, 2); - Result[0] := CF_MPHEXEDITOR; - Result[1] := CF_HDROP; - if FSupportsOtherClipFormats then - begin - Result[2] := CF_TEXT; - Result[3] := CF_RTF; - Result[4] := CF_UNICODETEXT; - Result[5] := CF_BITMAP; - Result[6] := CF_PALETTE; - Result[7] := CF_METAFILEPICT; - Result[8] := CF_TIFF; - Result[9] := CF_OEMTEXT; - Result[10] := CF_DIB; - Result[11] := CF_RIFF; - Result[12] := CF_WAVE; - Result[13] := CF_ENHMETAFILE; - Result[14] := CF_LOCALE; - Result[15] := CF_REGEDIT_HEXDATA; - Result[16] := CF_HTML; - end; -end; - -// reset droptarget helper interface on window destruction - -procedure TMPHexEditorEx.WMDestroy(var Message: TWMDestroy); -begin - inherited; - if ComponentState * [csLoading, csDesigning] = [] then - FDropTarget.Active := False; -end; - -// internal - -function TMPHexEditorEx.DumpUndoStorage(const FileName: string): boolean; -begin - Result := False; - if Assigned(UndoStorage) then - try - Result := True; - UndoStorage.SaveToFile(FileName); - except - Result := False; - end; -end; - -// set new printing options - -procedure TMPHexEditorEx.SetPrintOptions(const Value: TMPHPrintOptions); -begin - FPrintOptions.Assign(Value); -end; - -// internal: draw the specified page to a canvas using the given margins and options - -function TMPHexEditorEx.PrintToCanvas(ACanvas: TCanvas; const APage: integer; - const AMargins: TRect): integer; -var - LObjPrinter: TMPHCanvasPrinter; - LSetFlags: TMPHPrintFlags; -begin - if APage < 0 then - raise EMPHexEditor.Create(ERR_INVALID_PAGE); - WaitCursor; - LSetFlags := FPrintOptions.Flags; - try - if SelCount = 0 then - Exclude(LSetFlags, pfSelectionOnly); - LObjPrinter := TMPHCanvasPrinter.Create(self, ACanvas, LSetFlags, AMargins, - FPrintOptions.FHeaders); - try - Result := LObjPrinter.Pages; - if APage > Result then - raise EMPHexEditor.Create(ERR_INVALID_PAGE); - if APage > 0 then - if LObjPrinter.DrawOrCalc(False, APage) < 1 then - raise EMPHexEditor.Create(ERR_PRINTING_FAILED); - finally - LObjPrinter.Free; - end; - finally - OldCursor; - end; -end; - -// create a metafile with the selected page as a print preview - -function TMPHexEditorEx.PrintPreview(const Page: integer): TMetaFile; -var - LcnvMeta: TMetaFileCanvas; - LIntHeight, LIntWidth: integer; -begin - LIntWidth := GetDeviceCaps(Printer.Handle, HORZRES); - LIntHeight := GetDeviceCaps(Printer.Handle, VERTRES); - Result := TMetaFile.Create; - with Result do - begin - Width := LIntWidth; - Height := LIntHeight; - LcnvMeta := TMetaFileCanvas.Create(Result, 0); - with LcnvMeta do - try - if FUseEditorFontForPrinting then - Font.Assign(self.Font) - else - Font.Assign(self.FPrintFont); - SetMapMode(Handle, MM_ANISOTROPIC); - SetWindowExtEx(Handle, LIntWidth, LIntHeight, nil); - SetViewPortExtEx(Handle, LIntWidth, LIntHeight, nil); - Font.Size := Round(Font.Size * GetDeviceCaps(Printer.Handle, LOGPIXELSY) / - Screen.PixelsPerInch); - Brush.Style := bsSolid; - Brush.Color := clWhite; - FillRect(Rect(0, 0, LIntWidth, LIntHeight)); - FPrintPages := PrintToCanvas(LcnvMeta, Page, PrinterMarginRect); - finally - Free; - end; - end; -end; - -// print the given page - -procedure TMPHexEditorEx.Print(const Page: integer); -var - LmtfTemp: TMetaFile; -begin - if Page < 1 then - raise EMPHexEditor.Create(ERR_INVALID_PAGE); - LmtfTemp := PrintPreview(Page); - with LmtfTemp do - try - Printer.Canvas.StretchDraw(Rect(0, 0, Printer.PageWidth, - Printer.PageHeight), LmtfTemp); - finally - Free; - end; -end; - -// calculate margins from margins in print options - -function TMPHexEditorEx.PrinterMarginRect: TRect; -var - LIntLogX, LIntLogY, LIntPhysWidth, LIntPhysHeight: integer; -begin - Result := FPrintOptions.FMargins; - LIntLogX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); - // pixels per inch in x dir - LIntLogY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); - // pixels per inch in Y dir - LIntPhysWidth := Printer.PageWidth; - LIntPhysHeight := Printer.PageHeight; - Result.Left := Round(Result.Left / 25.4 * LIntLogX); - Result.Top := Round(Result.Top / 25.4 * LIntLogY); - Result.Right := LIntPhysWidth - Round(Result.Right / 25.4 * LIntLogX); - Result.Bottom := LIntPhysHeight - Round(Result.Bottom / 25.4 * LIntLogY); -end; - -// calculate page count - -function TMPHexEditorEx.PrintNumPages: integer; -begin - PrintPreview(0).Free; - Result := FPrintPages; -end; - -// empty or flush ole contents in clipboard that have been stored by this instance - -procedure TMPHexEditorEx.ReleaseClipboard(const Flush: boolean); -begin - if OwnsClipboard then - begin - if Flush then - OleCheck(OleFlushClipboard) - else - OleSetClipboard(nil); - end; -end; - -// is there data on the clipboard created by us? - -function TMPHexEditorEx.OwnsClipBoard: boolean; -begin - Result := OleIsCurrentClipBoard(FClipData) = S_OK; -end; - -procedure TMPHexEditorEx.SetPrintFont(const Value: TFont); -begin - FPrintFont.Assign(Value); - FUseEditorFontForPrinting := False; -end; - -{$IFDEF DELPHI6UP} - -procedure TMPHexEditorEx.DoContextPopup(MousePos: TPoint; var Handled: boolean); -begin - inherited; - if (not Handled) and (Assigned(FOffsetPopupMenu)) then - begin - // is mouse over offset col - with MousePos do - if ((X > -1) and (X < (ColWidths[0] + ColWidths[1]))) or ((Y > -1) and (Y - < (RowHeights[0] + RowHeights[1]))) then - begin - // in fixed range - if FOffsetPopupMenu.AutoPopup then - begin - Handled := True; - SendCancelMode(nil); - FOffsetPopupMenu.PopupComponent := Self; - MousePos := ClientToScreen(MousePos); - if InvalidPoint(MousePos) then - MousePos := ClientToScreen(Point(0, 0)); - FOffsetPopupMenu.Popup(MousePos.X, MousePos.Y); - end; - end; - end -end; -{$ENDIF} - -procedure TMPHexEditorEx.SetOffsetPopupMenu(const Value: TPopupMenu); -begin - FOffsetPopupMenu := Value; - if Assigned(Value) then - with Value do - begin - ParentBiDiModeChanged(self); - FreeNotification(self); - end; -end; - -function TMPHexEditorEx.GetOffsetPopupMenu: TPopupMenu; -begin - Result := FOffsetPopupMenu; -end; - -procedure TMPHexEditorEx.Notification(AComponent: TComponent; Operation: - TOperation); -begin - inherited; - if AComponent = FOffsetPopupMenu then - if Operation = opRemove then - OffsetPopupMenu := nil; -end; - -function TMPHexEditorEx.CanCreateUndo(const aKind: TMPHUndoFlag; - const aCount, aReplCount: integer): Boolean; -begin - Result := inherited CanCreateUndo(aKind, aCount, aReplCount); - if Result and (UndoStorage.UpdateCount > 0) then - FModifiedNoUndo := True; -end; - -function TMPHexEditorEx.GetBookmarksAsString: string; -var - LIntLoop, - LIntCheck: integer; -begin - Result := ''; - for LIntLoop := Low(TMPHBookMarks) to High(TMPHBookMarks) do - with BookMark[LIntLoop] do - if mPosition <> -1 then - Result := Result + IntToRadixLen(LIntLoop, 16, 2) + - IntToRadixLen(mPosition, 16, 16) + - IntToRadixLen(integer(mInCharField), - 16, 2); - if Result <> '' then - begin - LIntCheck := 0; - for LIntLoop := 1 to Length(Result) do - LIntCheck := LIntCheck + Ord(Result[LIntLoop]); - Result := IntToRadixLen(LIntCheck, 16, 8) + Result; - end; -end; - -procedure TMPHexEditorEx.SetBookMarksAsString(Value: string); -var - LIntLoop, LIntCheck, LIntCheck1, LIntPos: integer; - LBoolChars: boolean; - LRecBook: TMPHBookMark; -begin - BeginUpdate; - FBookmarksNoChange := True; - try - // empty all bookmarks - LRecBook.mPosition := -1; - LRecBook.mInCharField := InCharField; - for LIntLoop := Low(TMPHBookMarks) to High(TMPHBookMarks) do - Bookmark[LIntLoop] := LRecBook; - - if Value <> '' then - begin - try - // check sum - LIntCheck := RadixToInt(Copy(Value, 1, 8), 16); - Delete(Value, 1, 8); - - // calc check sum - LIntCheck1 := 0; - for LIntLoop := 1 to Length(Value) do - LIntCheck1 := LIntCheck1 + Ord(Value[LIntLoop]); - - if LIntCheck1 <> LIntCheck then - raise EMPHexEditor.Create(ERR_INVALID_BOOKFMT); - - // set bookmarks - //for LIntLoop := Low(TMPHBookMarks) to High(TMPHBookMarks) do - while Value <> '' do - begin - LIntLoop := RadixToInt(Copy(Value, 1, 2), 16); - Delete(Value, 1, 2); - LIntPos := RadixToInt(Copy(Value, 1, 16), 16); - Delete(Value, 1, 16); - LBoolChars := boolean(RadixToInt(Copy(Value, 1, 2), 16)); - Delete(Value, 1, 2); - LRecBook := Bookmark[LIntLoop]; - if (LRecBook.mPosition <> LIntPos) or (LRecBook.mInCharField <> - LBoolChars) then - begin - LRecBook.mPosition := LIntPos; - LRecBook.mInCharField := LBoolChars; - Bookmark[LIntLoop] := LRecBook; - end; - end; - - except - raise EMPHexEditor.Create(ERR_INVALID_BOOKFMT); - end; - end; - finally - EndUpdate; - FBookmarksNoChange := False; - BookmarkChanged; - end; -end; - -{$IFDEF DELPHI6UP} -const - PUBLIC_PROPS: array[0..66] of string = ('ShowRuler', - 'DrawGutter3D', - 'CreateBackup', - 'BackupExtension', - 'OleDragDrop', - 'ClipboardAsHexText', - 'FlushClipboardAtShutDown', - 'SupportsOtherClipFormats', - 'UseEditorFontForPrinting', - 'ZoomOnWheel', - 'BytesPerRow', - 'BytesPerColumn', - 'Translation', - 'OffsetFormat', - 'CaretKind', - 'FocusFrame', - 'SwapNibbles', - 'MaskChar', - 'NoSizeChange', - 'AllowInsertMode', - 'DrawGridLines', - 'ReadOnlyView', - 'HideSelection', - 'GraySelectionIfNotFocused', - 'GutterWidth', - 'MaxUndo', - 'InsertMode', - 'HexLowerCase', - 'Colors.Background', - 'Colors.ChangedBackground', - 'Colors.ChangedText', - 'Colors.CursorFrame', - 'Colors.NonFocusCursorFrame', - 'Colors.Offset', - 'Colors.OddColumn', - 'Colors.EvenColumn', - 'Colors.CurrentOffsetBackground', - 'Colors.OffsetBackGround', - 'Colors.CurrentOffset', - 'Colors.ActiveFieldBackground', - 'Colors.Grid', - 'PrintFont.Charset', - 'PrintFont.Color', - 'PrintFont.Name', - 'PrintFont.Size', - 'PrintFont.Style', - 'PrintOptions.MarginLeft', - 'PrintOptions.MarginTop', - 'PrintOptions.MarginRight', - 'PrintOptions.MarginBottom', - 'PrintOptions.PageHeader', - 'PrintOptions.PageFooter', - 'PrintOptions.Flags', - 'Font.Charset', - 'Font.Color', - 'Font.Name', - 'Font.Size', - 'Font.Style', - 'BytesPerUnit', - 'RulerBytesPerUnit', - 'ShowPositionIfNotFocused', - 'UnicodeChars', - 'UnicodeBigEndian', - 'BytesPerBlock', - 'SeparateBlocksInCharField', - 'FindProgress', - 'RulerNumberBase' - ); - -function TMPHexEditorEx.IsPropPublic(const PropName: string): boolean; -var - LIntLoop: integer; -begin - Result := False; - for LIntLoop := Low(PUBLIC_PROPS) to High(PUBLIC_PROPS) do - if AnsiCompareText(PropName, PUBLIC_PROPS[LIntLoop]) = 0 then - begin - Result := True; - Break; - end; - if Result and Assigned(FOnQueryPublicProperty) then - FOnQueryPublicProperty(self, PropName, Result); -end; - -function TMPHexEditorEx.GetPropertiesAsString: string; - - procedure Recurse(Ref: TObject; const Prefix: string); - var - LPtrProps: PPropList; - LIntCount: integer; - begin - if Ref = nil then - Exit; - LIntCount := GetPropList(Ref, LPTrProps); - if LIntCount > 0 then - try - for LIntCount := 0 to Pred(LIntCount) do - with LPtrProps^[LIntCount]^ do - if PropType^^.Kind = tkClass then - Recurse(GetObjectProp(Ref, Name), Prefix + Name + '.') - else if IsPropPublic(Prefix + Name) then - Result := Result + Prefix + Name + '=' + - string(GetPropValue(Ref, Name)) + #13#10; - - finally - FreeMem(LPtrProps); - end; - end; -begin - Result := ''; - Recurse(self, ''); -end; - -procedure TMPHexEditorEx.SetPropertiesAsString(const Value: string); -var - LStrData: TStrings; - LIntLoop, LIntDot: integer; - LStrProp, LStrVal: string; - LObjProp: TObject; -begin - BeginUpdate; - try - LStrData := TStringList.Create; - with LStrData do - try - Text := Value; - if Count > 0 then - for LIntLoop := 0 to Pred(Count) do - begin - LStrProp := Names[LIntLoop]; - if IsPropPublic(LStrProp) then - begin - LStrVal := Values[LStrProp]; - LObjProp := self; - repeat - LIntDot := Pos('.', LStrProp); - if LIntDot > 0 then - begin - LObjProp := GetObjectProp(LObjProp, Copy(LStrProp, 1, LIntDot - - 1)); - System.Delete(LStrProp, 1, LIntDot); - end; - until LIntDot = 0; - if Assigned(LObjProp) then - SetPropValue(LObjProp, LStrProp, LStrVal); - end; - end; - finally - Free; - end; - finally - EndUpdate; - end; -end; -{$ENDIF} - -procedure TMPHexEditorEx.Paint; -begin - //inherited; - if FPaintUpdateCounter < 1 then - inherited; -end; - -procedure TMPHexEditorEx.DblClick; -var - LptMouse: TPoint; - LIntPos: Integer; -begin - // get the position where the mouse is - Windows.GetCursorPos(LptMouse); - LptMouse := ScreenToClient(LptMouse); - with CheckMouseCoord(LptMouse.X, LptMouse.Y) do - LIntPos := GetPosAtCursor(X, Y); - if (LIntPos > -1) and (LIntPos < DataSize) then - begin - NewSelection(LIntPos, LIntPos); - FHasDoubleClicked := True; - MouseUpCanResetSel := False; - end; - inherited; -end; - -procedure TMPHexEditorEx.PasteData(P: Pointer; const ACount: integer; - const UndoDesc: string); -var - LgrcCoords: TGridCoord; - LIntPos: integer; -begin - // assure that we are positionned at the beginning of a unit - LIntPos := 0; - if SelCount = 0 then - begin - LIntPos := GetPosAtCursor(Col, Row); - if (LIntpos mod BytesPerUnit) <> 0 then - begin - while (LIntPos mod BytesPerUnit) <> 0 do - Dec(LIntPos); - LGrcCoords := GetCursorAtPos(LIntPos, InCharField); - with LGrcCoords do - begin - Col := X; - Row := Y; - end; - end; - end; - if (SelCount = 0) and NoSizeChange then - begin - SelStart := LIntPos; - SelEnd := Min(DataSize - 1, LIntPos + ACount - 1); - end; - ReplaceSelection(P, ACount, UndoDesc); -end; - -procedure TMPHexEditorEx.BookmarkChanged; -begin - if not FBookmarksNoChange then - inherited; -end; - -function TMPHexEditorEx.UndoBeginUpdate(const StrUndoDesc: string = ''): - integer; -begin - if (UndoStorage.UpdateCount = 0) and (FCreateUndoOnUndoUpdate or (StrUndoDesc - <> '')) then - begin - FCreateUndoOnUndoUpdate := True; - CreateRangeUndo(0, 0, StrUndoDesc); - FModifiedNoUndo := False; - end; - Result := inherited UndoBeginUpdate; -end; - -function TMPHexEditorEx.UndoEndUpdate: integer; -begin - Result := inherited UndoEndUpdate; - if (Result = 0) and FCreateUndoOnUndoUpdate then - begin - if FModifiedNoUndo then - FModifiedNoUndo := False - else - begin - UndoStorage.RemoveLastUndo; - end; - end; -end; - -procedure TMPHexEditorEx.WriteBuffer(const Buffer; const Index, - Count: Integer); -begin - inherited; - FModified := True; - if UndoStorage.UpdateCount > 0 then - FModifiedNoUndo := True; -end; - -{ TMPHDropTarget } - -// constructor - -constructor TMPHDropTarget.Create(Editor: TMPHexEditorEx); -begin - inherited Create; - FEditor := Editor; - FEditorHandle := 0; - FActive := False; - _AddRef; // don't free automatically because it's an object in TMPHexEditorEx -end; - -// tinterfacedobject auto-destructor hook - -procedure TMPHDropTarget.BeforeDestruction; -begin - Dec(FRefCount); // see create above - Active := False; - inherited; -end; - -// do we support data format? if yes, set desired drop effect - -function TMPHDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: - integer; pt: TPoint; var dwEffect: integer): HResult; -begin - Result := FEditor.SupportsOLEData(dataObj, grfKeyState, pt, dwEffect, - oleDrop); - if Result = S_OK then - begin - Result := FEditor.ModifyOLEDropEffect(grfKeyState, pt, dwEffect); - if Result = S_OK then - begin - pt := FEditor.ScreenToClient(pt); - FEditor.ShowDragCell(pt.X, pt.Y) - end; - end - else - dwEffect := DROPEFFECT_NONE; -end; - -// dragged out of window - -function TMPHDropTarget.DragLeave: HResult; -begin - Result := S_OK; - FEditor.HideDragCell; -end; - -// dragging over window - -function TMPHDropTarget.DragOver(grfKeyState: integer; pt: TPoint; var dwEffect: - integer): HResult; -begin - Result := FEditor.ModifyOLEDropEffect(grfKeyState, pt, dwEffect); - if Result = S_OK then - begin - pt := FEditor.ScreenToClient(pt); - FEditor.ShowDragCell(pt.X, pt.Y) - end - else - begin - dwEffect := DROPEFFECT_NONE; - FEditor.HideDragCell; - end; -end; - -// dropped! - -function TMPHDropTarget.Drop(const dataObj: IDataObject; grfKeyState: integer; - pt: TPoint; var dwEffect: integer): HResult; -begin - try - Result := FEditor.SupportsOLEData(dataObj, grfKeyState, pt, dwEffect, - oleDrop); - if Result = S_OK then - begin - Result := FEditor.ModifyOLEDropEffect(grfKeyState, pt, dwEffect); - if Result = S_OK then - try - Result := FEditor.InsertOLEData(dataObj, grfKeyState, pt, dwEffect, - oleDrop); - except - Result := E_FAIL; - ShowException(ExceptObject, ExceptAddr); - end; - end; - finally - FEditor.HideDragCell; - end; -end; - -// retrieve window handle from associated hex editor and (de)activate drop target - -procedure TMPHDropTarget.SetActive(const Value: boolean); -begin - if FActive <> Value then - begin - FActive := Value; - if not Value then - begin - OleCheck(RevokeDragDrop(FEditorHandle)); - OleCheck(CoLockObjectExternal(self, False, True)); - end - else - begin - FEditorHandle := FEditor.Handle; - OleCheck(RegisterDragDrop(FEditor.Handle, self)); - OleCheck(CoLockObjectExternal(self, True, False)); - end; - end; -end; - -{ TFormatEnum } - -// constructor - -constructor TFormatEnum.Create(const dataObject: IDataObject); -var - LRecFormat: TFormatETC; - LifEnum: IEnumFormatETC; -begin - FFormats := nil; - if Succeeded(dataObject.EnumFormatEtc(DATADIR_GET, LifEnum)) then - begin - while LifEnum.Next(1, LRecFormat, nil) = S_OK do - begin - SetLength(FFormats, Succ(Length(FFormats))); - FFormats[Pred(Length(FFormats))] := LRecFormat; - end; - end; -end; - -// destructor - -destructor TFormatEnum.Destroy; -begin - FFormats := nil; - inherited; -end; - -// return the desired formatetc struct - -function TFormatEnum.GetFormatETC(const cfFormat: TClipFormat): TFormatETC; -var - LBoolOK: boolean; - LIntLoop: integer; -begin - LBoolOK := False; - if Length(FFormats) > 0 then - for LIntLoop := 0 to Pred(Length(FFormats)) do - if FFormats[LIntLoop].cfFormat = cfFormat then - begin - LBoolOK := True; - Result := FFormats[LIntLoop]; - Break; - end; - if not LBoolOK then - FillChar(Result, sizeof(Result), #$FF); -end; - -// is the desired format available? - -function TFormatEnum.HasFormat(const cfFormat: TClipFormat): boolean; -var - LIntLoop: integer; -begin - Result := False; - if Length(FFormats) > 0 then - for LIntLoop := 0 to Pred(Length(FFormats)) do - if FFormats[LIntLoop].cfFormat = cfFormat then - begin - Result := True; - Break; - end; -end; - -{ TMPHEnumFormatETC } - -// constructor - -constructor TMPHEnumFormatETC.Create; -begin - inherited Create; - FIndex := 0; - with FFormats[0] do - begin - cfFormat := CF_MPHEXEDITOR; - ptd := nil; - dwAspect := DVASPECT_CONTENT; - lindex := -1; - tymed := TYMED_HGLOBAL; - end; - with FFormats[1] do - begin - cfFormat := CF_TEXT; - ptd := nil; - dwAspect := DVASPECT_CONTENT; - lindex := -1; - tymed := TYMED_HGLOBAL; - end; - with FFormats[2] do - begin - cfFormat := CF_FILEDESCRIPTOR; - ptd := nil; - dwAspect := DVASPECT_CONTENT; - lindex := -1; - tymed := TYMED_HGLOBAL; - end; - with FFormats[3] do - begin - cfFormat := CF_FILECONTENTS; - ptd := nil; - dwAspect := DVASPECT_CONTENT; - lindex := -1; - tymed := TYMED_HGLOBAL; - end; -end; - -// clone myself - -function TMPHEnumFormatETC.Clone(out Enum: IEnumFormatEtc): HResult; -begin - Enum := TMPHEnumFormatETC.Create; - Result := S_OK; -end; - -// iterate over all format records - -function TMPHEnumFormatETC.Next(celt: integer; out elt; pceltFetched: PLongint): - HResult; -var - LIntLoop: integer; - LRecOut: packed array[0..MY_SUPPORTED_FORMATS - 1] of TFormatETC absolute elt; -begin - LIntLoop := 0; - while (LIntLoop < celt) and (FIndex < MY_SUPPORTED_FORMATS) do - begin - LRecOut[LIntLoop] := FFormats[FIndex]; - Inc(FIndex); - Inc(LIntLoop); - end; - - if pceltFetched <> nil then - pceltFetched^ := LIntLoop; - - if LIntLoop = celt then - Result := S_OK - else - Result := S_FALSE; -end; - -// reset iteration - -function TMPHEnumFormatETC.Reset: HResult; -begin - FIndex := 0; - Result := S_OK; -end; - -// skip entries - -function TMPHEnumFormatETC.Skip(celt: integer): HResult; -begin - if (celt < MY_SUPPORTED_FORMATS - FIndex) then - begin - FIndex := FIndex + celt; - Result := S_OK; - end - else - Result := S_FALSE; -end; - -{ TMPHDropSource } - -// use default ole dnd cursors - -function TMPHDropSource.GiveFeedback(dwEffect: integer): HResult; -begin - case dwEffect and 7 of - DROPEFFECT_NONE, - DROPEFFECT_COPY, - DROPEFFECT_MOVE: Result := DRAGDROP_S_USEDEFAULTCURSORS; - else - Result := E_INVALIDARG; - end; -end; - -// standard behaviour - -function TMPHDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: - integer): HResult; -begin - if fEscapePressed then - Result := DRAGDROP_S_CANCEL - else if (grfKeyState and MK_LBUTTON) = 0 then - Result := DRAGDROP_S_DROP - else - Result := S_OK; -end; - -{ TMPHDataObject } - -// constructor - -constructor TMPHDataObject.Create(Data: Pointer; DataSize: integer; - ScrapFileName: ShortString; TextAsHex, SwapNibbles: boolean); -begin - inherited Create; - FData := nil; - FHasDropEffect := False; - FTextAsHex := TextAsHex; - FSwapNibbles := SwapNibbles; - if Assigned(Data) and (DataSize > 0) then - begin - FDataSize := DataSize; - FFileName := Format(STR_SCRAPFILE, - [ChangeFileExt(ExtractFileName(ScrapFileName), ''), - ExtractFileExt(ScrapFileName)]); - GetMem(FData, DataSize); - Move(Data^, FData^, FDataSize); - end; -end; - -constructor TMPHDataObject.CreateFromStream(Stream: TStream; Position, DataSize: - integer; ScrapFileName: ShortString; TextAsHex, SwapNibbles: boolean); -begin - inherited Create; - FData := nil; - FHasDropEffect := False; - FTextAsHex := TextAsHex; - FSwapNibbles := SwapNibbles; - if Assigned(Stream) and (DataSize > 0) then - begin - FDataSize := DataSize; - FFileName := Format(STR_SCRAPFILE, - [ChangeFileExt(ExtractFileName(ScrapFileName), ''), - ExtractFileExt(ScrapFileName)]); - GetMem(FData, DataSize); - Stream.Position := Position; - Stream.ReadBuffer(FData^, FDataSize); - end; -end; - -// destructor hook - -procedure TMPHDataObject.BeforeDestruction; -begin - if Assigned(FData) and (FDataSize > 0) then - FreeMem(FData); - FData := nil; - FDataSize := 0; - inherited; -end; - -// advise not supported - -function TMPHDataObject.DAdvise(const formatetc: TFormatEtc; advf: integer; const - advSink: IAdviseSink; out dwConnection: integer): HResult; -begin - Result := OLE_E_ADVISENOTSUPPORTED; -end; - -function TMPHDataObject.DUnadvise(dwConnection: integer): HResult; -begin - Result := OLE_E_ADVISENOTSUPPORTED; -end; - -function TMPHDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult; -begin - Result := OLE_E_ADVISENOTSUPPORTED; -end; - -// create a formetc enumerator, only for getdata - -function TMPHDataObject.EnumFormatEtc(dwDirection: integer; out enumFormatEtc: - IEnumFormatEtc): HResult; -begin - enumFormatETC := nil; - if dwDirection = DATADIR_GET then - begin - enumFormatETC := TMPHEnumFormatETC.Create; - Result := S_OK; - end - else - Result := E_NOTIMPL; -end; - -// always same format - -function TMPHDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out - formatetcOut: TFormatEtc): HResult; -begin - formatetcOut := formatetc; - formatetcOut.ptd := nil; - Result := DATA_S_SAMEFORMATETC; -end; - -// render and return data depending on the desired format - -function TMPHDataObject.GetData(const formatetcIn: TFormatEtc; out medium: - TStgMedium): HResult; -var - LIntDataSize: integer; - LPtrLocal: PClipData; - LRecSysTime: TSystemTime; -begin - FillChar(medium, sizeof(medium), #0); - Result := QueryGetData(formatetcIn); - if Result = S_OK then - begin - if formatetcIn.cfFormat = CF_MPHEXEDITOR then - LIntDataSize := sizeof(TClipData) - 1 + FDataSize - else if formatetcIn.cfFormat = CF_TEXT then - begin - if not FTextAsHex then - LIntDataSize := Min(FDataSize, StrLen(PChar(FData))) + 1 - else - LIntDataSize := (FDataSize * 2) + 1; - end - else if formatetcIn.cfFormat = CF_FILEDESCRIPTOR then - LIntDataSize := sizeof(TFileGroupDescriptor) - else - LIntDataSize := FDataSize; - medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, - LIntDataSize); - if medium.hGlobal = 0 then - Result := E_OUTOFMEMORY - else - begin - LPtrLocal := GlobalLock(medium.hGlobal); - try - try - medium.tymed := TYMED_HGLOBAL; - if formatetcIn.cfFormat = CF_TEXT then - begin - if FTextAsHex then - ConvertBinToHex(FData, PChar(LPtrLocal), FDataSize, FSwapNibbles) - else - Move(FData^, LPtrLocal^, LIntDataSize - 1); - PChar(LPtrLocal)[LIntDataSize - 1] := #0; - end - else if formatetcIn.cfFormat = CF_MPHEXEDITOR then - begin - LPtrLocal^.Signature := CLIP_SIG; - LPtrLocal^.Version := CLIP_VER; - LPtrLocal^.Size := FDataSize; - Move(FData^, LPtrLocal^.Data, FDataSize); - end - else if formatetcIn.cfFormat = CF_FILEDESCRIPTOR then - begin - with PFileGroupDescriptor(LPtrLocal)^ do - begin - cItems := 1; - with fgd[0] do - begin - dwFlags := FD_FILESIZE or FD_WRITESTIME; // or FD_PROGRESSUI; - nFileSizeLow := FDataSize; - nFileSizeHigh := 0; - GetSystemTime(LRecSysTime); - SystemTimeToFileTime(LRecSysTime, ftLastWriteTime); - Move(FFileName[1], cFileName, Min(Length(FFileName), - sizeof(cFileName) - 1)); - end; - end; - end - else - begin - Move(FData^, LPtrLocal^, LIntDataSize); - end; - except - Result := E_OUTOFMEMORY; - GlobalFree(medium.hGlobal); - medium.hGlobal := 0; - end; - finally - GlobalUnlock(medium.hGlobal); - end; - end; - end; -end; - -// what's this? - -function TMPHDataObject.GetDataHere(const formatetc: TFormatEtc; - out medium: TStgMedium): HResult; -begin - Result := DV_E_FORMATETC; -end; - -// do we support the desired format? - -function TMPHDataObject.QueryGetData(const formatetc: TFormatEtc): HResult; -begin - Result := DV_E_FORMATETC; - with formatetc do - begin - if dwAspect <> DVASPECT_CONTENT then - Result := DV_E_DVASPECT - else if not Bool(tymed and TYMED_HGLOBAL) - {// multiple tymeds may be queried (e.g. from explorer, wordpad...)}then - Result := DV_E_TYMED - else if (lindex <> -1) and ((cfFormat <> CF_FILECONTENTS) and (Lindex <> 0)) - then - Result := DV_E_LINDEX - else if (cfFormat = CF_MPHEXEDITOR) or (cfFormat = CF_TEXT) or - (cfFormat = CF_FILEDESCRIPTOR) or (cfFormat = CF_FILECONTENTS) then - Result := S_OK; - end; -end; - -// check for dropeffect calls (dodragdrop not always return the real effect) - -function TMPHDataObject.SetData(const formatetc: TFormatEtc; var medium: - TStgMedium; fRelease: BOOL): HResult; -var - LPtrEffect: PDWORD; -begin - Result := E_NOTIMPL; - if ((formatetc.cfFormat = CF_PERFORMEDDROPEFFECT) or (formatetc.cfFormat = - CF_LOGICALPERFORMEDDROPEFFECT)) and (medium.tymed = TYMED_HGLOBAL) then - begin - Result := S_OK; - // check drop effect - LPtrEffect := GlobalLock(medium.hGlobal); - try - FHasDropEffect := True; - FDropEffect := LPtrEffect^; - finally - GlobalUnLock(medium.hGlobal); - end; - end; - if fRelease then - ReleaseStgMedium(medium); -end; - -{ TMPHCanvasPrinter } - -// init - -constructor TMPHCanvasPrinter.Create(AEditor: TMPHexEditorEx; ACanvas: TCanvas; - AFlags: TMPHPrintFlags; AMargins: TRect; AHeaders: TMPHPrintHeaders); -begin - inherited Create; - FMargins := AMargins; - FCanvas := ACanvas; - FFlags := AFlags; - FEditor := AEditor; - FHeaders[0] := AHeaders[0]; - FHeaders[1] := AHeaders[1]; - GetLinesPerPage; -end; - -// convert %s variables - -function TMPHCanvasPrinter.BuildHeader(const S: string; const Page: integer): - string; -var - LIntLoop: integer; -begin - Result := ''; - LIntLoop := 1; - while LIntLoop <= Length(S) do - begin - if (S[LIntLoop] = '%') and (LIntLoop < Length(S)) then - begin - Inc(LIntLoop); - case S[LIntLoop] of - 'f': Result := Result + ExtractFileName(FEditor.Filename); - 'F': Result := Result + FEditor.Filename; - 'p': Result := Result + IntToRadix(Page, 10); - 'P': Result := Result + IntToRadix(FPages, 10); - 't': Result := Result + TimeToStr(now); - 'd': Result := Result + DateToStr(now); - '>': - begin - if not FEditor.UnicodeChars then - Result := Result + MPHTranslationDesc - [FEditor.Translation] - else - begin - if not FEditor.UnicodeBigEndian then - Result := Result + MPH_UC - else - Result := Result + MPH_UC_BE - end; - end; - '<': - begin - if not FEditor.UnicodeChars then - Result := Result + - MPHTranslationDescShort - [FEditor.Translation] - else - begin - if not FEditor.UnicodeBigEndian then - Result := Result + MPH_UC_S - else - Result := Result + MPH_UC_BE_S - end; - end - else - Result := Result + '%' + S[LIntLoop]; - end; - end - else - Result := Result + S[LIntLoop]; - Inc(LIntLoop); - end; -end; - -// calculate and draw page - -procedure TMPHCanvasPrinter.Draw(const Page: integer); -begin - DrawOrCalc(False, Page); -end; - -type - // text and color attributes per character - TCellAttribute = record - Back: TColor; - Fore: TColor; - Bold: boolean; - end; - - TCellAttributes = array of TCellAttribute; - - TTextWithAttr = record - Text: WideString; - Attributes: TCellAttributes; - end; - - // calculate lines per page and/or draw page - -function TMPHCanvasPrinter.DrawOrCalc(const JustCalc: boolean; const Page: - integer): integer; - - // return one line of data - function GetOneLine(CurPosition, EndPosition: integer; const MinLen: integer): - TTextWithAttr; - - // add spacer - procedure AddSpacer(UseDefAttr: boolean = False); - begin - Result.Text := Result.Text + ' '; - SetLength(Result.Attributes, Length(Result.Attributes) + 1); - if UseDefAttr or (Length(Result.Attributes) = 1) then - with Result.Attributes[Length(Result.Attributes) - 1] do - begin - Bold := False; - Fore := FEditor.Font.Color; - Back := FEditor.Colors.Background; - end - else - Result.Attributes[Length(Result.Attributes) - 1] := - Result.Attributes[Length(Result.Attributes) - 2] - end; - - // get hex representation of data (or empty if > datasize) - function GetByteHex(CurPosition, EndPosition: integer): string; - begin - if CurPosition > EndPosition then - Result := ' ' - else - begin - if FEditor.HexLowerCase then - Result := LowerCase(IntToRadixLen(FEditor.Data[CurPosition], 16, 2)) - else - Result := UpperCase(IntToRadixLen(FEditor.Data[CurPosition], 16, 2)); - if FEditor.SwapNibbles and (Length(Result) = 2) then - Result := Result[2] + Result[1]; - end; - end; - var - LIntLoop, - LIntLoopAttr: integer; - LStrPart: string; - LWChrText: WideChar; - lBold: boolean; - lOdd: boolean; - lFore, - lBack: TColor; - begin - Application.ProcessMessages; - LStrPart := FEditor.GetOffsetString(CurPosition); - - if LStrPart <> '' then - begin - LStrPart := StringOfChar(' ', MinLen - Length(LStrPart)) + LStrPart; - if (not (pfUseBackgroundColor in FFlags)) or (pfMonochrome in FFlags) then - LStrPart := LStrPart + ':'; - LStrPart := LStrPart + ' '; - end; - - Result.Text := LStrPart; - SetLength(Result.Attributes, Length(Result.Text)); - lBold := (FEditor.Row - FEditor.FixedRows) = (CurPosition div - FEditor.BytesPerRow); - for lIntLoop := 1 to Length(Result.Text) do - with Result.Attributes[lIntLoop - 1] do - begin - Bold := lBold; - if (lIntLoop = Length(Result.Text)) or (not (pfUseBackgroundColor in - FFlags)) then - begin - if (lIntLoop = Length(Result.Text)) and (pfUseBackgroundColor in - FFlags) then - Bold := False; - Fore := FEditor.Font.Color; - Back := FEditor.Colors.Background; - end - else - begin - if lBold then - begin - if (pfUseBackgroundColor in FFlags) and not (pfMonochrome in FFlags) - then - Bold := False; - Fore := FEditor.Colors.CurrentOffset; - Back := FEditor.Colors.CurrentOffsetBackground; - end - else - begin - Fore := FEditor.Colors.Offset; - Back := FEditor.Colors.OffsetBackground; - end; - end; - end; - - LFore := FEditor.Colors.OddColumn; - if FEditor.InCharField then - LBack := FEditor.Colors.Background - else - lBack := FEditor.Colors.ActiveFieldBackground; - lOdd := True; - for LIntLoop := 1 to FEditor.BytesPerRow do - begin - LStrPart := GetByteHex(CurPosition - 1 + LIntLoop, EndPosition); - Result.Text := Result.Text + LStrPart; - LIntLoopAttr := Length(Result.Attributes); - SetLength(Result.Attributes, Length(Result.Attributes) + - Length(LStrPart)); - - for LIntLoopAttr := LIntLoopAttr to Pred(Length(Result.Attributes)) do - with Result.Attributes[LIntLoopAttr] do - begin - Bold := FEditor.IsSelected(CurPosition - 1 + LIntLoop); - Fore := LFore; - Back := LBack; - if FEditor.ByteChanged[CurPosition - 1 + LIntLoop] then - begin - Fore := FEditor.Colors.ChangedText; - Back := FEditor.Colors.ChangedBackGround; - end; - - end; - - if LIntLoop < FEditor.BytesPerRow then - begin - - if (FEditor.BytesPerBlock > 1) and ((LIntLoop mod FEditor.BytesPerBlock) - = 0) then - AddSpacer; - - if (LIntLoop mod FEditor.BytesPerColumn) = 0 then - begin - AddSpacer; - lOdd := not lOdd; - if lOdd then - begin - LFore := FEditor.Colors.OddColumn; - if FEditor.InCharField then - LBack := FEditor.Colors.Background - else - lBack := FEditor.Colors.ActiveFieldBackground; - end - else - begin - LFore := FEditor.Colors.EvenColumn; - if FEditor.InCharField then - LBack := FEditor.Colors.Background - else - lBack := FEditor.Colors.ActiveFieldBackground; - end; - end; - end; - end; - - AddSpacer(True); - AddSpacer(True); - - if not FEditor.UnicodeChars then - begin - for LIntLoop := 1 to FEditor.BytesPerRow do - begin - if (CurPosition + LIntLoop - 1) > EndPosition then - Result.Text := Result.Text + ' ' - else - Result.Text := Result.Text + - FEditor.TranslateToAnsiChar(FEditor.Data[CurPosition + LIntLoop - - 1]); - - SetLength(Result.Attributes, Length(Result.Attributes) + 1); - - with Result.Attributes[Pred(Length(Result.Attributes))] do - begin - Bold := FEditor.IsSelected(CurPosition - 1 + LIntLoop); - if FEditor.ByteChanged[CurPosition - 1 + LIntLoop] then - begin - Fore := FEditor.Colors.ChangedText; - Back := FEditor.Colors.ChangedBackGround; - end - else - begin - Fore := FEditor.Font.Color; - if not FEditor.InCharField then - Back := FEditor.Colors.Background - else - Back := FEditor.Colors.ActiveFieldBackground; - end; - - end; - - if LIntLoop < FEditor.BytesPerRow then - begin - if (FEditor.BytesPerBlock > 1) and FEditor.SeparateBlocksInCharField and - ((LIntLoop mod FEditor.BytesPerBlock) = 0) then - AddSpacer; - - if (FEditor.UsedRulerBytesPerUnit <> 1) and - ((LIntLoop mod FEditor.UsedRulerBytesPerUnit) = 0) then - AddSpacer; - end; - end; - end - else - for LIntLoop := 0 to Pred(FEditor.BytesPerRow) div 2 do - begin - if (CurPosition + (LIntLoop * 2)) > EndPosition then - Result.Text := Result.Text + ' ' - else - begin - FEditor.ReadBuffer(LWChrText, CurPosition + (LIntLoop * 2), 2); - if FEditor.UnicodeBigEndian then - SwapWideChar(LWChrText); - if (LWChrText < #256) and (Char(LWChrText) in FEditor.MaskedChars) - then - LWChrText := WideChar(FEditor.MaskChar); - Result.Text := Result.Text + LWChrText; - end; - - SetLength(Result.Attributes, Length(Result.Attributes) + 1); - - with Result.Attributes[Pred(Length(Result.Attributes))] do - begin - Bold := FEditor.IsSelected(CurPosition + (LIntLoop * 2)); - if FEditor.ByteChanged[CurPosition + (LIntLoop * 2)] or - FEditor.ByteChanged[(CurPosition + (LIntLoop * 2)) + 1] then - begin - Fore := FEditor.Colors.ChangedText; - Back := FEditor.Colors.ChangedBackGround; - end - else - begin - Fore := FEditor.Font.Color; - if not FEditor.InCharField then - Back := FEditor.Colors.Background - else - Back := FEditor.Colors.ActiveFieldBackground; - end; - end; - - if LIntLoop < FEditor.BytesPerRow then - begin - if (FEditor.BytesPerBlock > 1) and FEditor.SeparateBlocksInCharField - and - (((LIntLoop + 1) mod (FEditor.BytesPerBlock div 2)) = 0) then - AddSpacer; - - if (FEditor.UsedRulerBytesPerUnit <> 2) and (((LIntLoop * 2) mod - FEditor.UsedRulerBytesPerUnit) = 0) then - AddSpacer; - end; - end; - end; - - // return ruler line - function GetRulerLine(MinLen: integer): TTextWithAttr; - - // add spacer - procedure AddSpacer; - begin - Result.Text := Result.Text + ' '; - SetLength(Result.Attributes, Length(Result.Attributes) + 1); - with Result.Attributes[Length(Result.Attributes) - 1] do - begin - Bold := False; - Fore := FEditor.Colors.Offset; - Back := FEditor.Colors.OffsetBackground; - end - end; - - var - LIntLoop: integer; - LStrPart: string; - lBold: boolean; - begin - Application.ProcessMessages; - - if MinLen > 0 then - begin - LStrPart := StringOfChar(' ', MinLen); - if (not (pfUseBackgroundColor in FFlags)) or (pfMonochrome in FFlags) then - LStrPart := LStrPart + ' '; - LStrPart := LStrPart + ' '; - end; - - Result.Text := LStrPart; - SetLength(Result.Attributes, Length(Result.Text)); - for lIntLoop := 1 to Length(Result.Text) do - with Result.Attributes[lIntLoop - 1] do - begin - Fore := FEditor.Colors.Offset; - Back := FEditor.Colors.OffsetBackGround; - end; - - for lIntLoop := 1 to Length(FEditor.FRulerString) do - begin - Result.Text := Result.Text + FEditor.FRulerString[lIntLoop]; - SetLength(Result.Attributes, Succ(Length(Result.Attributes))); - lBold := (FEditor.Col - 1) = lIntLoop; - with Result.Attributes[Pred(Length(Result.Attributes))] do - begin - Bold := lBold; - if (lIntLoop = Length(Result.Text)) or (not (pfUseBackgroundColor in - FFlags)) then - begin - if (lIntLoop = Length(Result.Text)) and (pfUseBackgroundColor in - FFlags) then - Bold := False; - Fore := FEditor.Font.Color; - Back := FEditor.Colors.Background; - end - else - begin - if lBold then - begin - if (pfUseBackgroundColor in FFlags) and not (pfMonochrome in FFlags) - then - Bold := False; - Fore := FEditor.Colors.CurrentOffset; - Back := FEditor.Colors.CurrentOffsetBackground; - end - else - begin - Fore := FEditor.Colors.Offset; - Back := FEditor.Colors.OffsetBackground; - end; - end; - end; - if lIntLoop <> Length(FEditor.FRulerString) then - begin - if (FEditor.BytesPerBlock > 1) and ((LIntLoop mod (FEditor.BytesPerBlock * - 2)) = 0) then - AddSpacer; - if (LIntLoop mod (FEditor.BytesPerColumn * 2)) = 0 then - AddSpacer; - end; - end; - - AddSpacer; AddSpacer; - - for lIntLoop := 1 to Length(FEditor.FRulerCharString) do - begin - Result.Text := Result.Text + FEditor.FRulerCharString[lIntLoop]; - SetLength(Result.Attributes, Succ(Length(Result.Attributes))); - lBold := (FEditor.Col - 2 - (FEditor.BytesPerRow * 2)) = lIntLoop; - with Result.Attributes[Pred(Length(Result.Attributes))] do - begin - Bold := lBold; - if (lIntLoop = Length(Result.Text)) or (not (pfUseBackgroundColor in - FFlags)) then - begin - if (lIntLoop = Length(Result.Text)) and (pfUseBackgroundColor in - FFlags) then - Bold := False; - Fore := FEditor.Font.Color; - Back := FEditor.Colors.Background; - end - else - begin - if lBold then - begin - if (pfUseBackgroundColor in FFlags) and not (pfMonochrome in FFlags) - then - Bold := False; - Fore := FEditor.Colors.CurrentOffset; - Back := FEditor.Colors.CurrentOffsetBackground; - end - else - begin - Fore := FEditor.Colors.Offset; - Back := FEditor.Colors.OffsetBackground; - end; - end; - end; - if lIntLoop <> Length(FEditor.FRulerCharString) then - begin - if not FEditor.UnicodeChars then - begin - if (FEditor.BytesPerBlock > 1) and FEditor.SeparateBlocksInCharField and - ((LIntLoop mod FEditor.BytesPerBlock) = 0) then - AddSpacer; - - if (FEditor.UsedRulerBytesPerUnit <> 1) and - ((LIntLoop mod FEditor.UsedRulerBytesPerUnit) = 0) then - AddSpacer; - end - else - begin - if (FEditor.BytesPerBlock > 1) and FEditor.SeparateBlocksInCharField - and - ((LIntLoop mod (FEditor.BytesPerBlock div 2)) = 0) then - AddSpacer; - - if (FEditor.UsedRulerBytesPerUnit <> 2) and ((((LIntLoop-1) * 2) mod - FEditor.UsedRulerBytesPerUnit) = 0) then - AddSpacer; - end; - end; - end; - end; - - // render a header to the canvas - procedure DrawHeader(const LeftPos, Y, RightPos: integer; StrText: string); - var - LStrLeft, LStrCenter, LStrRight: string; - LIntPipe, LIntOldBKMode, LIntOldAlign: integer; - begin - LStrLeft := ''; - LStrCenter := ''; - LStrRight := ''; - LIntPipe := Pos('|', StrText); - if LIntPipe > 0 then - begin - LStrLeft := Copy(StrText, 1, LIntPipe - 1); - Delete(StrText, 1, LIntPipe); - LIntPipe := Pos('|', StrText); - if LIntPipe > 0 then - begin - LStrCenter := Copy(StrText, 1, LIntPipe - 1); - Delete(StrText, 1, LIntPipe); - if StrText <> '' then - LStrRight := StrText; - end - else - LStrCenter := StrText; - end - else - LStrLeft := StrText; - - LIntOldAlign := GetTextAlign(FCanvas.Handle); - LIntOldBKMode := GetBKMode(FCanvas.Handle); - try - SetBKMode(FCanvas.Handle, TRANSPARENT); - if LStrLeft <> '' then - begin - SetTextAlign(FCanvas.Handle, TA_TOP or TA_LEFT); - TextOut(FCanvas.Handle, LeftPos, Y, PChar(LStrLeft), - Length(LStrLeft)); - end; - if LStrCenter <> '' then - begin - SetTextAlign(FCanvas.Handle, TA_TOP or TA_CENTER); - TextOut(FCanvas.Handle, LeftPos + ((RightPos - LeftPos) div 2), Y, - PChar(LStrCenter), Length(LStrCenter)); - end; - if LStrRight <> '' then - begin - SetTextAlign(FCanvas.Handle, TA_TOP or TA_RIGHT); - TextOut(FCanvas.Handle, RightPos, Y, PChar(LStrRight), - Length(LStrRight)); - end; - finally - SetTextAlign(FCanvas.Handle, LIntOldAlign); - SetBKMode(FCanvas.Handle, LIntOldBKMode); - end; - end; -var - LfntTemp: TFont; - LRecTextAttr: TTextWithAttr; - LIntWidth, - LIntHeight, - LIntDataPos, - LIntLeft, - LIntY, - LIntMaxY, - LIntDataEnd, - LIntDataStart: integer; - LclrFSave: TColor; - LclrBSave: TColor; - LfstSave: TFontStyles; - LIntLoop: integer; - LIntMinWidth: integer; - LRectOut: TRect; -begin - FPrintHeaders[0] := BuildHeader(FHeaders[0], Page); - FPrintHeaders[1] := BuildHeader(FHeaders[1], Page); - Result := -1; - if (not Assigned(FEditor)) or (FEditor.DataSize < 1) then - Exit; - - LIntMinWidth := Length(FEditor.GetOffsetString(FEditor.DataSize)); - - if (not JustCalc) and (FLinesPerPage < 1) then - Exit; - - if (pfSelectionOnly in FFlags) and (FEditor.SelCount > 0) then - begin - LIntDataEnd := FEditor.SelEnd; - LIntDataStart := FEditor.SelStart; - if LIntDataStart > LIntDataEnd then - begin - LIntDataStart := FEditor.SelEnd; - LIntDataEnd := FEditor.SelStart; - end; - end - else - begin - if (pfCurrentViewOnly in FFlags) then - begin - LIntDataStart := FEditor.DisplayStart; - LIntDataEnd := FEditor.DisplayEnd; - end - else - begin - LIntDataStart := 0; - LIntDataEnd := Pred(FEditor.DataSize); - end; - end; - - if not (JustCalc) then - LIntDataStart := LIntDataStart + ((Page - 1) * (fLinesPerPage * - FEditor.BytesPerRow)); - - if LIntDataStart > LIntDataEnd then - Exit; - - Result := 0; -// länge einer zeile berechnen - LRecTextAttr := GetOneLine(LIntDataStart, LIntDataEnd, LIntMinWidth); - LfntTemp := TFont.Create; - LfntTemp.Assign(FCanvas.Font); - try - if (pfMonochrome in FFlags) or (not (pfUseBackgroundColor in FFlags)) - then - FCanvas.Brush.Color := clWhite - else - FCanvas.Brush.Color := FEditor.Colors.Background; - FCanvas.Brush.Style := bsSolid; - if (pfMonochrome in FFlags) then - FCanvas.Font.Color := clBlack - else - FCanvas.Font.Color := FEditor.Font.Color; - if not JustCalc then - FCanvas.FillRect(FMargins); - LIntWidth := FCanvas.TextWidth(LRecTextAttr.Text); - while (LIntWidth > (FMargins.Right - FMargins.Left)) and - (FCanvas.Font.Size - > 1) do - begin - FCanvas.Font.Size := FCanvas.Font.Size - 1; - LIntWidth := FCanvas.TextWidth(LRecTextAttr.Text); - end; - - LIntHeight := FCanvas.TextHeight(LRecTextAttr.Text); - - LIntDataPos := LIntDataStart; - LIntY := FMargins.Top; - LIntMaxY := FMargins.Bottom; - FPrintHeaders[0] := BuildHeader(FHeaders[0], Page); - FPrintHeaders[1] := BuildHeader(FHeaders[1], Page); - if FPrintHeaders[0] <> '' then - begin - if not JustCalc then - begin - DrawHeader(FMargins.Left, LIntY, FMargins.Right, FPrintHeaders[0]); - FCanvas.MoveTo(FMargins.Left, LIntY + LIntHeight); - FCanvas.LineTo(FMargins.Right, LIntY + LIntHeight); - end; - LIntY := LIntY + LIntHeight + LIntHeight; - end; - - if FPrintHeaders[1] <> '' then - LIntMaxY := LIntMaxY - LIntHeight; - - if (pfIncludeRuler in FFlags) and FEditor.ShowRuler then - begin - if not JustCalc then - begin - LRecTextAttr := GetRulerLine(LIntMinWidth); - - LclrFSave := FCanvas.Font.Color; - LclrBSave := FCanvas.Brush.Color; - LfstSave := FCanvas.Font.Style; - LIntLeft := FMargins.Left; - for LIntLoop := 1 to Length(LRecTextAttr.Text) do - begin - if not (pfMonochrome in FFlags) then - begin - FCanvas.Font.Color := LRecTextAttr.Attributes[LIntLoop - - 1].Fore; - if pfUseBackgroundColor in FFlags then - FCanvas.Brush.Color := LRecTextAttr.Attributes[LIntLoop - - 1].Back - else - if LRecTextAttr.Attributes[LIntLoop - 1].Fore = clWhite then - FCanvas.Font.Color := clBlack; - end; - - if FFlags * [pfSelectionBold, pfSelectionOnly] = [pfSelectionBold] - then - begin - if FFlags * [pfMonochrome, pfUseBackgroundColor] = - [pfUseBackGroundColor] then - begin - FCanvas.Font.Style := []; - if LRecTextAttr.Attributes[LIntLoop - 1].Bold then - begin - FCanvas.Font.Color := ColorToRGB(FCanvas.Font.Color) xor - $FFFFFF; - FCanvas.Brush.Color := ColorToRGB(FCanvas.Brush.Color) xor - $FFFFFF; - end; - end - else - begin - if LRecTextAttr.Attributes[LIntLoop - 1].Bold then - FCanvas.Font.Style := [fsBold] - else - FCanvas.Font.Style := []; - end; - end; - - LRectOut := Rect(LIntLeft, LIntY, LIntLeft + - FCanvas.TextWidth('w'), - LIntY + LIntHeight); - if (not (pfUseBackgroundColor in FFlags)) or (pfMonochrome in - FFlags) then - LRectOut.Bottom := LIntY + (LIntHeight * 3 div 2); - ExtTextOutW(FCanvas.Handle, LIntLeft, LIntY, ETO_CLIPPED or - ETO_OPAQUE, @LRectOut, @LRecTextAttr.Text[LIntLoop], - 1, nil); - if (not (pfUseBackgroundColor in FFlags)) or (pfMonochrome in - FFlags) then - begin - FCanvas.MoveTo(LRectOut.Left, LIntY + LIntHeight + 1); - FCanvas.LineTo(LRectOut.Right + 1, LIntY + LIntHeight + 1); - end; - LIntLeft := LRectOut.Right; - end; - FCanvas.Font.Color := LclrFSave; - FCanvas.Brush.Color := LclrBSave; - FCanvas.Font.Style := LfstSave; - - LRecTextAttr := GetOneLine(LIntDataStart, LIntDataEnd, - LIntMinWidth); - end; - if (not (pfUseBackgroundColor in FFlags)) or (pfMonochrome in FFlags) - then - LIntY := LIntY + (LIntHeight * 3 div 2) - else - LIntY := LIntY + LIntHeight; - end; - - while (LIntHeight + LIntY) <= LIntMaxY do - begin - if not JustCalc then - begin - LclrFSave := FCanvas.Font.Color; - LclrBSave := FCanvas.Brush.Color; - LfstSave := FCanvas.Font.Style; - LIntLeft := FMargins.Left; - for LIntLoop := 1 to Length(LRecTextAttr.Text) do - begin - if not (pfMonochrome in FFlags) then - begin - FCanvas.Font.Color := LRecTextAttr.Attributes[LIntLoop - - 1].Fore; - if pfUseBackgroundColor in FFlags then - FCanvas.Brush.Color := LRecTextAttr.Attributes[LIntLoop - - 1].Back - else - if LRecTextAttr.Attributes[LIntLoop - 1].Fore = clWhite then - FCanvas.Font.Color := clBlack; - end; - - if FFlags * [pfSelectionBold, pfSelectionOnly] = [pfSelectionBold] - then - begin - if FFlags * [pfMonochrome, pfUseBackgroundColor] = - [pfUseBackGroundColor] then - begin - FCanvas.Font.Style := []; - if LRecTextAttr.Attributes[LIntLoop - 1].Bold then - begin - FCanvas.Font.Color := ColorToRGB(FCanvas.Font.Color) xor - $FFFFFF; - FCanvas.Brush.Color := ColorToRGB(FCanvas.Brush.Color) xor - $FFFFFF; - end; - end - else - begin - if LRecTextAttr.Attributes[LIntLoop - 1].Bold then - FCanvas.Font.Style := [fsBold] - else - FCanvas.Font.Style := []; - end; - end; - - LRectOut := Rect(LIntLeft, LIntY, LIntLeft + - FCanvas.TextWidth('w'), - LIntY + LIntHeight); - ExtTextOutW(FCanvas.Handle, LIntLeft, LIntY, ETO_CLIPPED or - ETO_OPAQUE, @LRectOut, @LRecTextAttr.Text[LIntLoop], - 1, nil); - LIntLeft := LRectOut.Right; - end; - FCanvas.Font.Color := LclrFSave; - FCanvas.Brush.Color := LclrBSave; - FCanvas.Font.Style := LfstSave; - end; - Inc(Result); - LIntDataPos := LIntDataPos + FEditor.BytesPerRow; - if LIntDataPos > LIntDataEnd then - begin - Break; - end; - if not JustCalc then - LRecTextAttr := GetOneLine(LIntDataPos, LIntDataEnd, LIntMinWidth); - LIntY := LIntY + LIntHeight; - end; - - if FPrintHeaders[1] <> '' then - if not JustCalc then - begin - DrawHeader(FMargins.Left, FMargins.Bottom - LIntHeight, - FMargins.Right, - FPrintHeaders[1]); - FCanvas.MoveTo(FMargins.Left, FMargins.Bottom - LIntHeight); - FCanvas.LineTo(FMargins.Right, FMargins.Bottom - LIntHeight); - end; - - finally - FCanvas.Font.Assign(LfntTemp); - LfntTemp.Free; - end; -end; - -// count number of lines per page (as well as number of pages) - -function TMPHCanvasPrinter.GetLinesPerPage: integer; -var - LIntSize: integer; - LSetTempFlags: TMPHPrintFlags; -begin - LSetTempFlags := FFlags; - Exclude(FFlags, pfSelectionOnly); - try - Result := DrawOrCalc(True, 1); - finally - FFlags := LSetTempFlags; - end; - FLinesPerPage := Result; - if pfSelectionOnly in FFlags then - LIntSize := Abs(FEditor.SelStart - FEditor.SelEnd) - else if pfCurrentViewOnly in FFlags then - begin - LIntSize := Abs(FEditor.DisplayEnd - FEditor.DisplayStart); - end - else - LIntSize := FEditor.DataSize; - - while (LIntSize mod FEditor.BytesPerRow) <> 0 do - Inc(LIntSize); - LIntSize := LIntSize div FEditor.BytesPerRow; - while (LIntSize mod FLinesPerPage) <> 0 do - Inc(LIntSize); - FPages := LIntSize div FLinesPerPage; -end; - -{ TMPHPrintOptions } - -// init - -constructor TMPHPrintOptions.Create; -begin - inherited; - FMargins := MPH_DEF_PRINT_MARGINS; - FFlags := [pfMonochrome, pfSelectionBold]; -end; - -// copy props - -procedure TMPHPrintOptions.Assign(Source: TPersistent); -begin - inherited; - if Source is TMPHPrintOptions then - with TMPHPrintOptions(Source) do - begin - self.FMargins := FMargins; - self.FHeaders := FHeaders; - self.FFlags := FFlags; - end; -end; - -// header/footer - -function TMPHPrintOptions.GetHeader(const Index: integer): string; -begin - Result := FHeaders[Index]; -end; - -// margin (mm) - -function TMPHPrintOptions.GetMargin(const Index: integer): integer; -begin - case Index of - 1: Result := FMargins.Left; - 2: Result := FMargins.Top; - 3: Result := FMargins.Right; - else - Result := FMargins.Bottom; - end; -end; - -// set haeder/footer - -procedure TMPHPrintOptions.SetHeader(const Index: integer; const Value: - string); -begin - FHeaders[Index] := Value; -end; - -// set margin (mm) - -procedure TMPHPrintOptions.SetMargin(const Index, Value: integer); -begin - case Index of - 1: FMargins.Left := Value; - 2: FMargins.Top := Value; - 3: FMargins.Right := Value; - else - FMargins.Bottom := Value; - end; -end; - -{ TFormatSelDialog } - -// ok on list doubleclick - -procedure TFormatSelDialog.ListDoubleClick(Sender: TObject); -begin - ModalResult := mrOk; -end; - -// enable checkbox if cf_text or cf_oemtext - -procedure TFormatSelDialog.ListSelect(Sender: TObject); -begin - with LlbxFormats do - LcbxTextAsHex.Enabled := (ItemIndex > -1) and - (TClipFormat(Items.Objects[ItemIndex]) in [CF_TEXT, CF_OEMTEXT]) -end; - -initialization -// register clip formats -OleInitialize(nil); -CF_MPHEXEDITOR := RegisterClipboardFormat(PChar(MPTH_CF)); -CF_REGEDIT_HEXDATA := RegisterClipboardFormat(CFSTR_REGEDIT_HEXDATA); -CF_RTF := RegisterClipboardFormat(CFSTR_RTF); -CF_HTML := RegisterClipboardFormat(CFSTR_HTML); -CF_FILECONTENTS := RegisterClipboardFormat(CFSTR_FILECONTENTS); -CF_FILEDESCRIPTOR := RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR); -CF_PERFORMEDDROPEFFECT := RegisterClipboardFormat(CFSTR_PERFORMEDDROPEFFECT); -CF_LOGICALPERFORMEDDROPEFFECT := - RegisterClipboardFormat(CFSTR_LOGICALPERFORMEDDROPEFFECT); - -finalization - OleUninitialize; -end. - diff --git a/hexcontrol/mphexeditorreg.pas b/hexcontrol/mphexeditorreg.pas deleted file mode 100644 index 4c6ed18..0000000 --- a/hexcontrol/mphexeditorreg.pas +++ /dev/null @@ -1,120 +0,0 @@ -unit MPHexEditorReg; - -{$I MPDELVER.INC} - -(********************************************************************************************** -* * -* TMPHexEditor v 12-29-2004 * -* * -* (C) markus stephany, vcl[at]mirkes[dot]de, all rights reserverd. * -* * -* IDE Registration Unit for TMPHexEditor and TMPHexEditorEx * -* * -**********************************************************************************************) - -interface - -uses - Classes, MPHexEditor, MPHexEditorEx{$IFDEF DELPHI6UP}, DesignIntf, - DesignEditors{$ELSE}, dsgnintf{$ENDIF}; - -type - TBytesPerUnitProperty = class(TIntegerProperty) - public - function GetAttributes: TPropertyAttributes; override; - procedure GetValues(Proc: TGetStrProc); override; - end; - - TRulerNumberBaseProperty = class(TIntegerProperty) - public - function GetAttributes: TPropertyAttributes; override; - procedure GetValues(Proc: TGetStrProc); override; - end; - -procedure Register; - -implementation -uses - SysUtils; - -procedure Register; -begin - RegisterComponents('mirkes.de', [TMPHexEditor, TMPHexEditorEx]); - RegisterPropertyEditor(TypeInfo(Integer), TCustomMPHexEditor, 'BytesPerUnit', - TBytesPerUnitProperty); - RegisterPropertyEditor(TypeInfo(Byte), TCustomMPHexEditor, 'RulerNumberBase', - TRulerNumberBaseProperty); -{$IFDEF DELPHI6UP} - RegisterPropertiesInCategory(sVisualCategoryName, TCustomMPHexEditor, - ['DrawGridLines', 'Colors', 'CaretStyle', 'BytesPerRow', 'FocusFrame', - 'BytesPerColumn', - 'GraySelectionIfNotFocused', 'MaskChar', 'OffsetFormat', 'ReadOnlyView', - 'HexLowerCase', 'ZoomOnWheel', 'DrawGutter3D', 'ShowRuler', - 'GutterWidth', 'HideSelection', 'PrintOptions', 'ScrollBars', - 'Translation', 'SeparateBlocksInCharField', - 'BytesPerUnit', 'CaretKind', 'RulerBytesPerUnit', 'BytesPerBlock', - 'ShowPositionIfNotFocused', 'UnicodeChars', 'UnicodeBigEndian', - 'RulerNumberBase']); - RegisterPropertyInCategory(sDragNDropCategoryName, TCustomMPHexEditor, - 'OleDragDrop'); - RegisterPropertyInCategory(sInputCategoryName, TCustomMPHexEditor, - 'OnInvalidKey'); -{$ENDIF} -end; - -{ TBytesPerUnitProperty } - -type - TInt_Hexer = class(TCustomMPHexEditor); // propagate protected properties - -function TBytesPerUnitProperty.GetAttributes: TPropertyAttributes; -var - bRO: boolean; - i: integer; -begin - bRo := False; - if PropCount > 0 then - for i := 0 to Pred(PropCount) do - begin - if GetComponent(i) is TCustomMPHexEditor then - if TInt_Hexer(GetComponent(i)).UnicodeChars then - begin - bRO := True; - Break; - end; - end; - - Result := [paValueList, paSortList, paRevertable, paMultiSelect]; - if bRO then - Include(Result, paReadOnly); -end; - -procedure TBytesPerUnitProperty.GetValues(Proc: TGetStrProc); -begin - if not (paReadOnly in GetAttributes) then // unicode? no. - begin - Proc('1'); - Proc('2'); - Proc('4'); - Proc('8'); - end - else - Proc('2'); // unicode -end; - -function TRulerNumberBaseProperty.GetAttributes: TPropertyAttributes; -begin - Result := [paValueList, paRevertable, paMultiSelect]; -end; - -procedure TRulerNumberBaseProperty.GetValues(Proc: TGetStrProc); -var - i: integer; -begin - for i := 2 to 16 - do - Proc(IntToStr(i)); -end; - -end. - diff --git a/resources/icons/dish.bmp b/resources/icons/dish.bmp new file mode 100644 index 0000000..f032673 Binary files /dev/null and b/resources/icons/dish.bmp differ diff --git a/resources/icons/dish.gif b/resources/icons/dish.gif new file mode 100644 index 0000000..8e9718d Binary files /dev/null and b/resources/icons/dish.gif differ diff --git a/resources/icons/dish2.bmp b/resources/icons/dish2.bmp new file mode 100644 index 0000000..147e923 Binary files /dev/null and b/resources/icons/dish2.bmp differ diff --git a/resources/icons/dump_fourth.bmp b/resources/icons/dump_fourth.bmp new file mode 100644 index 0000000..be03d61 Binary files /dev/null and b/resources/icons/dump_fourth.bmp differ diff --git a/resources/icons/dump_half.bmp b/resources/icons/dump_half.bmp new file mode 100644 index 0000000..ad00596 Binary files /dev/null and b/resources/icons/dump_half.bmp differ diff --git a/resources/icons/tf-1377.bmp b/resources/icons/tf-1377.bmp new file mode 100644 index 0000000..29978d4 Binary files /dev/null and b/resources/icons/tf-1377.bmp differ diff --git a/resources/xheader.bmp b/resources/xheader.bmp deleted file mode 100644 index 90ee2b3..0000000 Binary files a/resources/xheader.bmp and /dev/null differ diff --git a/resources/xwmark.bmp b/resources/xwmark.bmp deleted file mode 100644 index 3b12e7c..0000000 Binary files a/resources/xwmark.bmp and /dev/null differ diff --git a/src/AppGlobal.pas b/src/AppGlobal.pas deleted file mode 100644 index a65b9c6..0000000 --- a/src/AppGlobal.pas +++ /dev/null @@ -1,203 +0,0 @@ -unit AppGlobal; - -interface - -uses Tool, LogStream, Classes, Clipbrd, SysUtils, StrUtils, IdGlobal, XBOXManager; - -{ type TMemSect = record - Offset,Size,Flags,Loc:Cardinal; - end; } - - type TParsedParams = record - Key:TStringList; - Value:TStringList; - end; - - type TStatus = (stNorm,stDump,stBreak,stGetXBEInfo,stGetContext); - - function ConvPC2XBOX(PCOffset:Cardinal;XBOXOffset:PCardinal):Integer; - function ConvXBOX2PC(XBOXOffset:Cardinal;Section:PInteger;PCOffset:PCardinal):Integer; - function ConvError(Err:Integer):String; - function TextToClip(Text:String):Boolean; - function MakeOffset(const AString:String):String; - function ParseParams(const AInput:String):TParsedParams; - -const - EConvOkay = 0; - EConvNotFound = -1; - EConvBadPointer = -2; - EConvOutOfRange = -3; - EConvNoSections = -4; - -var - Tools: array of TTool; -// Sections: array of TMemSect; -// MemBuffer:TMemoryStream; - Log:TLogStream; - ProgStatus:TStatus; - DebugBox:TXBOX; - -implementation - -function ParseParams(const AInput:String):TParsedParams; -begin - {202- multiline response follows - timestamp=0x40d52299 checksum=0x00000000 - name="E:\UnleashX\default.xbe" - .} - -end; - -function MakeOffset(const AString:String):String; -var -XPos:Integer; -NewString:String; -PadStr:String; -begin - Result := '0x00000000'; - NewString := Uppercase(AString); - NewString := AnsiReplaceText(NewString,' ',''); - - XPos := AnsiPos('0X',NewString); - - if (XPos < 0) then - NewString := '0x' + NewString - else if (XPos > 1) then - NewString := AnsiRightStr(NewString,Length(NewString) - XPos+1); - - if (Length(NewString) > 10) then - SetLength(NewString,10) - else if Length(NewString) < 10 then - begin - for XPos := 0 to (10 - Length(NewString) - 2) do - PadStr := PadStr + '0'; - NewString := StuffString(NewString,3,0,PadStr); - end; - -// if(IsHexidecimal(NewString)) then -{TODO: Fix this so it will check for valid hex} - Result := NewString - -end; - -function ConvXBOX2PC(XBOXOffset:Cardinal;Section:PInteger;PCOffset:PCardinal):Integer; -var -Count:Integer; -begin - if not Assigned(PCOffset) then - begin - Result := EConvBadPointer; - Exit; - end; - -with DebugBox.Memory do -begin - if(Length(Sections) <= 0) then - begin - Result := EConvNoSections; - Exit; - end; - - if(XBOXOffset < Sections[Low(Sections)].Offset) or - (XBOXOffset > (Sections[High(Sections)].Offset + Sections[High(Sections)].Size)) then - begin - Result := EConvOutOfRange; - Exit; - end; - - for Count := Low(Sections) to High(Sections) do - begin - with Sections[Count] do - begin - if (XBOXOffset < Offset) or (XBOXOffset > (Offset+Size)) then Continue; - - if Assigned(Section) then Section^ := Count; - - if Assigned(PCOffset) then - PCOffset^ := Cardinal(DebugBox.Memory.Buffer.Memory) + Loc - Size + XBOXOffset - Offset; -// PCOffset^ := Cardinal(MemBuffer.Memory) + Loc - Size + (XBOXOffset - Offset); - Result := EConvOkay; - Exit; - end; - end; - Result := EConvNotFound; -end; -end; - -function ConvPC2XBOX(PCOffset:Cardinal;XBOXOffset:PCardinal):Integer; -var -Pos:Integer; -Base:Cardinal; -begin - if not Assigned(XBOXOffset) then - begin - Result := EConvBadPointer; - Exit; - end; - -// if (PCOffset < Cardinal(MemBuffer.Memory)) or -// (PCOffset > (Cardinal(MemBuffer.Memory) + MemBuffer.Size)) then - if (PCOffset < Cardinal(DebugBox.Memory.Buffer.Memory)) or - (PCOffset > (Cardinal(DebugBox.Memory.Buffer.Memory) + DebugBox.Memory.Buffer.Size)) then - begin - Result := EConvOutOfRange; - Exit; - end; - -with DebugBox.Memory do -begin - for Pos := High(Sections) downto Low(Sections) do - begin -// Base := Cardinal(MemBuffer.Memory) + Sections[Pos].Loc; - Base := Cardinal(DebugBox.Memory.Buffer.Memory) + Sections[Pos].Loc; - if ( (PCOffset >= (Base - Sections[Pos].Size)) and (PCOffset < Base) ) then - begin - Result := EConvOkay; - if Assigned(XBOXOffset) then - XBOXOffset^ := Sections[Pos].Offset + - (PCOffset - -// Cardinal(MemBuffer.Memory) - - Cardinal(DebugBox.Memory.Buffer.Memory) - - (Sections[Pos].Loc - - Sections[Pos].Size)); - Exit; - end; - end; -end; - Result := EConvNotFound; -end; - -function ConvError(Err:Integer):String; -begin - case Err of - EConvOutOfRange: Result := 'Offset was not found in the buffer range. Check the log to see if the buffer has jumped around. If it hasn''t check and make sure you are putting the correct address. Also, make sure you are searching the correct memory ranges with your search application.'; - EConvNotFound: Result := 'The offset was found in the buffer range, but it was not found inside of any of the memory sections that are saved. This could be a mathematical mistake, or some other coding problem. It shouldn''t be caused by anything you did.'; - EConvBadPointer: Result := 'The pointer supplied for returning the offset in was empty. No offset was returned.'; - EConvNoSections: Result := 'There are no saved memory sections. Are you connected?'; - EConvOkay: Result := 'Everything went okay.'; - else - Result := 'An unknown error occured while trying to convert the offset.'; - end; - - -end; - -function TextToClip(Text:String):Boolean; -var - Clipboard:TClipboard; -begin - Result := false; - try - Clipboard := TClipboard.Create; - if Assigned(Clipboard) then - begin - Clipboard.AsText := Text; - FreeAndNil(Clipboard); - Result := true; - end; - except - on E: Exception do Result := false; - end; -end; - -end. diff --git a/src/AppStrings.pas b/src/AppStrings.pas new file mode 100644 index 0000000..63d1ee5 --- /dev/null +++ b/src/AppStrings.pas @@ -0,0 +1,46 @@ +unit AppStrings; + +interface + + const + DEFAULT_IP = '192.168.1.101'; + + EOM_PATTERN = #13#10 + '.' + #13#10; + + NON_EMPTY_INPUT = 'bytes still on input buffer.'; + INVALID_LOG_TYPE = 'Invalid message type passed to OnNewLog.'; + + BYE = 'BYE'; + + PROT_CONNECTED = '201- connected'; + PROT_OK = '200- OK'; + PROT_BYE = '202- bye'; + PROT_MULTILINE = '202- multiline response follows'; + PROT_VIRTUAL = '202- Valid Virtual Address Ranges Follow'; + PROT_BINARY = '203- binary response follows'; + PROT_UNKNOWN_CMD = '407- unknown command'; + + GETMEM2_FULL = 'GETMEM2 ADDR=0x%.8x LENGTH=0x%.8x'; + + REBOOT_WARM_TAG = 'WARM'; + REBOOT_WAIT_TAG = 'WAIT'; + REBOOT_STOP_TAG = 'STOP'; + REBOOT_NODEBUG_TAG = 'NODEBUG'; + REBOOT_DEBUG_TAG = 'DEBUG'; + REBOOT_HEADER = 'REBOOT%s'; + REBOOT_MAGICBOOT = 'magicboot title=%s%s'; + + NOTIFYAT = 'NOTIFYAT PORT='; + NOTIFYAT_DROP = 'DROP'; + + DEBUGGER = 'DEBUGGER'; + DEBUGGER_CONNECT = 'CONNECT'; + DEBUGGER_DISCONNECT = 'DISCONNECT'; + + VIRTUAL_ADDRESS_BASE = 'base='; + VIRTUAL_ADDRESS_SIZE = 'size='; + VIRTUAL_ADDRESS_PROTECT = 'protect='; + +implementation + +end. diff --git a/src/Breakpoint.pas b/src/Breakpoint.pas deleted file mode 100644 index 6b16cd2..0000000 --- a/src/Breakpoint.pas +++ /dev/null @@ -1,47 +0,0 @@ -unit Breakpoint; - -interface - -uses SysUtils; - -type TBPTypes = (Read,Write,Addr,Execute); - -type - TBreakpoint = record - Enabled:Boolean; - Offset: Cardinal; - Size: Cardinal; - BPType:TBPTypes; - Desc: String; -end; - -function LocateBreakpoint(fBreak:TBreakpoint):Integer; - -var - Breakpoints: array of TBreakpoint; - -implementation - -function LocateBreakpoint(fBreak:TBreakpoint):Integer; -var -Counter:Integer; -begin - Result := -1; - if Length(Breakpoints) <= 0 then - begin - Result := -1; - Exit; - end; - - for Counter := Low(Breakpoints) to High(Breakpoints) do - begin - if CompareMem(@fBreak,@Breakpoints[Counter],SizeOf(TBreakpoint)) then - begin - Result := Counter; - Break; - end; - end; - -end; - -end. diff --git a/src/CXBreakpointManager.pas b/src/CXBreakpointManager.pas new file mode 100644 index 0000000..d784f16 --- /dev/null +++ b/src/CXBreakpointManager.pas @@ -0,0 +1,35 @@ +unit CXBreakpointManager; + +interface + +type TRegisters = record + EBP,ESP,EIP,EAX,EBX,ECX,EDX,EDI,ESI,EFlags,Cr0NpxState:Cardinal; +end; + +type TBPTypes = (Read,Write,Addr,Execute); + +type TBreakpoint = record + Enabled:Boolean; //If the breakpoint is enabled or not + Offset: Cardinal; //What location the breakpoint is set on + TimesHit: Integer; //Number of times the breakpoint has been triggered + LastTriggeredBy: Cardinal; //Address that last triggered the breakpoint + TriggeredBy: Cardinal; //Address that currently triggered the breakpoint + Size: Cardinal; //Size of the breakpoint's covereage + BPType:TBPTypes; //Type of the breakpoint + Desc: String; //Description of the breakpoint + PreviousRegisters: TRegisters; //Register information at previous break + Registers:TRegisters; //Current register information +end; + +type TXBOXBreakpointManage = class + Item: array of TBreakpoint; + + {TODO 1 -cBreakpoints: Implement functions to add, remove, locate, modify breakpoints} +// function Add(); +// function Delete(); +// function IndexOf(); +end; + +implementation + +end. diff --git a/src/CXMemoryManager.pas b/src/CXMemoryManager.pas new file mode 100644 index 0000000..a1193c0 --- /dev/null +++ b/src/CXMemoryManager.pas @@ -0,0 +1,81 @@ +unit CXMemoryManager; + +interface + +uses Classes, SysUtils, StrUtils, AppStrings; + +type TMemSection = record + Offset,Size,Flags,Loc:Cardinal; +end; + + +type TXBOXMemory = class + Sections: array of TMemSection; + Buffer:TMemoryStream; + + function fillPages(strlist:TStringList):Boolean; + + constructor Create(); + destructor Free(); +end; + +implementation + +function TXBOXMemory.fillPages(strlist:TStringList):Boolean; +var +idx:Integer; +str:String; +begin +{TODO : Better result checking} + result := true; + SetLength(Sections,strlist.Count); //Size array to match number of strings + idx := 0; + + while (idx < (strList.Count - 1)) do + begin + if strlist.Count <= 0 then + begin + Result := false; + Break; + end; + + if idx < 0 then Continue; + if idx > strlist.Count-1 then Break; + + str := strlist[idx]; {TODO: Does this actually speed up the process?} + + if ( not AnsiContainsStr(LowerCase(str),VIRTUAL_ADDRESS_BASE) or + not AnsiContainsStr(LowerCase(str),VIRTUAL_ADDRESS_SIZE) or + not AnsiContainsStr(LowerCase(str),VIRTUAL_ADDRESS_PROTECT) ) then + begin + //str did not contain base, size, and protect + strlist.Delete(idx); + Dec(idx); + Continue; + end; + + //base=0xd08b2000 size=0x00540000 protect=0x00020002 + Sections[idx].Offset := StrToInt64( AnsiMidStr(str,AnsiPos(VIRTUAL_ADDRESS_BASE,str) + Length(VIRTUAL_ADDRESS_BASE),10)); + Sections[idx].Size := StrToInt64( AnsiMidStr(str,AnsiPos(VIRTUAL_ADDRESS_SIZE,str) + Length(VIRTUAL_ADDRESS_SIZE),10)); + Sections[idx].Flags := StrToInt64( AnsiMidStr(str,AnsiPos(VIRTUAL_ADDRESS_PROTECT,str) + Length(VIRTUAL_ADDRESS_PROTECT),10)); + Sections[idx].Loc := 0; + + Inc(idx); + end; + + if Length(Sections) > strlist.Count then //Had some badly formated strings, remove empty sections + SetLength(Sections,strlist.Count); +end; + +constructor TXBOXMemory.Create; +begin + {TODO -cBugs:Make sure creation went okay} + Buffer := TMemoryStream.Create; +end; + +destructor TXBOXMemory.Free; +begin + FreeAndNil(Buffer); +end; + +end. diff --git a/src/CXboxManager.pas b/src/CXboxManager.pas new file mode 100644 index 0000000..04fca06 --- /dev/null +++ b/src/CXboxManager.pas @@ -0,0 +1,249 @@ +unit CXboxManager; + +interface + +uses SysUtils,IdTCPClient,IdIPAddress,IdIOHandler,CXMemoryManager,CXBreakpointManager, + Global,IdGlobal,Classes,AppStrings,Log; + +type PIdTCPClient = ^TIdTCPClient; +type PIdIOHandler = ^TIdIOHandler; +type PTStringList = ^TSTringList; + +type TRegisters = record + EBP,ESP,EIP,EAX,EBX,ECX,EDX,EDI,ESI,EFlags,Cr0NpxState:Cardinal; +end; + +type TXBE = record + Name:String; + TimeStamp:Cardinal; + PID:Cardinal; +end; + +type TXBOX = class + IP:TIdIPAddress; //IP of the Xbox + XDKPort:Cardinal; //XDK Port + EventPort:Cardinal; //Port that the XDK sends events to + Registers:TRegisters; //XDK Register information + Memory:TXBOXMemory; //Dumped memory + XBE:TXBE; //XBE information + IsNotify:Boolean; //If Notify is currently enabled + EnableNotify:Boolean; //Notification feature is turned on + + Link:PIdTCPClient; //Pointer to the connection + + function Reboot(Flags:Cardinal;Title:String):Boolean; + function SendCmd(Cmd:String):Boolean; + function Notify(Enable:Boolean):Boolean; + function setIP(newIP:String):Boolean;overload; + function setIP(newIP:Cardinal):Boolean;overload; + + function Disconnect():Boolean; + function Connect():Boolean; + function IsConnected():Boolean; + + function getLines(strlist:PTStringList):Boolean; + procedure dumpMem(); + + constructor Create(TCPCon:PIdTCPClient); + destructor Free(); + const + _XDKPort = 731; //Default XDK port + _NotifyPort= 1500; + _rbWait = $00000001; + _rbStop = $00000002; + _rbWarm = $00000004; + _rbNoDebug = $00000008; +end; + +implementation + +procedure TXBOX.dumpMem(); +var +stream:TMemoryStream; +idx:Integer; +buf:String; +begin + stream := TMemoryStream.Create; + + Memory.Buffer.Clear; + + if Length(Memory.Sections) <= 0 then Exit; + + + for idx := 0 to High(Memory.Sections) do + begin + stream.Clear; + stream.SetSize(Memory.Sections[idx].Size); + + Link.IOHandler.WriteLn(Format(GETMEM2_FULL, + [Memory.Sections[idx].Offset, Memory.Sections[idx].Size])); + + buf := ''; + + repeat + if buf <> '' then + AppLog.addItem('Input still on buffer - ' + buf,ltWarning); + buf := Link.IOHandler.ReadLn; + until (buf = PROT_BINARY) and (IsConnected()); + + while (Cardinal(Link.IOHandler.InputBuffer.Size) < Memory.Sections[idx].Size) and + (IsConnected()) do; + + Link.IOHandler.ReadStream(stream,Memory.Sections[idx].Size); + + Memory.Buffer.CopyFrom(stream,0); + Memory.Sections[idx].Loc := Memory.Buffer.Position; + + end; + + AppLog.addItem( Format('Buffer location: 0x%.8p - 0x%.8x', [Memory.Buffer.Memory, + Cardinal(Memory.Buffer.Memory) + Memory.Buffer.Size] ), + ltNormal); + + FreeAndNil(stream); + +end; + +function TXBOX.getLines(strlist:PTStringList):Boolean; +var +buf:String; +begin +{TODO: Check to make sure connected / link is valid / strlist is valid} + Result := true; + + repeat + buf := Link.IOHandler.ReadLn; + if (buf <> '.') then + strlist.Add(buf); + until buf = '.'; +end; + +function TXBOX.setIP(newIP:String):Boolean; +begin + Result := false; + + if (isValidIP(newip)) then + begin + if (Self.IP <> nil) then FreeAndNil(Self.IP); + Self.IP := TIdIPAddress.MakeAddressObject(newip); + Result := true; + end; +end; + +function TXBOX.setIP(newIP:Cardinal):Boolean; +begin + + if (Self.IP = nil) then + begin + Self.IP := TIdIPAddress.MakeAddressObject(DEFAULT_IP); + end; + + Self.IP.IPv4 := newIP; + Result := true; +end; + +function TXBOX.Reboot(Flags:Cardinal;Title:String):Boolean; +var +Style,Send:String; +begin + if ((Flags and _rbWarm) = _rbWarm) then + Style := ' ' + REBOOT_WARM_TAG; + + if ((Flags and _rbWait) = _rbWait) then + Style := Style + ' ' + REBOOT_WAIT_TAG + else if ((Flags and _rbStop) = _rbStop) then + Style := Style + ' ' + REBOOT_STOP_TAG; + + if(Title = '') then + begin + if ((Flags and _rbNoDebug) = _rbNoDebug) then + Style := Style + ' ' + REBOOT_NODEBUG_TAG; + Send := Format(REBOOT_HEADER,[Style]); + end + else + begin + if ((Flags and _rbNoDebug) <> _rbNoDebug) then + Style := Style + ' ' + REBOOT_DEBUG_TAG; + Send := Format(REBOOT_MAGICBOOT,[Title,Style]); + end; + Result := SendCmd(Send); +end; + +function TXBOX.SendCmd(Cmd:String):Boolean; +begin + Result := false; + if (Link = nil) then Exit; + + if(not Link.Connected) then Exit; + + Link.IOHandler.WriteLn(Cmd); + Result := true; +end; + +function TXBOX.Connect():Boolean; +begin + Result := false; + if (Link = nil) then Exit; + + if (Link.Connected) then + Disconnect(); + +{TODO -cFunctionality : Link connection thread to this instead } + Link.Connect(IP.IPv4AsString,XDKPort); + +// SendCmd('DEBUGGER CONNECT'); {TODO : DEBUGGER LINE} + +// if (IsNotify) then Notify(true); + + Result := Link.Connected; +end; + +function TXBOX.IsConnected():Boolean; +begin + Result := false; + if (Link <> nil) then Result := Link.Connected; +end; + +function TXBOX.Disconnect():Boolean; +begin + Result := false; + if (IsNotify) then + Result := Result AND Notify(false); +// Result := Result AND SendCmd('DEBUGGER DISCONNECT'); {TODO : DEBUGGER LINE} + Result := Result AND SendCmd(BYE); + + if (Link <> nil) then + if (Link.Connected) then + Link.Disconnect; +end; + +function TXBOX.Notify(Enable:Boolean):Boolean; +begin + + if (Enable) then + begin + Result := SendCmd(NOTIFYAT + IntToStr(EventPort)); + end + else + begin + Result := SendCmd(NOTIFYAT + IntToStr(EventPort) + ' ' + NOTIFYAT_DROP); + end; + + IsNotify := Result; +end; + +constructor TXBOX.Create(TCPCon:PIdTCPClient); +begin + Memory := TXBOXMemory.Create; + Link := TCPCon; + IP := TIdIPAddress.MakeAddressObject(DEFAULT_IP); + XDKPort := _XDKPort; + EventPort := _NotifyPort; +end; + +destructor TXBOX.Free; +begin + FreeAndNil(Memory); + FreeAndNil(IP); +end; +end. diff --git a/src/Global.pas b/src/Global.pas new file mode 100644 index 0000000..0d725bf --- /dev/null +++ b/src/Global.pas @@ -0,0 +1,31 @@ +unit Global; + +interface + +uses IdIPAddress, SysUtils, Log; + +function IsValidIP(const Addr : String): Boolean; + +var + AppLog:TLog; + +implementation + +function IsValidIP(const Addr : String): Boolean; +var LIP : TIdIPAddress; +begin + if (Length(Addr) = 0) then + begin + Result := false; + Exit; + end; + + LIP := TIdIPAddress.MakeAddressObject(Addr); + Result := Assigned(LIP); + if Result then + begin + FreeAndNil(LIP); + end; +end; + +end. diff --git a/src/Log.pas b/src/Log.pas new file mode 100644 index 0000000..80d0bcd --- /dev/null +++ b/src/Log.pas @@ -0,0 +1,148 @@ +unit Log; + +interface + +uses Classes, SysUtils, Windows; + +type TLogType = (ltError, ltWarning, ltStatus, ltNormal, ltSystem, ltQuick ); + +type TLogMessage = record + dTimeStamp:TDateTime; + sMessage:String; + eType:TLogType; +end; + +type TLogMessageArray = array of TLogMessage; + +type TLog = class + private + msgID: Cardinal; + protected + History: TLogMessageArray; + msgWnd: HWND; + + function newItem(sMessage:String;eType:TLogType):TLogMessage; + function inBounds(iIndex:Integer):Boolean; + + public + constructor Create(msgWnd:HWND;msgID:Cardinal);overload; + procedure addItem(sMessage:String;eType:TLogType); + function getItem(iIndex:Integer):TLogMessage; + function getItems(iStart:Integer;iEnd:Integer):TLogMessageArray;overload; + function getItems(iStart:Integer;iEnd:Integer;eExclude:TLogType):TLogMessageArray;overload; + function getLastOfType(eType:TLogType):TLogMessage; + function getLast():TLogMessage; + function getCount():Integer; +end; + +implementation + +constructor TLog.Create(msgWnd:HWND;msgID:Cardinal); +begin + Self.msgWnd := msgWnd; + Self.msgID := msgID; + Self.Create(); +end; + +function TLog.newItem(sMessage: string; eType: TLogType):TLogMessage; +var +newMsg:TLogMessage; +begin + newMsg.sMessage := sMessage; + newMsg.eType := eType; + newMsg.dTimeStamp := Now(); + + Result := newMsg; +end; + +procedure TLog.addItem(sMessage: string; eType: TLogType); +var +newMsg:TLogMessage; +begin + newMsg := newItem(sMessage,eType); + + SetLength(History,Length(History)+1); + History[High(History)] := newMsg; + SendMessage(msgWnd,msgID, Integer(@History[High(History)]), Integer(eType)); +end; + +function TLog.getItem(iIndex: Integer):TLogMessage; +var +errMsg:TLogMessage; +begin + if(Low(History) > iIndex) then + begin + errMsg := newItem('Message index too low',ltError); + end + else if(High(History) < iIndex) then + begin + errMsg := newItem('Message index too high',ltError); + end + else + begin + errMsg := History[iIndex]; + end; + + Result := errMsg; +end; + +function TLog.inBounds(iIndex: Integer):Boolean; +begin + if ( (Low(History) > iIndex) or (High(History) < iIndex) )then + begin + Result := false; + end + else + begin + Result := true; + end; +end; + +function TLog.getItems(iStart: Integer; iEnd: Integer):TLogMessageArray; +var +iLoop:Integer; +begin + if (iEnd <= iStart) then iEnd := iStart+1; + if (iStart >= iEnd) then iStart := iEnd-1; + + if not inBounds(iStart) then iStart := Low(History); + if not inBounds(iEnd) then iEnd := High(History); + + SetLength(Result,iEnd-iStart); + + for iLoop := 0 to (iEnd - iStart) do + begin + if ( (iEnd-iLoop < iStart) or (iEnd-iLoop < Low(History)) ) then break; + + Result[iLoop] := History[iEnd-iLoop]; + end; +end; + +function TLog.getItems(iStart: Integer; iEnd: Integer; eExclude: TLogType):TLogMessageArray; +begin + Result := getItems(iStart,iEnd); +end; + +function TLog.getLast():TLogMessage; +begin + Result := History[High(History)]; +end; + +function TLog.getLastOfType(eType:TLogType):TLogMessage; +var +iIndex:Integer; +begin + for iIndex := High(History) downto Low(History) do + begin + if History[iIndex].eType = eType then break; + end; + + Result := History[iIndex]; +end; + +function TLog.getCount():Integer; +begin + Result := Length(History); +end; + +end. diff --git a/src/LogStream.pas b/src/LogStream.pas deleted file mode 100644 index e228ee0..0000000 --- a/src/LogStream.pas +++ /dev/null @@ -1,47 +0,0 @@ -unit LogStream; - -interface - -uses Classes,Windows; - -type TLogStream = class(TStringStream) - UpdateMsg:Cardinal; - UpdateWindow:THandle; - procedure AddLn(const AString:String); - procedure SaveToFile(const FileName:String); - constructor Create(const AString:String;Msg:Cardinal;Handle:THandle); - procedure Clear; -end; - -implementation - -constructor TLogStream.Create(const AString:String;Msg:Cardinal;Handle:THandle); -begin - inherited Create(AString); - UpdateMsg := Msg; - UpdateWindow := Handle; -// SendMessage(UpdateWindow,UpdateMsg,0,Self.Size); -end; - -procedure TLogStream.Clear; -begin - SetSize(0); -end; - -procedure TLogStream.AddLn(const AString:String); -begin - WriteString(AString + #13#10); - SendMessage(UpdateWindow,UpdateMsg,Self.Size-(Length(AString)+2),Length(AString)+2); -end; - -procedure TLogStream.SaveToFile(const FileName:String); -var -logfile:TextFile; -begin - AssignFile(logfile,FileName); - ReWrite(logfile); - WriteLn(logfile,Self.DataString); - CloseFile(logfile); - AddLn('Log saved to ' + FileName + '.'); -end; -end. diff --git a/src/Main.dfm b/src/Main.dfm deleted file mode 100644 index 7b99037..0000000 --- a/src/Main.dfm +++ /dev/null @@ -1,1724 +0,0 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'XDK Assist' - ClientHeight = 573 - ClientWidth = 715 - Color = clBtnFace - Constraints.MinHeight = 403 - Constraints.MinWidth = 489 - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - Menu = mnuMain - OldCreateOrder = False - Position = poDesktopCenter - OnClose = FormClose - OnCloseQuery = FormCloseQuery - OnCreate = FormCreate - OnDestroy = FormDestroy - DesignSize = ( - 715 - 573) - PixelsPerInch = 96 - TextHeight = 13 - object grpConsole: TGroupBox - Left = 8 - Top = 8 - Width = 707 - Height = 185 - Anchors = [akLeft, akTop, akRight] - Caption = 'Console:' - Color = clBtnFace - ParentColor = False - TabOrder = 0 - DesignSize = ( - 707 - 185) - object richLog: TRichEdit - Left = 9 - Top = 16 - Width = 688 - Height = 137 - TabStop = False - Anchors = [akLeft, akTop, akRight, akBottom] - BorderStyle = bsNone - Color = clBlack - Font.Charset = DEFAULT_CHARSET - Font.Color = clWhite - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - Constraints.MinHeight = 89 - Constraints.MinWidth = 200 - ParentFont = False - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 0 - OnChange = richLogChange - end - object edInput: TEdit - Left = 9 - Top = 153 - Width = 688 - Height = 22 - Anchors = [akLeft, akRight, akBottom] - BorderStyle = bsNone - Color = clBlack - Font.Charset = DEFAULT_CHARSET - Font.Color = clWhite - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 1 - OnKeyUp = edInputKeyUp - end - end - object StatusBar: TStatusBar - Left = 0 - Top = 556 - Width = 715 - Height = 17 - Panels = < - item - Width = 50 - end> - SimplePanel = True - end - object pgControl: TPageControl - Left = 8 - Top = 200 - Width = 705 - Height = 350 - ActivePage = tbBreakpoints - Anchors = [akLeft, akTop, akRight, akBottom] - HotTrack = True - Images = ImageList1 - TabOrder = 1 - object tbBreakpoints: TTabSheet - Caption = 'Breakpoints' - ImageIndex = -1 - DesignSize = ( - 697 - 321) - object lbBPType: TLabel - Left = 184 - Top = 0 - Width = 28 - Height = 13 - Caption = 'Type:' - end - object bpUnset: TButton - Left = 632 - Top = 13 - Width = 57 - Height = 25 - Anchors = [akTop, akRight] - Caption = 'Unset' - TabOrder = 5 - OnClick = bpUnsetClick - end - object bpSet: TButton - Left = 568 - Top = 13 - Width = 57 - Height = 25 - Anchors = [akTop, akRight] - Caption = 'Set' - TabOrder = 4 - OnClick = bpSetClick - end - object edBPOffset: TLabeledEdit - Left = 8 - Top = 18 - Width = 81 - Height = 21 - EditLabel.Width = 35 - EditLabel.Height = 13 - EditLabel.Caption = 'Offset:' - MaxLength = 10 - TabOrder = 1 - OnKeyPress = edBPOffsetKeyPress - end - object lvBreak: TListView - Left = 8 - Top = 48 - Width = 681 - Height = 154 - Anchors = [akLeft, akTop, akRight, akBottom] - Checkboxes = True - Columns = < - item - Caption = 'Offset' - MinWidth = 90 - Width = 90 - end - item - Caption = 'Type' - Width = 75 - end - item - Caption = 'Size' - end - item - Caption = 'Last Hit' - MinWidth = 90 - Width = 90 - end - item - AutoSize = True - Caption = 'Description' - end> - FlatScrollBars = True - GridLines = True - MultiSelect = True - RowSelect = True - TabOrder = 0 - ViewStyle = vsReport - OnChange = lvBreakChange - OnKeyUp = lvBreakKeyUp - OnSelectItem = lvBreakSelectItem - end - object cmbBPType: TComboBox - Left = 184 - Top = 18 - Width = 83 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - TabOrder = 3 - end - object edBPSize: TLabeledEdit - Left = 96 - Top = 18 - Width = 81 - Height = 21 - EditLabel.Width = 23 - EditLabel.Height = 13 - EditLabel.Caption = 'Size:' - TabOrder = 2 - OnKeyPress = edBPSizeKeyPress - end - object btGetRegisters: TButton - Left = 616 - Top = 282 - Width = 75 - Height = 25 - Anchors = [akRight, akBottom] - Caption = 'Update' - TabOrder = 6 - OnClick = btGetRegistersClick - end - object lvRegisters: TListView - Left = 8 - Top = 210 - Width = 497 - Height = 99 - Anchors = [akLeft, akRight, akBottom] - Columns = < - item - MaxWidth = 45 - MinWidth = 5 - Width = 30 - end - item - MinWidth = 5 - Width = 74 - end - item - MaxWidth = 45 - MinWidth = 5 - Width = 30 - end - item - MinWidth = 5 - Width = 74 - end - item - MaxWidth = 45 - MinWidth = 5 - Width = 30 - end - item - MinWidth = 5 - Width = 74 - end - item - MinWidth = 5 - Width = 74 - end - item - MinWidth = 5 - Width = 74 - end> - FlatScrollBars = True - GridLines = True - ShowColumnHeaders = False - TabOrder = 7 - ViewStyle = vsReport - end - object edBPDesc: TLabeledEdit - Left = 272 - Top = 18 - Width = 289 - Height = 21 - Anchors = [akLeft, akTop, akRight] - EditLabel.Width = 57 - EditLabel.Height = 13 - EditLabel.Caption = 'Description:' - TabOrder = 8 - end - end - object tbDumping: TTabSheet - Caption = 'Dumping' - ImageIndex = 8 - DesignSize = ( - 697 - 321) - object pbDump: TProgressBar - Left = 208 - Top = 8 - Width = 481 - Height = 17 - Anchors = [akLeft, akTop, akRight] - Smooth = True - TabOrder = 0 - end - object lvDump: TListView - Left = 208 - Top = 32 - Width = 481 - Height = 163 - Anchors = [akLeft, akTop, akRight, akBottom] - Columns = < - item - Caption = '#' - MaxWidth = 40 - MinWidth = 15 - Width = 30 - end - item - AutoSize = True - Caption = 'Offset' - MinWidth = 80 - end - item - AutoSize = True - Caption = 'Size' - MinWidth = 80 - end - item - AutoSize = True - Caption = 'Flags' - MinWidth = 80 - end - item - AutoSize = True - Caption = 'Start' - MinWidth = 80 - end - item - AutoSize = True - Caption = 'End' - MinWidth = 80 - end> - FlatScrollBars = True - GridLines = True - HotTrack = True - RowSelect = True - TabOrder = 1 - ViewStyle = vsReport - OnSelectItem = lvDumpSelectItem - end - object grpMemEdit: TGroupBox - Left = 512 - Top = 204 - Width = 177 - Height = 97 - Anchors = [akRight, akBottom] - Caption = 'Memory Editing:' - TabOrder = 4 - object Label1: TLabel - Left = 8 - Top = 12 - Width = 34 - Height = 13 - Caption = 'Action:' - end - object cbMemEdit: TComboBox - Left = 8 - Top = 28 - Width = 73 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - ItemIndex = 0 - TabOrder = 0 - Text = 'GETMEM' - OnChange = cbMemEditChange - Items.Strings = ( - 'GETMEM' - 'SETMEM') - end - object edMemEditOffset: TLabeledEdit - Left = 88 - Top = 28 - Width = 81 - Height = 21 - EditLabel.Width = 35 - EditLabel.Height = 13 - EditLabel.Caption = 'Offset:' - MaxLength = 8 - TabOrder = 1 - end - object edMemEditParam: TLabeledEdit - Left = 8 - Top = 68 - Width = 121 - Height = 21 - CharCase = ecUpperCase - EditLabel.Width = 37 - EditLabel.Height = 13 - EditLabel.Caption = 'Length:' - TabOrder = 2 - OnKeyUp = edMemEditParamKeyUp - end - object btMemEdit: TButton - Left = 136 - Top = 64 - Width = 33 - Height = 25 - Caption = 'Go' - TabOrder = 3 - OnClick = btMemEditClick - end - end - object grpConvOffset: TGroupBox - Left = 320 - Top = 204 - Width = 185 - Height = 97 - Anchors = [akRight, akBottom] - Caption = 'Offset Conversion:' - TabOrder = 3 - object Label2: TLabel - Left = 8 - Top = 12 - Width = 67 - Height = 13 - Caption = 'Original Type:' - end - object lbConvOffStat: TLabel - Left = 80 - Top = 12 - Width = 97 - Height = 33 - AutoSize = False - end - object cbOffsetConvert: TComboBox - Left = 8 - Top = 28 - Width = 65 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - ItemIndex = 0 - TabOrder = 0 - Text = 'PC' - Items.Strings = ( - 'PC' - 'XBOX') - end - object edConvOffsetTo: TLabeledEdit - Left = 96 - Top = 68 - Width = 81 - Height = 21 - EditLabel.Width = 55 - EditLabel.Height = 13 - EditLabel.Caption = 'Converted:' - MaxLength = 10 - ReadOnly = True - TabOrder = 2 - end - object edConvOffsetFrom: TLabeledEdit - Left = 8 - Top = 68 - Width = 81 - Height = 21 - EditLabel.Width = 40 - EditLabel.Height = 13 - EditLabel.Caption = 'Original:' - MaxLength = 10 - TabOrder = 1 - OnKeyPress = edConvOffsetFromKeyPress - OnKeyUp = edConvOffsetFromKeyUp - end - end - object GroupBox1: TGroupBox - Left = 8 - Top = 4 - Width = 193 - Height = 191 - Anchors = [akLeft, akTop, akBottom] - Caption = 'Section Flags:' - TabOrder = 2 - DesignSize = ( - 193 - 191) - object lbSectFlags: TCheckListBox - Left = 8 - Top = 16 - Width = 177 - Height = 163 - Anchors = [akLeft, akTop, akRight, akBottom] - ItemHeight = 13 - Sorted = True - TabOrder = 0 - end - end - object btDump: TButton - Left = 8 - Top = 204 - Width = 305 - Height = 97 - Anchors = [akLeft, akRight, akBottom] - Caption = - 'Here is AcidFlash'#39's dump button, so he doesn'#39't have to put down ' + - 'the controller for a split second.' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [fsBold] - ParentFont = False - TabOrder = 5 - WordWrap = True - OnClick = btDumpClick - end - end - object tbTools: TTabSheet - Caption = 'Tools' - ImageIndex = 11 - object GroupBox3: TGroupBox - Left = 0 - Top = 0 - Width = 697 - Height = 321 - Align = alClient - Caption = 'Tools' - Constraints.MinHeight = 160 - Constraints.MinWidth = 210 - TabOrder = 0 - DesignSize = ( - 697 - 321) - object edToolPath: TLabeledEdit - Left = 8 - Top = 32 - Width = 649 - Height = 21 - Anchors = [akLeft, akTop, akRight] - EditLabel.Width = 26 - EditLabel.Height = 13 - EditLabel.Caption = 'Path:' - Enabled = False - TabOrder = 0 - end - object edToolCaption: TLabeledEdit - Left = 8 - Top = 72 - Width = 577 - Height = 21 - Anchors = [akLeft, akTop, akRight] - EditLabel.Width = 41 - EditLabel.Height = 13 - EditLabel.Caption = 'Caption:' - TabOrder = 1 - end - object lvToolList: TListView - Left = 8 - Top = 104 - Width = 681 - Height = 209 - Anchors = [akLeft, akTop, akRight, akBottom] - Columns = < - item - AutoSize = True - Caption = 'Caption' - end - item - AutoSize = True - Caption = 'Path' - end - item - AutoSize = True - Caption = 'Launch' - end> - FlatScrollBars = True - GridLines = True - SortType = stText - TabOrder = 2 - ViewStyle = vsReport - end - object chkToolLaunch: TCheckBox - Left = 592 - Top = 72 - Width = 97 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Launch On Load' - TabOrder = 3 - end - object btnToolSelect: TButton - Left = 664 - Top = 32 - Width = 25 - Height = 21 - Anchors = [akTop, akRight] - Caption = '...' - TabOrder = 4 - OnClick = btnToolSelectClick - end - end - end - object tbMemView: TTabSheet - Caption = 'Memory View' - ImageIndex = 12 - DesignSize = ( - 697 - 321) - object edByteSearch: TLabeledEdit - Left = 256 - Top = 24 - Width = 361 - Height = 21 - Anchors = [akLeft, akTop, akRight] - CharCase = ecUpperCase - EditLabel.Width = 62 - EditLabel.Height = 13 - EditLabel.Caption = 'Byte Search:' - TabOrder = 1 - OnKeyPress = edByteSearchKeyPress - OnKeyUp = edByteSearchKeyUp - end - object edViewOffset: TLabeledEdit - Left = 160 - Top = 24 - Width = 89 - Height = 21 - CharCase = ecUpperCase - EditLabel.Width = 78 - EditLabel.Height = 13 - EditLabel.Caption = 'Jump To Offset:' - MaxLength = 10 - TabOrder = 0 - OnKeyPress = edViewOffsetKeyPress - OnKeyUp = edViewOffsetKeyUp - end - object hxMemView: TMPHexEditor - Left = 8 - Top = 56 - Width = 681 - Height = 251 - Cursor = crIBeam - Anchors = [akLeft, akTop, akRight, akBottom] - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -15 - Font.Name = 'Courier New' - Font.Style = [] - ParentFont = False - PopupMenu = popMemView - TabOrder = 3 - BytesPerRow = 16 - BytesPerColumn = 1 - Translation = tkAsIs - OffsetFormat = '-!10:0x|' - Colors.Background = clWindow - Colors.ChangedBackground = 11075583 - Colors.ChangedText = clMaroon - Colors.CursorFrame = clNavy - Colors.Offset = clBlack - Colors.OddColumn = clBlue - Colors.EvenColumn = clNavy - Colors.CurrentOffsetBackground = clMoneyGreen - Colors.OffsetBackGround = clWindow - Colors.CurrentOffset = clGreen - Colors.Grid = clSkyBlue - Colors.NonFocusCursorFrame = clAqua - Colors.ActiveFieldBackground = clWindow - FocusFrame = True - NoSizeChange = True - AllowInsertMode = False - DrawGridLines = True - GraySelectionIfNotFocused = True - Version = 'December 29, 2004; '#169' markus stephany, vcl[at]mirkes[dot]de' - OnTopLeftChanged = hxMemViewTopLeftChanged - OnChange = hxMemViewChange - DrawGutter3D = False - FindProgress = True - ExplicitHeight = 253 - end - object btMemSrchReset: TButton - Left = 624 - Top = 19 - Width = 65 - Height = 25 - Anchors = [akTop, akRight] - Caption = 'Reset' - TabOrder = 2 - OnClick = btMemSrchResetClick - end - object chkHighlightDumpChanges: TCheckBox - Left = 8 - Top = 23 - Width = 137 - Height = 17 - Hint = - 'This will add a lot of time to your dumps, but will in turn allo' + - 'w you to see the changes between different dumps in the memory v' + - 'iew window.' - Caption = 'Highlight Dump Changes' - ParentShowHint = False - ShowHint = True - TabOrder = 4 - WordWrap = True - end - end - object tbNotes: TTabSheet - Caption = 'Notes' - ImageIndex = 3 - DesignSize = ( - 697 - 321) - object moNotes: TMemo - Left = 8 - Top = 8 - Width = 681 - Height = 298 - Anchors = [akLeft, akTop, akRight, akBottom] - ScrollBars = ssVertical - TabOrder = 0 - WantTabs = True - ExplicitHeight = 300 - end - end - object tbSettings: TTabSheet - Caption = 'Settings' - ImageIndex = 10 - object GroupBox2: TGroupBox - Left = 8 - Top = 8 - Width = 257 - Height = 169 - Caption = 'Searcher Offsets:' - TabOrder = 0 - object edSearcherStart: TLabeledEdit - Left = 8 - Top = 56 - Width = 105 - Height = 21 - EditLabel.Width = 70 - EditLabel.Height = 13 - EditLabel.Caption = 'Start Address:' - MaxLength = 10 - TabOrder = 0 - end - object edSearcherEnd: TLabeledEdit - Left = 8 - Top = 96 - Width = 105 - Height = 21 - EditLabel.Width = 64 - EditLabel.Height = 13 - EditLabel.Caption = 'End Address:' - MaxLength = 10 - TabOrder = 1 - end - object chkUseSearchRange: TCheckBox - Left = 120 - Top = 18 - Width = 133 - Height = 17 - Caption = 'Automatically set range' - Checked = True - State = cbChecked - TabOrder = 2 - end - object edSearcherCaption: TLabeledEdit - Left = 120 - Top = 56 - Width = 113 - Height = 21 - EditLabel.Width = 82 - EditLabel.Height = 13 - EditLabel.Caption = 'Window Caption:' - TabOrder = 3 - end - object edSearcherClass: TLabeledEdit - Left = 120 - Top = 96 - Width = 113 - Height = 21 - EditLabel.Width = 59 - EditLabel.Height = 13 - EditLabel.Caption = 'Class Name:' - TabOrder = 4 - end - object edSearcherState: TLabeledEdit - Left = 8 - Top = 136 - Width = 105 - Height = 21 - EditLabel.Width = 84 - EditLabel.Height = 13 - EditLabel.Caption = 'Enabled Address:' - TabOrder = 5 - end - object cbRangePresets: TComboBox - Left = 8 - Top = 18 - Width = 105 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - Sorted = True - TabOrder = 6 - end - end - object GroupBox4: TGroupBox - Left = 263 - Top = 8 - Width = 170 - Height = 81 - Caption = 'Dump:' - TabOrder = 1 - object chkDumpAutoStop: TCheckBox - Left = 8 - Top = 19 - Width = 81 - Height = 17 - Caption = 'Auto-Pause' - Checked = True - State = cbChecked - TabOrder = 0 - end - object chkCopyOffToClip: TCheckBox - Left = 8 - Top = 36 - Width = 155 - Height = 17 - Caption = 'Copy Converts To Clipboard' - Checked = True - State = cbChecked - TabOrder = 1 - WordWrap = True - end - end - object GroupBox5: TGroupBox - Left = 263 - Top = 88 - Width = 170 - Height = 89 - Caption = 'Miscellaneous:' - TabOrder = 2 - object chkWarnConnected: TCheckBox - Left = 9 - Top = 30 - Width = 158 - Height = 19 - Caption = 'Warn on exit if connected' - Checked = True - State = cbChecked - TabOrder = 0 - WordWrap = True - end - object chkVerboseLog: TCheckBox - Left = 9 - Top = 14 - Width = 105 - Height = 17 - Caption = 'Verbose Logging' - Checked = True - State = cbChecked - TabOrder = 1 - end - object chkShowMainLog: TCheckBox - Left = 8 - Top = 48 - Width = 153 - Height = 17 - Caption = 'Show main log' - Checked = True - State = cbChecked - TabOrder = 2 - OnClick = chkShowMainLogClick - end - end - end - end - object SaveDialog: TSaveDialog - DefaultExt = '.bin' - Filter = - 'Dumps (*.bin)|*.bin|Breakpoint List (*.bpl)|*.bpl|Notes file (*.' + - 'notes, *.txt)|*.notes;*.txt|All files (*.*)|*.*' - Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] - Title = 'Save..' - Left = 640 - Top = 64 - end - object ImageList1: TImageList - Left = 672 - Top = 96 - Bitmap = { - 494C0101100013002C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 - 0000000000003600000028000000400000005000000001002000000000000050 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000FFFFFF008080 - 8000008000000080000080808000FFFFFF00FFFFFF0000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000008080 - 8000808080000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000FFFFFF00008000000080 - 000000800000008000000080000080808000FFFFFF00FFFFFF00008000000080 - 0000008000000080000080808000808080000000000000000000000000000000 - 0000000000008080800000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008080800080808000808080008080 - 8000808080008080800080808000808080008080800080808000C0C0C00000FF - FF0000FFFF008080800000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000080808000008000000080 - 0000008000000080000080808000FFFFFF0000000000FFFFFF00008000000080 - 000000800000008000000080000000800000000000008080800000000000FF00 - FF0000000000FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0080808000C0C0C00000000000FFFF - FF0000FFFF008080800000000000000000000000000000000000000000000000 - 0000000000FF5F5F5FFF00000000000000000000000000000000000000000000 - 00FF5F5F5FFF000000000000000000000000FFFFFF0000800000008000000080 - 00008080800080808000FFFFFF000000000000000000FFFFFF00008000000080 - 0000008000000080000000800000808080000000000000000000FF00FF00FF00 - FF00FFFFFF0000000000FFFFFF00FFFFFF0080808000FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000FFFF0000FFFF000000 - 0000C0C0C0000000000000000000000000000000000000000000000000000000 - 000000000000000000FF5F5F5FFF000000000000000000000000000000FF5F5F - 5FFF000000000000000000000000000000000080000000800000008000000080 - 000080808000FFFFFF00000000000000000000000000FFFFFF00008000000080 - 0000008000000080000000800000808080000000000000000000FF00FF00FFFF - FF000000000000FFFF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008080800000FFFF0000FF - FF00808080000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000FF5F5F5FFF00000000000000FF5F5F5FFF0000 - 0000000000000000000000000000000000000080000000800000008000008080 - 8000FFFFFF000000000000000000000000000000000080808000008000000080 - 0000008000000080000000800000808080000000000000000000808080008080 - 8000FFFFFF0000FFFF0000FFFF0000000000000000008080800080808000FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF008080 - 8000808080008080800080808000808080008080800080808000000000008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000FF000000FF5F5F5FFF000000000000 - 0000000000000000000000000000000000000080000000800000008000008080 - 8000FFFFFF000000000000000000000000000000000080808000808080008080 - 8000008000000080000000800000808080008080800000000000000000000000 - 000080808000FFFFFF0000FFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF008080 - 8000808080008080800080808000808080008080800080808000808080008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000FF000000FF5F5F5FFF000000000000 - 0000000000000000000000000000000000000080000000800000008000008080 - 8000FFFFFF0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF - FF0000800000008000000080000080808000000000000000000000000000FFFF - 000000000000FFFFFF00FFFFFF0080808000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF008080 - 8000808080008080800080808000808080008080800080808000808080008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000FF5F5F5FFF00000000000000FF5F5F5FFF0000 - 0000000000000000000000000000000000000080000000800000008000008080 - 8000FFFFFF00FFFFFF0000000000000000000000000000000000000000008080 - 8000008000000080000000800000808080000000000000000000FFFFFF000000 - 000000000000FFFFFF0080808000C0C0C000FFFFFF0080808000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF008080 - 8000808080008080800080808000FFFFFF008080800080808000808080008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000FF5F5F5FFF000000000000000000000000000000FF5F5F - 5FFF000000000000000000000000000000008080800000800000008000000080 - 000080808000FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF000080 - 0000008000000080000080808000FFFFFF000000000000000000808080000000 - 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF008080 - 8000808080008080800080808000FFFFFF008080800080808000808080008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 0000000000FF5F5F5FFF00000000000000000000000000000000000000000000 - 00FF5F5F5FFF000000000000000000000000FFFFFF0000800000008000000080 - 00008080800080808000FFFFFF00FFFFFF00FFFFFF00FFFFFF00008000000080 - 0000008000000080000080808000FFFFFF000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF008080 - 8000808080008080800080808000FFFFFF008080800080808000808080008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000080808000008000000080 - 0000008000000080000080808000808080008080800000800000008000000080 - 00000080000080808000FFFFFF00000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000FFFFFF00808080000080 - 0000008000000080000000800000008000000080000000800000008000000080 - 000080808000FFFFFF0000000000000000000000000000000000800000008000 - 0000800000008000000080000000800000008000000080000000800000008000 - 000080000000800000008000000080000000FFFFFF0000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF - FF0080808000008000000080000000800000008000000080000080808000FFFF - FF00FFFFFF000000000000000000000000000000000000000000800000008000 - 0000800000008000000080000000800000008000000080000000800000008000 - 0000800000008000000080000000800000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000F5F5F50AFCFCFC03000000000000000004040400040404000404 - 0400040404000404040004040400040404000404040004040400040404000404 - 0400040404000404040000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000AAAAAA16202020F24C4C4CD1E6E6E6060000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00C0C0C00000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000FFFFFF00C0C0C000C0C0 - C000C0C0C000C0C0C00080808000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000B4B6 - B41A1F1F1FF2929292FF383838FFAFB0AF040000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00C0C0C00000000000000000000080800000808000008080000080 - 8000008080000080800000808000008080000080800000808000008080000080 - 80000080800000808000008080000000000080808000C0C0C000C0C0C000C0C0 - C000C0C0C000C0C0C00000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000001D1D1D1F2424 - 24F19C9C9CFF373737FEE7E7E704000000000000000086868600CBCBCB00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00C6D6EF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0080000000FF0000000000000000FFFF00FF00FF000000800000FF - FF0000FFFF0000FFFF0000FFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF0080808000C0C0C000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000F3F3F302000000000000000000000000D8D8D821262626F0A6A6 - A6FF393939FE0000000000000000000000000000000086868600FFFFFF0090A9 - AD0066FFCC00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000CC - 9900FFFFFF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0080000000FF0000000000000000FFFF00FF00FF000000800000FF - FF0000FFFF0000FFFF0000FFFF000000000080808000C0C0C000C0C0C000C0C0 - C000C0C0C000C0C0C000C0C0C000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000D5D5D50CCCCC - CC23B8B8B838BABABA3BB8B8B834C6C6C632F3F3F3052D2D2DE9B3B3B3FF3A3A - 3AFD000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF0033CC990000CC9900FFFFFF00FFFFFF00FFFFFF00F0FBFF0000CC6600F8F8 - F800FFFFFF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0000FFFF008000000000FFFF0000FFFF00000080000000800000FF - FF0000FFFF0000FFFF0000FFFF000000000080808000C0C0C000C0C0C000C0C0 - C000808080008080800080808000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000E9E9E90A7D7D7D96C2C2 - C2CECECECE6EDDDDDD64CDCDCDB3888888BF7A7A7A7EAEAEAEFF3E3E3EFD0000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF000099330000CC9900FFFFFF0099FFFF0000993300C0DCC000EAEA - EA00FFFFFF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0000FFFF00C0C0C00000FFFF0000FFFF00808080000000000000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000080808000808080008080 - 8000000000000000FF000000FF00000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000959595DECFCFCF2DD9D9 - D934DEDEDE4DEEEEEE50D9D9D93EDBDBDB1CB9B9B9F1828282B3000000000000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF0000CC660000CC660000CC990033996600D7D7D700EAEA - EA00F1F1F100C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF000000 - 000000FFFF0000000000C0C0C0000000000000FFFF00000000000000000000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000009E9F9F64D9D9D934E0E0E03BECEC - EC56ECECEC55E8E8E855E6E6E657EDEDED49E5E5E519898989CCD4D4D4240000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF0000CC9900009933000099330090A9AD00D7D7D700E3E3 - E300F1F1F100C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF00C0C0 - C00080808000C0C0C000C0C0C000C0C0C00080808000FFFFFF000000000000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 - 000000000000000000000000FF00000000000000000000000000000000000000 - 000000000000000000000000000000000000929292E0DDDDDD26CFCECE46D4D4 - D440E7E7E745E0E0E050D7D7D743D5D5D549DEDEDE32A9A9A9A2AEAEAE320000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF0000CC99000099330099CC9900008000000099330099CCCC00EAEA - EA00FFFFFF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF00FFFF - FF0080808000FFFFFF00FFFFFF00FFFFFF00FFFFFF00C0C0C0008080800000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000000000000FF - FF0000000000000000000000000000000000929292A4DCDCDB2ADDDDDD33E2E1 - E22AE8E8E82FE9E9E937E2E2E12CDFE0DF32DCDBDB32C3C3C250B1B1B0410000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF0000CC6600C0DCC000EAEAEA00DDDDDD00DDDDDD00CBCBCB000099660099CC - CC00FFFFFF00C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00C0C0C0008080800000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 - 0000000000000000000000000000000000000080800000FFFF0000FFFF0000FF - FF00FFFFFF000080800000808000000000008A8989ABDCDCDC27E5E4E524BFBE - BE1DCACACA25ECEBEC24D2D0D11FC1C0C023C2C1C1299E9E9E5FA9A9A92D0000 - 0000000000000000000000000000000000000000000086868600FFFFFF00CCCC - CC00FFFFFF00FFFFFF00FFFFFF00F1F1F100F1F1F100FFFFFF00FFFFFF00DDDD - DD00F1F1F100C0C0C0000000000000000000FFFFFF0000FFFF0000FFFF0000FF - FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00808080008080800000FF - FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000008080 - 8000C0C0C000C0C0C00000000000000000000000000000FFFF0000FFFF000080 - 8000FFFFFF00000000000000000000000000939292EDE2E1E131DBDBDA20BCBC - BC22EBEBEB36DFDFDF33C7C6C620D2D2D222DADADA2A7D7D7DCA000000000000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00C0C0C0000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 - 00008080800080808000808080008080800000FFFF0000FFFF00000000000080 - 8000FFFFFF00FFFFFF000080800000000000D5D4D457C8C7C762F7F7F753FBFA - FA45FAF9F947FAF9F941FAF8F93AF0F0F050D3D2D24F9B9A9AB4000000000000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00C0C0C0000404040000000000000000008080800000FFFF0000FFFF0000FF - FF0000FFFF0000FFFF0000FFFF00808080000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000C0C0C000FFFF0000FFFF0000C0C0C0000000000000FFFF00008080000000 - 0000FFFFFF0000808000000000000000000000000000C1C1C1D0D1D1D162FFFF - FF5DFFFFFF69FFFFFF68FFFFFF5CE3E3E349BBBBBBFB00000000000000000000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C0C0 - C000040404000000000000000000000000000000000080808000FFFFFF00FFFF - FF00FFFFFF00FFFFFF0080808000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000C0C0C000FFFF0000FFFF0000C0C0C0000080800000FFFF000000000000FF - FF00FFFFFF000080800000808000000000000000000000000000D1D1D1748888 - 88F3939393B29D9D9DA87D7D7DE9DDDDDDA60000000000000000000000000000 - 0000000000000000000000000000000000000000000086868600FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000404 - 0400000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000C0C0C000C0C0C000C0C0C000C0C0C00000000000000000000080800000FF - FF00008080000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 - 000000000000DBF7DF2E9FECAB6092E99E6D92E89D6DB2EEB84DF6FCF7190000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000CC660099CCCC0099CCCC0000CC - 660000993300009966000099660099CCCC00006633000099660000993300F0FB - FF0000993300FFFFFF0000993300F0FBFF00000000000000000000000000CBF6 - D44296ECA7699AECAA659FEDAE60A1EDAE5EA1ECAD5E9EEBA9619AEAA46597E8 - 9F68F9FDF9110000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000E3E3E300CCCC9900CC996600CC996600F0CAA600FFFFFF000000 - 000000000000000000000000000000000000FFFFFF0000CC660000996600F0FB - FF0000800000009933000099330066CC990000CC6600FFFFFF00FFFFFF0000CC - 9900FFFFFF0000800000FFFFFF00FFFFFF0000000000000000009FEFB2609CEF - B063A9F0BA56BAF4C745C7F5D138BAECC345C3F0CB3CC3F3CB3CB3F0BC4CA3EC - AD5C99E9A166E8F9EA2800000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000FFFF - FF00CC999900996633009966330099663300996633009966330099663300F0CA - A6000000000000000000000000000000000000CC6600F0FBFF00F0FBFF000099 - 660000996600009933000099330099CCCC00009933000099330000993300F0FB - FF0000996600FFFFFF0000996600F0FBFF0000000000A7F1BC589DF0B462B2F3 - C44DC5F2D03A21AE2FDE00E420FF00DE19FF00D910FF00CD06FF7DCB8382C4F3 - CB3BA8EDB15799E9A166F9FDF911000000000000000000000000000000000000 - 0000000000003130310031303100313031003130310031303100000000000000 - 0000000000000000000000000000000000000000000000000000FFFFFF00CC99 - 6600996633009966330099663300996633009966330099663300996633009966 - 3300C0C0C000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ECFCF11C9AF1B565AFF4C450C1F2 - CE3E01D82FFF12F658FF0ADE3AFF02E230FF00CF1DFF00DE1AFF00D00BFF27A6 - 28D8C4F3CB3BA3ECAD5C97E89F68000000000000000000000000000000003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 3100000000000000000000000000000000000000000000000000CCCC99009966 - 330099663300CC996600E3E3E300FFFFFF00FFFFFF00F0CAA600996633009966 - 330099663300F1F1F1000000000000000000FFFFFF00FFFFFF00FFECCC00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00F0FBFF00FFFFFF00FFFFFF009FF3BB60A2F3BE5DC6F7D73907D5 - 38F832E469FF4FE882FF54EB8CFF32E161FF16D941FF01D224FF00CC17FF00D5 - 0CFF7DCB8382B3F0BC4C9AEAA465F6FCF7190000000000000000000000003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 31000000000000000000000000000000000000000000FFFFFF00996633009966 - 330099663300FFFFFF00CC9999009966330099663300CCCCCC00E3E3E3009966 - 330099663300CC9999000000000000000000FFFFFF00FFFFFF00FFFFFF006699 - 6600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0099FF - FF00C0DCC000FFFFFF00FFFFFF00FFFFFF0096F3B869ACF7C75399E1A76621E5 - 65FF7DEFACFF82EFA9FF72EC9CFF63EA92FF49E67CFF20DB4DFF03D92BFF00D3 - 18FF00C608FFC3F3CB3C9EEBA961B2EEB94D0000000000000000313031003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 31003130310000000000000000000000000000000000FFFFFF00996633009966 - 3300CCCC9900CCCCCC0099663300996633009966330099663300F1F1F1009999 - 330099663300999966000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF000099660099FFCC00FFFFFF00FFFFFF00FFFFFF00FFFFFF0066CC990099CC - CC00F0FBFF00FFFFFF00FFFFFF00FFFFFF0096F4BB69B1F7CD4E40D865BF55EF - 9EFFB6F7CFFFAAF6C7FFA1F4C0FF7FEFA7FF66EB95FF3FE26DFF1AE04CFF00CC - 1CFF00D511FFC3F0CB3CA1ECAE5E92E89D6D0000000000000000313031003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 31003130310000000000000000000000000000000000F1F1F100996633009966 - 3300D7D7D700CC99990099663300CCCC99009999660099663300DDDDDD009999 - 660099663300996633000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF000066330066CC9900FFFFFF00FFFFFF0000CC660066CC9900C0DC - C000FFECCC00F0FBFF00FFFFFF00FFFFFF0096F6BF69B2F7D04D37DB6DC85EF3 - AFFFBEF9D8FFCBFAE0FFADF7CDFFA2F5C3FF7AEFA6FF55E886FF2EE260FF04D8 - 2FFF00D71AFFBAECC345A1EDAF5E92E99F6D0000000000000000313031003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 31003130310000000000000000000000000000000000FFFFFF00996633009966 - 3300CC999900DDDDDD0099663300DDDDDD009999660099663300FFFFFF009966 - 330099663300CC9966000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00B2B2B2000099660000CC990000CC660000996600A4A0A000C0DC - C000FFECCC00F0FBFF00FFFFFF00FFFFFF0095F7C16AAFF9D15069E28C965AF5 - ADFFD8FCEAFFDBFCECFFC9FBE1FFAEF8CEFF8BF3B3FF71F0ABFF41E97BFF0BDF - 3EFF00E224FFC7F5D1389FEDAE609FECAC600000000000000000313031003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 31003130310000000000000000000000000000000000FFFFFF00996666009966 - 330099663300F1F1F100F0CAA600DDDDDD00CC996600EAEAEA00F0CAA6009966 - 330099663300CCCC99000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0000CC66000099660000993300A4A0A00086868600B2B2 - B200FFECCC00F0FBFF00FFFFFF00FFFFFF0096F7C569A6F9CF59D3FCE72C10F2 - 96FFC9FDE5FFEBFEF5FFCEFCE5FFADF9D0FFA4F6C6FF63EC96FF3DE677FF0CDE - 40FF21BC32DEBAF4C8459AEDAB65DBF7E02E0000000000000000313031003130 - 310031303100313031003130310031303100FFFFFF00FFFFFF00FFFFFF003130 - 3100313031000000000000000000000000000000000000000000CCCCCC009966 - 33009966330099663300CCCC9900DDDDDD00CC996600CC999900996633009966 - 330099663300FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF0066CCCC000099330000CC66000033330000663300A4A0A000C0DC - C000FFECCC00F0FBFF00FFFFFF00FFFFFF00C0FBDE469EFBCD61BBFCDD445CD4 - 87A341FBB6FFB6FDDDFFD4FCE9FF99F7C4FF90F4BCFF64EFA3FF2EED7DFF00E0 - 3EFFC5F2D03AA9F2BB5696ECA969000000000000000000000000000000003130 - 310031303100313031003130310031303100FFFFFF00FFFFFF00FFFFFF003130 - 310000000000000000000000000000000000000000000000000000000000CC99 - 9900996633009966330099663300DDDDDD00CC99660099663300996633009966 - 3300DDDDDD00000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF0066CC990066CC6600C0DCC000A4A0A000A4A0A0007777770000333300FFEC - CC00F0FBFF00FFFFFF00FFFFFF00FFFFFF000000000098FCCD67A6FBD559C4FD - E33B60E783B018F7A2FF4DF6ACFF52F4AFFF4DF2ADFF26F596FF07E352F8C1F2 - CF3EB2F4C54D9CEFB263CBF7D542000000000000000000000000000000003130 - 3100313031003130310031303100313031003130310031303100313031003130 - 3100000000000000000000000000000000000000000000000000000000000000 - 0000F0CAA6009966330099663300996633009966330099663300CC996600E3E3 - E30000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00C0DC - C000FFECCC00FFECCC00FFECCC00C0DCC000FFECCC00FFECCC00F0FBFF00A4A0 - A000F0FBFF00FFFFFF00FFFFFF00FFFFFF0000000000F3FEF81999FDD266A6FC - D659BBFCDD44D3FDE82C61E08FB037E171C840DE71BF96E6A66AC6F7D839AFF4 - C6509DF1B6629FF0B46000000000000000000000000000000000000000000000 - 0000000000003130310031303100313031003130310031303100000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000FFFFFF00DDDDDD00F0CAA600D7D7D700EAEAEA00000000000000 - 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00F0FBFF00F0FBFF00F0FBFF00F0FBFF00F0FBFF00F0FBFF00F0FBFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000F3FEF91998FD - D0679EFBCF61A6FAD059AFFAD350B2F8D24DB1F7CF4EACF7C953A2F4BF5D9AF3 - B765A7F2BD580000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 - 0000C0FCDF4696F9C76995F7C36A96F7C16996F5BD6996F4BA699FF4BD60ECFC - F11C000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000080800000000000808080000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000FFFF0000000000000000008080 - 8000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000008080800000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000808000000000000000000080808000808080000000 - 0000808080000000000000000000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000FFFF00000000008080800000000000000000008080 - 8000000000008080800000000000000000000000000000000000FFFFFF008000 - 0000800000008000000080000000800000008000000080000000800000008000 - 0000FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000008080000000000000000000808080000000000000000000000000000000 - 0000808080000000000080808000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000FFFF000000000080808000000000000000000000000000000000000000 - 0000000000008080800080808000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000FF000000FF00000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000008080000000 - 0000000000008080800000000000000000000000000000000000808080000000 - 0000000000000000000000000000008080000000000000000000FFFFFF008000 - 0000800000008000000080000000800000008000000080000000800000008000 - 0000FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000FF000000FF000000FF000000FF0000000000000000 - 000000000000000000000000000000000000000000000000000000FFFF000000 - 0000808080000000000000000000000000000000000000000000000000000000 - 0000000000000000000000FFFF0000FFFF000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF - 0000000000000000000000000000000000000080800000000000000000008080 - 8000000000000000000000000000808080008080800000000000000000000000 - 0000000000000080800000000000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000FF000000FF000000FF000000FF0000000000000000 - 00000000000000000000000000000000000000FFFF0000000000808080000000 - 0000000000000000000080808000808080000000000000000000000000000000 - 000000FFFF0000FFFF0000000000000000000000000000000000FFFFFF008000 - 0000800000008000000080000000800000008000000080000000800000008000 - 0000FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000FF000000FF00000000000000000000000000000000 - 0000000000000000000000000000000000000000000080808000000000000000 - 0000000000000000000080808000000000000000000000000000000000000080 - 8000000000000000000000000000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF008080800000000000000000000000000000000000000000000000 - 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 000000FF000000FF000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008080800000000000000000008080 - 800080808000808080000000000000000000000000000000000000FFFF0000FF - FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000008080 - 8000808080008080800000000000000000000000000000808000000000000000 - 0000000000000000000000000000000000000000000000000000FFFFFF008000 - 00008000000080000000800000008000000080000000FFFFFF00FFFFFF00C0C0 - C000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000FFFF0000FFFF00000000000000 - 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C0C0C0000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000008080000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000FFFF0000FFFF000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000424D3E000000000000003E000000 - 2800000040000000500000000100010000000000800200000000000000000000 - 000000000000000000000000FFFFFF0000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000FFDFFFFFFFFFF0FFFF9FFFCFFFFFC040 - FF3FFF83FFFF8000C87F0001FFFF808080000001F3E7018000000001F9CF0380 - C0000003FC9F0780C0000007FE3F078040000007FE3F078040000007FC9F03E0 - 80000007F9CF0180C0000007F3E70000C0000007FFFF8001C0000007FFFF8003 - C0000007FFFFC007C0000007FFFFF01FFFF98003FFFF80FFFFF08003FFFF80FF - FFE08003000000FFFFC18003000000FFFB878003000000FFC00F8003000001FF - 801F8003000089FF803F80030000FFFF001F80030000FDE7001F80030000FF81 - 001F80030000F001001F80030000E001003F80030001F000003F800300FFF001 - 807F800781FFF001C0FF800FFFFFF043FFFF0000F81FFFFFFFFF0000E007F01F - F81F0000C003E00FE00F00008001C007C007000000018003C003000000000001 - 8003000000000001800300000000000180030000000000018003000000000001 - 8003000000000001C003000000010001E007000080018003F00F00008003C007 - F83F0000C007E00FFFFF0000F00FF01FFFFFFFFFFF5FFFFFFFFFFFFFFF0FC003 - E007FFFFFD07C003C003E3FFFC03C003C003C0FFF401C003C003C03FF001C003 - C003C007D000C003C003C003C004C003C003C0034003C003C003C0030013C003 - C003C007000FC003C003C03F004FC007C003C0FF803FC00FE007E3FFC13FC01F - FFFFFFFFE0FFC03FFFFFFFFFF4FFFFFF00000000000000000000000000000000 - 000000000000} - end - object mnuMain: TMainMenu - Images = ImageList1 - Left = 608 - Top = 96 - object Application1: TMenuItem - Caption = '&Application' - object Tools1: TMenuItem - Caption = 'Tools' - end - object N4: TMenuItem - Caption = '-' - end - object SaveLog1: TMenuItem - Caption = 'Save Log' - ShortCut = 16467 - OnClick = SaveLog1Click - end - object Settings1: TMenuItem - Caption = 'Settings' - ImageIndex = 10 - object SetXBOXAddress1: TMenuItem - Caption = 'Set XBOX Address' - OnClick = SetXBOXAddress1Click - end - object SetListenPort1: TMenuItem - Caption = 'Set Listen Port' - OnClick = SetListenPort1Click - end - end - object N2: TMenuItem - Caption = '-' - end - object Exit1: TMenuItem - Caption = 'E&xit' - ImageIndex = 14 - ShortCut = 49240 - OnClick = Exit1Click - end - end - object XDK1: TMenuItem - Caption = '&XDK' - object Connect1: TMenuItem - Caption = '&Connect' - ImageIndex = 7 - ShortCut = 112 - OnClick = Connect1Click - end - object Dumpmemory1: TMenuItem - Caption = '&Dump memory' - ImageIndex = 8 - ShortCut = 16452 - OnClick = Dumpmemory1Click - end - object N1: TMenuItem - Caption = '-' - end - object Stop1: TMenuItem - Caption = 'Stop' - ImageIndex = 0 - ShortCut = 114 - OnClick = Stop1Click - end - object Go1: TMenuItem - Caption = 'Go' - ImageIndex = 1 - ShortCut = 115 - OnClick = Go1Click - end - object ContinueThread1: TMenuItem - Caption = 'Continue Thread' - ImageIndex = 1 - ShortCut = 116 - OnClick = ContinueThread1Click - end - object Modules1: TMenuItem - Caption = 'Modules' - ImageIndex = 2 - ShortCut = 16461 - OnClick = Modules1Click - end - object Threads1: TMenuItem - Caption = 'Threads' - ImageIndex = 13 - ShortCut = 16468 - OnClick = Threads1Click - end - object GetProcessID1: TMenuItem - Caption = 'Get Process ID' - ImageIndex = 13 - ShortCut = 16464 - OnClick = GetProcessID1Click - end - object XBEInfo1: TMenuItem - Caption = 'XBE Info' - ImageIndex = 9 - ShortCut = 16457 - OnClick = XBEInfo1Click - end - object WarmReboot1: TMenuItem - Caption = 'Reboot Warm' - ImageIndex = 4 - ShortCut = 120 - OnClick = WarmReboot1Click - end - object RebootCold1: TMenuItem - Caption = 'Reboot Cold' - ImageIndex = 4 - ShortCut = 121 - OnClick = RebootCold1Click - end - object RestartTitle1: TMenuItem - Caption = 'Restart Title' - ImageIndex = 15 - ShortCut = 123 - OnClick = RestartTitle1Click - end - end - object Help1: TMenuItem - Caption = '&Help' - object About1: TMenuItem - Caption = '&About' - OnClick = About1Click - end - end - end - object ClientThread: TIdThreadComponent - Active = False - Loop = True - Priority = tpNormal - StopMode = smTerminate - OnRun = ClientThreadRun - Left = 672 - Top = 32 - end - object popMemView: TPopupMenu - Left = 640 - Top = 96 - object JumpbyPCAddress1: TMenuItem - Caption = 'Jump by PC Address' - OnClick = JumpbyPCAddress1Click - end - object JumpbyXBOXAddress1: TMenuItem - Caption = 'Jump by XBOX Address' - OnClick = JumpbyXBOXAddress1Click - end - object N3: TMenuItem - Caption = '-' - end - object SavetoFile1: TMenuItem - Caption = 'Save to File' - OnClick = SavetoFile1Click - end - end - object XClient: TIdTCPClient - OnStatus = XClientStatus - ConnectTimeout = 0 - Host = '192.168.1.153' - IPVersion = Id_IPv4 - Port = 731 - ReadTimeout = 0 - Left = 672 - Top = 64 - end - object Server: TIdTCPServer - Bindings = <> - DefaultPort = 2000 - MaxConnections = 1 - OnExecute = ServerExecute - Left = 640 - Top = 32 - end - object odToolSelect: TOpenDialog - DefaultExt = '*.exe' - Filter = 'Programs|*.exe|All Files|*.*' - Options = [ofHideReadOnly, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofEnableSizing, ofDontAddToRecent] - Title = 'Select a tool' - Left = 608 - Top = 64 - end -end diff --git a/src/Main.pas b/src/Main.pas deleted file mode 100644 index dcac108..0000000 --- a/src/Main.pas +++ /dev/null @@ -1,1843 +0,0 @@ -unit Main; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, Menus, StdCtrls, ExtCtrls, ComCtrls,CommCtrl, IdThreadComponent, IdGlobal, - IdTCPConnection, IdBaseComponent, IdComponent, IdTCPClient, - IdStreamVCL, StrUtils, IdExceptionCore,IdException, - Breakpoint, Tabs, CategoryButtons, IdContext,INIFiles,IdIPAddress, - TypInfo, IdTCPServer, ShellApi, IdStack, Grids, MPHexEditor, AppGlobal, LogStream, - CheckLst, ImgList, ValEdit, XBOXManager, IdCustomTCPServer; - -const - WM_NEWTEXT = WM_USER+0; - WM_NEWDUMP = WM_USER+1; - PAGE_WRITECOMBINE = $400; - MEM_LARGE_PAGES = $20000000; - MEM_4MB_PAGES = $80000000; - -type - TfrmMain = class(TForm) - grpConsole: TGroupBox; - edInput: TEdit; - mnuMain: TMainMenu; - Application1: TMenuItem; - Exit1: TMenuItem; - XDK1: TMenuItem; - Connect1: TMenuItem; - Dumpmemory1: TMenuItem; - Help1: TMenuItem; - About1: TMenuItem; - ClientThread: TIdThreadComponent; - richLog: TRichEdit; - StatusBar: TStatusBar; - N1: TMenuItem; - Modules1: TMenuItem; - Threads1: TMenuItem; - WarmReboot1: TMenuItem; - GetProcessID1: TMenuItem; - XBEInfo1: TMenuItem; - RebootCold1: TMenuItem; - Stop1: TMenuItem; - Go1: TMenuItem; - N2: TMenuItem; - pgControl: TPageControl; - tbBreakpoints: TTabSheet; - bpUnset: TButton; - bpSet: TButton; - edBPOffset: TLabeledEdit; - lvBreak: TListView; - tbDumping: TTabSheet; - ContinueThread1: TMenuItem; - XClient: TIdTCPClient; - Server: TIdTCPServer; - pbDump: TProgressBar; - lvDump: TListView; - cmbBPType: TComboBox; - edBPSize: TLabeledEdit; - tbTools: TTabSheet; - tbMemView: TTabSheet; - edByteSearch: TLabeledEdit; - edViewOffset: TLabeledEdit; - hxMemView: TMPHexEditor; - btMemSrchReset: TButton; - tbNotes: TTabSheet; - moNotes: TMemo; - SetXBOXAddress1: TMenuItem; - SetListenPort1: TMenuItem; - SaveDialog: TSaveDialog; - Tools1: TMenuItem; - N4: TMenuItem; - Settings1: TMenuItem; - popMemView: TPopupMenu; - JumpbyPCAddress1: TMenuItem; - JumpbyXBOXAddress1: TMenuItem; - N3: TMenuItem; - SavetoFile1: TMenuItem; - tbSettings: TTabSheet; - grpMemEdit: TGroupBox; - cbMemEdit: TComboBox; - Label1: TLabel; - edMemEditOffset: TLabeledEdit; - edMemEditParam: TLabeledEdit; - btMemEdit: TButton; - grpConvOffset: TGroupBox; - cbOffsetConvert: TComboBox; - Label2: TLabel; - edConvOffsetTo: TLabeledEdit; - edConvOffsetFrom: TLabeledEdit; - lbConvOffStat: TLabel; - lbBPType: TLabel; - GroupBox1: TGroupBox; - lbSectFlags: TCheckListBox; - ImageList1: TImageList; - btDump: TButton; - GroupBox2: TGroupBox; - edSearcherStart: TLabeledEdit; - edSearcherEnd: TLabeledEdit; - chkUseSearchRange: TCheckBox; - GroupBox4: TGroupBox; - chkDumpAutoStop: TCheckBox; - chkCopyOffToClip: TCheckBox; - edSearcherCaption: TLabeledEdit; - edSearcherClass: TLabeledEdit; - edSearcherState: TLabeledEdit; - RestartTitle1: TMenuItem; - SaveLog1: TMenuItem; - btGetRegisters: TButton; - lvRegisters: TListView; - cbRangePresets: TComboBox; - chkHighlightDumpChanges: TCheckBox; - GroupBox5: TGroupBox; - chkWarnConnected: TCheckBox; - chkVerboseLog: TCheckBox; - chkShowMainLog: TCheckBox; - edBPDesc: TLabeledEdit; - GroupBox3: TGroupBox; - edToolPath: TLabeledEdit; - edToolCaption: TLabeledEdit; - lvToolList: TListView; - chkToolLaunch: TCheckBox; - btnToolSelect: TButton; - odToolSelect: TOpenDialog; - procedure btnToolSelectClick(Sender: TObject); - procedure chkShowMainLogClick(Sender: TObject); - procedure btGetRegistersClick(Sender: TObject); - procedure hxMemViewTopLeftChanged(Sender: TObject); - procedure SaveLog1Click(Sender: TObject); - procedure lvBreakSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); - procedure RestartTitle1Click(Sender: TObject); - procedure btDumpClick(Sender: TObject); - procedure lvDumpSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); - procedure lvBreakChange(Sender: TObject; Item: TListItem; - Change: TItemChange); - procedure edMemEditParamKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure edConvOffsetFromKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure edConvOffsetFromKeyPress(Sender: TObject; var Key: Char); - procedure GenericMenuItemClick(Sender: TObject); - procedure btMemEditClick(Sender: TObject); - procedure cbMemEditChange(Sender: TObject); - procedure hxMemViewChange(Sender: TObject); - procedure SavetoFile1Click(Sender: TObject); - procedure JumpbyPCAddress1Click(Sender: TObject); - procedure JumpbyXBOXAddress1Click(Sender: TObject); - procedure SetListenPort1Click(Sender: TObject); - procedure SetXBOXAddress1Click(Sender: TObject); - procedure btMemSrchResetClick(Sender: TObject); - procedure edByteSearchKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure edByteSearchKeyPress(Sender: TObject; var Key: Char); - procedure edViewOffsetKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure edViewOffsetKeyPress(Sender: TObject; var Key: Char); - procedure FormDestroy(Sender: TObject); - procedure edBPSizeKeyPress(Sender: TObject; var Key: Char); - procedure edBPOffsetKeyPress(Sender: TObject; var Key: Char); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure ServerExecute(AContext: TIdContext); - procedure ContinueThread1Click(Sender: TObject); - procedure bpUnsetClick(Sender: TObject); - procedure bpSetClick(Sender: TObject); - procedure lvBreakKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure Go1Click(Sender: TObject); - procedure Stop1Click(Sender: TObject); - procedure RebootCold1Click(Sender: TObject); - procedure XBEInfo1Click(Sender: TObject); - procedure GetProcessID1Click(Sender: TObject); - procedure WarmReboot1Click(Sender: TObject); - procedure Threads1Click(Sender: TObject); - procedure Modules1Click(Sender: TObject); - procedure ClientThreadRun(Sender: TIdThreadComponent); - procedure richLogChange(Sender: TObject); - procedure XClientStatus(ASender: TObject; const AStatus: TIdStatus; - const AStatusText: string); - procedure Exit1Click(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure edInputKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure FormCreate(Sender: TObject); - procedure About1Click(Sender: TObject); - procedure Dumpmemory1Click(Sender: TObject); - procedure Connect1Click(Sender: TObject); - - procedure OnNewText(var Msg: TMessage); message WM_NEWTEXT; - procedure OnNewDump(var Msg: TMessage); message WM_NEWDUMP; - - private - { Private declarations } - MemSrchPos:Integer; - public - { Public declarations } - function SendData(Data:String):Boolean; - procedure ConnectToggle(Tog:Boolean); - end; - - procedure FillDumpPages(hDump:HWND); - procedure GetDumpData(hProgress:HWND;hWin:HWND;Verbose:Boolean); - function IsValidHexBoxInput(var Key: Char):Boolean; - function IsValidIP(const AAddr : String): Boolean; -// function LaunchAsChild(EXEName:String;EXEClass:PAnsiChar;EXECaption:PAnsiChar;Parent:HWND):HWND; - -var -// XBEName:String; - ProgressBar:HWND; - DumpList:HWND; - SavedDump:TMemoryStream; - frmMain: TfrmMain; - -implementation - -{$R *.dfm} - -procedure TfrmMain.Connect1Click(Sender: TObject); -begin - if XClient.Connected then - begin - XClient.Disconnect; - Exit; - end; - - try - XClient.Connect; - except - On E : Exception do Log.AddLn('Connect: ' + E.Message); - end; -end; - -procedure TfrmMain.Dumpmemory1Click(Sender: TObject); -begin - if (XClient.Connected) and - (ProgStatus = stNorm) then - begin - ProgStatus := stDump; - SendData('WALKMEM'); - end; -end; - -procedure TfrmMain.About1Click(Sender: TObject); -begin - ShowMessage('Coded by ddh for EvoX-T.'+#13#10+'Current official download site:'+#13#10+'http://trainers.evolutionx.info'); -end; - -procedure TfrmMain.FormCreate(Sender: TObject); -var -count:TBPTypes; -iniSet:TINIFile; -Sections:TStringList; -Counter:Integer; -//r:TRect; -mi:TMenuItem; -ExIcon:HICON; -NewIcon:TIcon; -begin - Log := TLogStream.create('',WM_NEWTEXT,frmMain.Handle); - DebugBox := TXBOX.Create(@XClient); - -// richlog.SelStart := richlog.GetTextLen; -// richlog.seltext := '{\rtf1\ansi\deff0\deftab720\fnil\deflang1033\pard{\colortbl\red0\green0\blue0;\red0\green200\blue200;}\cf1 test \par}'; -// log.AddLn('{\rtf1\ansi\fnil{\colortbl\red110\green0\blue0;\red0\green200\blue20;}\cf0 Another test \par}'); - - lbSectFlags.Clear; - lbSectFlags.AddItem('PAGE_NOACCESS',Self); - lbSectFlags.AddItem('PAGE_READONLY',Self); - lbSectFlags.AddItem('PAGE_READWRITE',Self); - lbSectFlags.AddItem('PAGE_WRITECOPY',Self); - lbSectFlags.AddItem('PAGE_EXECUTE',Self); - lbSectFlags.AddItem('PAGE_EXECUTE_READ',Self); - lbSectFlags.AddItem('PAGE_EXECUTE_READWRITE',Self); - lbSectFlags.AddItem('PAGE_EXECUTE_WRITECOPY',Self); - lbSectFlags.AddItem('PAGE_GUARD',Self); - lbSectFlags.AddItem('PAGE_NOCACHE',Self); - lbSectFlags.AddItem('PAGE_WRITECOMBINE',Self); - lbSectFlags.AddItem('MEM_COMMIT',Self); - lbSectFlags.AddItem('MEM_RESERVE',Self); - lbSectFlags.AddItem('MEM_DECOMMIT',Self); - lbSectFlags.AddItem('MEM_RELEASE',Self); - lbSectFlags.AddItem('MEM_FREE',Self); - lbSectFlags.AddItem('MEM_PRIVATE',Self); - lbSectFlags.AddItem('MEM_MAPPED',Self); - lbSectFlags.AddItem('MEM_RESET',Self); - lbSectFlags.AddItem('MEM_TOP_DOWN',Self); - lbSectFlags.AddItem('MEM_LARGE_PAGES',Self); - lbSectFlags.AddItem('MEM_4MB_PAGES',Self); - lbSectFlags.AddItem('SEC_RESERVE',Self); - - cmbBPType.Clear; - for count := Low(TBPTypes) to High(TBPTypes) do - begin - cmbBPType.Items.Add(GetEnumName(TypeInfo(TBPTypes),ord(count))); - end; - cmbBPType.ItemIndex := 0; - - edInput.Enabled := false; - lvBreak.Enabled := false; -// Membuffer := TMemoryStream.Create; - SavedDump := TMemoryStream.Create; - - try - begin - iniSet := TINIFile.Create(ExtractFilePath(Application.EXEName) + 'xdkassist.ini'); - XClient.Host := iniSet.ReadString('Connection','Host','192.168.1.153'); - Server.DefaultPort := iniSet.ReadInteger('Connection','Port',2000); - cmbBPType.ItemIndex := cmbBPType.Items.IndexOf( - iniSet.ReadString('Breakpoints','Type','Read')); - if cmbBPType.ItemIndex < 0 then cmbBPType.ItemIndex := 0; - - Sections := TStringList.Create; - -{ tbTools.TabVisible := false;} - - iniSet.ReadSections(Sections); - for Counter := 0 to (Sections.Count-1) do - begin - if (not AnsiStartsText('Tool',Sections.Strings[Counter])) then Continue; - - SetLength(Tools,Length(Tools)+1); - with Tools[High(Tools)] do - begin - Name := iniSet.ReadString(Sections[Counter],'Name',''); -// WinClass := iniSet.ReadString(Sections[Counter],'Class',''); - WinText := iniSet.ReadString(Sections[Counter],'Caption',''); - Load := iniSet.ReadBool(Sections[Counter],'Load',false); - - if (Name = '') or (not FileExists(Name)){and (WinClass = '') and (WinText = '')} then - begin - SetLength(Tools,Length(Tools)-1); - Continue; - end; - - mi := TMenuItem.Create(mnuMain); - if WinText <> '' then - mi.Caption := WinText - else if Name <> '' then - begin - mi.Caption := Name; - end -{ else if WinClass <> '' then - mi.Caption := WinClass } - else - mi.Caption := 'Unknown Tool #' + IntToStr(High(Tools)); - - mi.OnClick := GenericMenuItemClick; - mi.Tag := High(Tools); - - if Name <> '' then - begin - ExIcon := ExtractIcon(Handle,PAnsiChar(Name+#0),0); - if ExIcon <> 0 then - begin - NewIcon := TIcon.Create; - NewIcon.Handle := ExIcon; - mi.ImageIndex := ImageList1.AddIcon(NewIcon); - end; - end; - - Tools1.Add(mi); - - if (Load = true) then ShellExecute(0,'open',PAnsiChar(Name),#0,#0,SW_NORMAL); - -{ if (Load = true) then - begin - tbTools.TabVisible := true; - - Handle := LaunchAsChild(Name,PAnsiChar(WinClass+#0),PAnsiChar(WinText+#0),ScrollBox1.handle); - if Handle <> 0 then - begin - Log.AddLn('Launched and captured ' + WinText + ' for your pleasure!'); - if Length(Tools) > 1 then - begin - GetWindowRect(Tools[Length(Tools)-2].handle,r); - SetWindowPos(Handle,0,r.right+5,5,0,0,SWP_NOSIZE or SWP_NOZORDER); - end - else - SetWindowPos(Handle,0,5,5,0,0,SWP_NOSIZE or SWP_NOZORDER); - end; - end; } - end; - end; - FreeAndNil(Sections); - - frmMain.Width := iniSet.ReadInteger('Window','Width',frmMain.Width); - frmMain.Height := iniSet.ReadInteger('Window','Height',frmMain.Height); - frmMain.WindowState := TWindowState(iniSet.ReadInteger('Window','State',Integer(frmMain.WindowState))); - pgControl.ActivePageIndex := iniSet.ReadInteger('Window','LastTab',pgControl.ActivePageIndex); - chkDumpAutoStop.Checked := iniSet.ReadBool('Dumping','AutoStop',true); - chkCopyOffToClip.Checked := iniSet.ReadBool('Dumping','AutoCopy',true); - chkHighlightDumpChanges.Checked := iniSet.ReadBool('Dumping','Highlight',false); - chkVerboseLog.Checked := iniSet.ReadBool('Logging','Verbose',true); - - chkWarnConnected.Checked := iniSet.ReadBool('Misc','WarnConClose',true); - chkShowMainLog.Checked := iniSet.ReadBool('Layout','ShowMainLog',true); - - chkUseSearchRange.Checked := iniSet.ReadBool('Range','Enabled',true); - edSearcherStart.Text := iniSet.ReadString('Range','Start',''); - edSearcherEnd.Text := iniSet.ReadString('Range','End',''); - edSearcherCaption.Text := iniSet.ReadString('Range','Caption',''); - edSearcherClass.Text := iniSet.ReadString('Range','Class',''); - edSearcherState.Text := iniSet.ReadString('Range','State',''); - - FreeAndNil(iniSet); - Log.AddLn('Settings have been read.'); - end - except - on E:Exception do Log.AddLn('Failed loading settings: ' + E.Message); - end; - - if Length(Tools) > 0 then - Log.AddLn(IntToStr(Length(Tools)) + ' tools were loaded.'); {If any were set to autolaunch, and the application ' + - 'crashes, or is terminated without it being able to clean up you ' + - 'will have to manually close the launched tools with task manager.'); } - - ConnectToggle(false); - {if ((tbTools.TabVisible = false) and (pgControl.ActivePage = tbTools)) then - pgControl.ActivePage := tbDumping; } - Log.AddLn(Application.Title + ' started.'); - - Progressbar := pbDump.Handle; - DumpList := lvDump.Handle; - if FileExists('xdkassist.notes') then - begin - moNotes.Lines.LoadFromFile('xdkassist.notes'); - Log.addln('Notes loaded from a previous session.'); - end; - -end; - -procedure TfrmMain.edInputKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -var -Pos:Cardinal; -Buf:String; -ConvOff:Int64; -ret:Integer; -begin - if Key = VK_RETURN then - begin - if StartsStr('/conv',edInput.Text) then - begin - Buf := edInput.Text; - Pos := AnsiPos(' ',Buf); - if (Pos = 0) then - begin - Log.AddLn('/conv offset'); - Exit; - end; - - Buf := RightStr(Buf,(Cardinal(Length(Buf)) - Pos)); - ret := ConvPC2XBOX(StrToInt64(Buf),@ConvOff); - if(ret <> EConvOkay) then begin - Log.AddLn(ConvError(ret)); - end else begin - Log.AddLn(Format('0x%.80x -> 0x%.80x',[Cardinal(Buf),ConvOff])); - if(chkCopyOffToClip.Checked) then - TextToClip(IntToHex(ConvOff,8)); - end; - end - else if AnsiStartsStr('/clear',edInput.Text) then - begin - Log.Clear; - richlog.Clear; - end - else - begin - SendData(edInput.Text); - end; - edInput.Text := ''; - end; -end; - -function TfrmMain.SendData(Data:String):Boolean; -begin - Result := DebugBox.IsConnected; - try - if (DebugBox.IsConnected = true) then - begin - Log.AddLn('s: ' + Data); - DebugBox.SendCmd(AnsiString(Data)); - end - else - begin - Log.AddLn('Not connected.'); - end; - except - on E: Exception do - begin - Log.AddLn('Send Data: ' + E.message); - Result := false; - end; - end; -end; - -procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); -var -Ret: Integer; -begin - CanClose := true; - if ((DebugBox.IsConnected = true) and (chkWarnConnected.Checked)) then - begin - Ret := MessageDlg('You are still connected to an XBOX. Are you sure you want to disconnect?', - mtConfirmation,[mbYes, mbNo],0); - - if Ret = mrYes then XClient.Disconnect - else CanClose := false; - end; -end; - -procedure TfrmMain.Exit1Click(Sender: TObject); -begin - frmMain.Close; -end; - -procedure TfrmMain.XClientStatus(ASender: TObject; const AStatus: TIdStatus; - const AStatusText: string); -begin - { -hsResolving A host name is being resolved to an IP Address. -hsConnecting A connection is being opened. -hsConnected A connection has been made. -hsDisconnecting The connection is being closed. -hsDisconnected The connection has been closed. -hsStatusText The connection is generating an informational message. -ftpTransfer An FTP connection is beginning its transfer. -ftpReady An FTP connection is ready. -ftpAborted An FTP transfer has been aborted. -} - StatusBar.SimpleText := AStatusText; - try - begin - if AStatus = hsDisconnecting then - begin - try - try - begin - DebugBox.Notify(Server.DefaultPort,true); - ClientThread.Terminate; - end - except - on E: Exception do Log.AddLn('Status (Disconnecting): ' + E.Message); - end; - finally - ProgStatus := stNorm; - end; - end - else if AStatus = hsDisconnected then - begin - Log.AddLn('Disconnected from ' + XClient.Host + '.'); - ConnectToggle(false); - end - else if AStatus = hsConnected then - begin - try - Log.AddLn('Connected to ' + XClient.Host + '. Listening on port ' + IntToStr(Server.DefaultPort) + '.'); - except - on E: Exception do Log.AddLn('Status (Connected): ' + E.Message); - end; - ConnectToggle(true); - end; - end - except - on E : Exception do Log.AddLn('Status: ' + E.Message); - end; -end; - -procedure TfrmMain.richLogChange(Sender: TObject); -begin - richLog.Perform(EM_SCROLL,SB_PAGEDOWN,0); -end; - -procedure TfrmMain.ClientThreadRun(Sender: TIdThreadComponent); -var -Read: String; -Time:Cardinal; -Buffer:PAnsiChar; -begin - while (not ClientThread.Terminated) and - (XClient.Connected) do - begin - try - Read := ''; - if Assigned(XClient.IOHandler) then - Read := XClient.IOHandler.ReadLn; - except - on E: Exception do - begin - if (E is EIdReadTimeout) or (E is EIdNoDataToRead) then Continue - else if (E is EIdConnClosedGracefully) or - (E is EIdNotConnected) or (E is EIdTCPConnectionError) then - begin - ClientThread.Terminate; - end - else if (E is EIdSocketError) then - begin - Log.AddLn('Thread: ' + E.Message); - XClient.Socket.Close; - ConnectToggle(false); - ClientThread.Terminate; - Continue; - end; - Log.AddLn('Thread: ' + E.Message); - Continue; - end; - end; - - if Read = '' then Continue - else if Read = '201- connected' then - begin - DebugBox.Connect(Server.DefaultPort); -{ SendData('NOTIFYAT PORT=' + IntToStr(Server.DefaultPort)); - SendData('DEBUGGER CONNECT');} - end - else if Read = '202- bye' then - begin - XClient.Disconnect; - ClientThread.Terminate; - end - else if Read = '202- Valid Virtual Address Ranges Follow' then - begin - if ProgStatus = stDump then - begin - Log.AddLn(Read); - if chkDumpAutoStop.Checked then SendData('STOP'); - PostMessage(ProgressBar,PBM_SETPOS,0,0); - PostMessage(DumpList,LVM_DELETEALLITEMS,0,0); - - Time := GetTickCount; - FillDumpPages(DumpList); - GetDumpData(ProgressBar,frmMain.handle,frmMain.chkVerboseLog.Checked); - - Log.AddLn(Format('All done (0x%.8p - 0x%.8x). The dump took %.2fs.', -// [Membuffer.memory,Integer(MemBuffer.Memory) + Membuffer.position, - [DebugBox.Memory.Buffer.Memory,Integer(DebugBox.Memory.Buffer.Memory) + DebugBox.Memory.Buffer.Position, - (Windows.GetTickCount - Time) / 1000])); - - PostMessage(frmMain.Handle,WM_NEWDUMP,0,0); - Read :=''; - end; - end - else if Read = '202- multiline response follows' then - begin - if (ProgStatus = stGetXBEInfo) then - begin - {202- multiline response follows - timestamp=0x40d52299 checksum=0x00000000 - name="E:\UnleashX\default.xbe" - .} - log.addln('r: ' + Read); - Read := XClient.IOHandler.ReadLn; - log.addln('r: ' + Read); - Read := XClient.IOHandler.ReadLn; - DebugBox.XBE.Name := AnsiMidStr(Read,7,Length(Read)-7); - progStatus := stNorm; - end - else if(ProgStatus = stGetContext) then - begin - while Read <> '.' do - begin - Read := XClient.IOHandler.ReadLn; - log.AddLn(read); - end; - - progStatus := stNorm; - end; - end - else if Read = '203- binary response follows' then - begin - Log.AddLn(Read); - repeat - Read := XClient.IOHandler.ReadString(XClient.IOHandler.InputBuffer.Size); - if (Length(Read) > 0) then - begin - Buffer := StrAlloc(Length(Read) * 2 + 1); - BinToHex(PAnsiChar(Read),Buffer,Length(Read)); - Log.AddLn(String(Buffer)); - StrDispose(Buffer); - end; - until XClient.IOHandler.InputBuffer.Size = 0; - Read := ''; - end; - if Read <> '' then - begin - Log.AddLn('r: ' + Read); - end; - end; -end; - -procedure TfrmMain.Modules1Click(Sender: TObject); -begin - SendData('MODULES'); -end; - -procedure TfrmMain.Threads1Click(Sender: TObject); -begin - SendData('THREADS'); -end; - -procedure TfrmMain.WarmReboot1Click(Sender: TObject); -begin -// SendData('REBOOT WAIT WARM'); - if(DebugBox.Reboot(DebugBox.rbWait and DebugBox.rbWarm and DebugBox.rbNoDebug,'')) then - DebugBox.Disconnect; -// if XClient.Connected then -// XClient.Disconnect; -end; - -procedure TfrmMain.GetProcessID1Click(Sender: TObject); -begin - SendData('GETPID'); -end; - -procedure TfrmMain.XBEInfo1Click(Sender: TObject); -begin - if DebugBox.IsConnected then - begin - progStatus := stGetXBEInfo; - DebugBox.SendCmd('XBEINFO RUNNING'); - end; -end; - -procedure TfrmMain.RebootCold1Click(Sender: TObject); -begin -// SendData('REBOOT STOP NODEBUG'); - if(DebugBox.Reboot(DebugBox.rbStop and DebugBox.rbNoDebug,'')) then -// if XClient.Connected then - DebugBox.Disconnect; -// XClient.Disconnect; -end; - -procedure TfrmMain.Stop1Click(Sender: TObject); -begin - DebugBox.SendCmd('STOP'); -end; - -procedure TfrmMain.Go1Click(Sender: TObject); -begin - DebugBox.SendCmd('GO'); -end; - -procedure TfrmMain.lvBreakKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if key = VK_INSERT then - begin - end - else if key = VK_DELETE then - begin - if (lvBreak.ItemIndex >= 0) then - begin - - with lvBreak.Selected do - begin - if(Checked = true) then - SendData(Format('BREAK %s=%s SIZE=%s CLEAR', - [SubItems.Strings[0],Caption,SubItems.Strings[1]])); - {TODO: Delete from BP list in memory} - Delete; - end; - end; - end; -end; - -procedure TfrmMain.bpSetClick(Sender: TObject); -var -NewItem:TListItem; -NewBP:TBreakpoint; -begin - if edBPOffset.Text = '' then Exit; - - if not AnsiStartsStr('0x',edBPOffset.Text) then - edBPOffset.Text := '0x' + edBPOffset.Text; - - if (edBPSize.Text = '') or (StrToInt(edBPSize.Text) <= 0) then edBPSize.Text := '1'; - -// SendData(Format('BREAK %s=%s SIZE=%s',[cmbBPType.Text,edBPOffset.Text,edBPSize.Text])); - - NewBP.Size := StrToInt(edBPSize.Text); - NewBp.Offset := StrToInt64(edBPOffset.Text); - NewBP.Desc := edBPDesc.Text; - NewBP.BPType := TBPTypes(GetEnumValue(TypeInfo(TBPTypes),cmbBPType.Text)); - - SetLength(Breakpoints,Length(Breakpoints)+1); - Breakpoints[High(Breakpoints)] := NewBP; - NewItem := lvBreak.Items.Add; - lvBreak.Items.BeginUpdate; - NewItem.Caption := edBPOffset.Text; - NewItem.SubItems.Add(cmbBPType.Text); - NewItem.SubItems.Add(edBPSize.Text); - NewItem.SubItems.Add('Never'); - NewItem.SubItems.Add(edBPDesc.Text); - NewItem.Data := Pointer(NewItem.Checked); - NewItem.Checked := true; - lvBreak.Items.EndUpdate; - - -end; - -procedure TfrmMain.bpUnsetClick(Sender: TObject); -var -Counter:Integer; -begin - if edBPOffset.Text = '' then Exit; - - if not AnsiStartsStr('0x',edBPOffset.Text) then - edBPOffset.Text := '0x' + edBPOffset.Text; - - if edBPSize.Text = '' then edBPSize.Text := '1'; - - Counter := 0; -repeat - if lvBreak.Items.Count = 0 then Break; - with lvBreak.Items[Counter] do - begin - if Caption = edBPOffset.Text then - begin - if ( (SubItems.IndexOf(edBPSize.Text) >= 0) and - (SubItems.IndexOf(cmbBPType.Text) >= 0) ) then - Checked := false; - - end; - end; - Inc(Counter); -until Counter = lvBreak.Items.Count; -end; - -procedure TfrmMain.ContinueThread1Click(Sender: TObject); -begin - SendData('CONTINUE THREAD=' + InputBox('Which thread?','Which thread do you wish to continue?','28')); -end; - -procedure TfrmMain.ServerExecute(AContext: TIdContext); -var -buf:String; -Index:Integer; -Pos:Integer; -Pos2:Integer; -Off:Cardinal; -HitOff:Cardinal; -BPType:String; -begin - with AContext do - begin - buf := Connection.IOHandler.ReadLn; - if ((AnsiStartsText('data',buf)) or (AnsiStartsText('break',buf))) then - begin - //data write=0x02414d80 addr=0x0007fc5d thread=28 stop - if (AnsiStartsText('data',buf)) then - begin - Pos := AnsiPos('addr=',buf) + 5; - HitOff := StrToInt64Def(AnsiMidStr(buf,Pos,10),0); - - Pos := AnsiPos('data ',buf) + 5; - Pos2 := AnsiPos('=0x',buf); - BPType := AnsiMidStr(buf,Pos,Pos2-Pos); - - Pos := AnsiPos(BPType + '=',buf) + Length(BPType) + 1; - Off := StrToInt64Def(AnsiMidStr(buf,Pos,10),0); - end - else - begin - //break addr=0x0007fc5d thread=28 stop - BPType := 'addr'; - - Pos := AnsiPos('addr=',buf) + 5; - HitOff := StrToInt64Def(AnsiMidStr(buf,Pos,10),0); - - Off := HitOff - end; -{r: . -s: getcontext thread=28 int control -r: 202- multiline response follows -r: Ebp=0xd0059b6c -r: Esp=0xd0059b30 -r: Eip=0x0007fc5d -r: EFlags=0x00000206 -r: Eax=0x00000000 -r: Ebx=0x024148f0 -r: Ecx=0x0134fb20 -r: Edx=0x004b2a60 -r: Edi=0xd0059b14 -r: Esi=0xd0059b48} - -{TODO: Get registers} - Log.AddLn(Format('Breakpoint detected (%s,0x%.80x,0x%.80x).',[BPType,Off,HitOff])); - - for index := 0 to High(Breakpoints) do - begin - if ((Breakpoints[Index].Offset = Off) and - (Breakpoints[Index].BPType = TBPTypes(GetEnumValue(TypeInfo(TBPTypes),BPType)))) then - begin - lvBreak.Items.Item[Index].SubItems.Strings[2] := '0x' + IntToHex(HitOff,8); - end; - end; - ProgStatus := stGetContext; - SendData('GETCONTEXT thread=28 int control'); - - end - else - begin - Log.AddLn('n: ' + buf); - end; - end; -end; - -procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); -var -iniSet:TINIFile; -Counter:Integer; -begin - iniSet := TINIFile.Create(ExtractFilePath(Application.EXEName) + 'xdkassist.ini'); - iniSet.WriteString('Connection','Host',XClient.Host); - iniSet.WriteInteger('Connection','Port',Server.defaultport); - iniSet.WriteBool('Dumping','AutoStop',chkDumpAutoStop.Checked); - iniSet.WriteBool('Dumping','AutoCopy',chkCopyOffToClip.Checked); - iniSet.WriteBool('Dumping','Highlight',chkHighlightDumpChanges.Checked); - iniSet.WriteBool('Logging','Verbose',chkVerboseLog.Checked); - iniSet.WriteString('Breakpoints','Type',cmbBPType.Text); - iniSet.WriteInteger('Window','State',Integer(frmMain.WindowState)); - if(frmMain.WindowState = wsMaximized) then - frmMain.WindowState := wsNormal; - iniSet.WriteInteger('Window','Width',frmMain.Width); - iniSet.WriteInteger('Window','Height',frmMain.Height); - iniSet.WriteInteger('Window','LastTab',pgControl.ActivePageIndex); - iniSet.WriteInteger('Window','State',Integer(frmMain.WindowState)); - - iniSet.WriteBool('Misc','WarnConClose',chkWarnConnected.Checked); - iniSet.WriteBool('Layout','ShowMainLog',chkShowMainLog.Checked); - - - iniSet.WriteBool('Range','Enabled',chkUseSearchRange.Checked); - iniSet.WriteString('Range','Start',edSearcherStart.Text); - iniSet.WriteString('Range','End',edSearcherEnd.Text); - iniSet.WriteString('Range','Caption',edSearcherCaption.Text); - iniSet.WriteString('Range','Class',edSearcherClass.Text); - iniSet.WriteString('Range','State',edSearcherState.Text); - - for Counter:=0 to High(Tools) do - begin - With Tools[Counter] do - begin - iniSet.WriteString('Tool' + IntToStr(Counter),'Name',Name); - iniSet.WriteString('Tool' + IntToStr(Counter),'Class',WinClass); - iniSet.WriteString('Tool' + IntToStr(Counter),'Caption',WinText); - iniSet.WriteBool('Tool' + IntToStr(Counter),'Load',Load); - end; - end; - - FreeAndNil(iniSet); - - while not ClientThread.Terminated do - begin - ClientThread.Terminate; - if not ClientThread.Terminated then - begin - ShowMessage('Internet thread not terminated. Waiting, and then will try again.' - + 'If you continue to get this message I am afraid you must end the task manually.'); - Sleep(2000); - end; - - end; - if Assigned(SavedDump) then FreeAndNil(SavedDump); -end; - -procedure FillDumpPages(hDump:HWND); -var -Read:String; -begin -with DebugBox.Memory do -begin - SetLength(Sections,0); - SetLength(DebugBox.Memory.Sections,0); - Read := ''; - while (Read <> '.') and - Assigned(frmMain.XClient) and - (not frmMain.ClientThread.Terminated) and - (frmMain.XClient.Connected = true) do - begin - try - Read := frmMain.XClient.IOHandler.ReadLn; - except - on E: Exception do - begin - if (E is EIdReadTimeout) or (E is EIdNoDataToRead) then Continue - else if E is EIdConnClosedGracefully then - begin - SetLength(Sections,0); - Exit; - end - else - Log.AddLn(E.Message); - end; - end; - - if (Read = '') or (Read = '.') then Continue; - SetLength(Sections,Length(Sections)+1); - with Sections[High(Sections)] do - begin - Offset := StrToInt( AnsiMidStr(Read,AnsiPos('base=',Read) + Length('base='),10)); - Size := StrToInt( AnsiMidStr(Read,AnsiPos('size=',Read) + Length('size='),10)); - Flags := StrToInt( AnsiMidStr(Read,AnsiPos('protect=',Read) + Length('protect='),10)); - Loc := 0; - end; - end; -end; -end; - -procedure GetDumpData(hProgress:HWND;hWin:HWND;Verbose:Boolean); -var -Counter:Cardinal; -NewSize:Cardinal; -Time:Cardinal; -MemStream:TMemoryStream; -begin -// MemBuffer.Clear; - DebugBox.Memory.Buffer.Clear; - if(frmMain.hxMemView.DataSize > 0) then - begin - frmMain.hxMemView.CreateEmptyFile(''); - end; -with DebugBox.Memory do -begin - NewSize := 0; - for Counter := Low(Sections) to High(Sections) do - NewSize := NewSize + Sections[Counter].Size; - - PostMessage(hProgress,PBM_SETRANGE32,0,High(Sections)); - - //MemBuffer.SetSize(NewSize); - DebugBox.Memory.Buffer.SetSize(NewSize); -try -begin - MemStream := TMemoryStream.Create; - if (not Assigned(MemStream)) then - begin - log.addln('Failed to create memory stream for dumping.'); - Exit; - end; - - for Counter := 0 to High(Sections) do - begin - with Sections[Counter] do - begin - Time := GetTickCount; - MemStream.Clear; - MemStream.SetSize(Size); - - frmMain.XClient.IOHandler.WriteLn(Format('GETMEM2 ADDR=0x%.8x LENGTH=0x%.8x',[Offset,Size])); - while (frmMain.XClient.IOHandler.ReadLn <> '203- binary response follows') and (frmMain.XClient.Connected) do; - while (Cardinal(frmMain.XClient.IOHandler.InputBuffer.Size) < Size) and (frmMain.XClient.Connected) do; - - frmMain.XClient.IOHandler.ReadStream(MemStream,Size); - PostMessage(hProgress,PBM_SETPOS,Counter,0); - - try - begin -// MemBuffer.CopyFrom(MemStream,0); - DebugBox.Memory.Buffer.CopyFrom(MemStream,0); -// Loc := Membuffer.Position; - Loc := DebugBox.Memory.Buffer.Position; - if Verbose then - Log.AddLn(Format('Dumped %d bytes in %.2f seconds from 0x%.8x (0x%.8x)', - [Size,(GetTickCount-Time)/1000,Offset, - //Cardinal(MemBuffer.Memory) - Cardinal(DebugBox.Memory.Buffer.Memory) - + Loc-Size])); - end - except - on E: Exception do - log.AddLn('Dump (MemStream): ' + E.Message); - end; - - if (not frmMain.XClient.IOHandler.InputBufferIsEmpty) and - (frmMain.XClient.Connected = true) then - begin - Log.AddLn(IntToStr(frmMain.XClient.IOHandler.InputBuffer.size) + ' bytes still on input buffer.'); - frmMain.XClient.IOHandler.ReadStream(MemStream,frmMain.XClient.IOHandler.InputBuffer.Size); - end; - end; - end; - FreeAndNil(MemStream); -end -except - on E: Exception do - Log.AddLn('Dump: ' + E.Message); -end; -end; -end; - -procedure TfrmMain.edBPOffsetKeyPress(Sender: TObject; var Key: Char); -begin - if (not IsValidHexBoxInput(Key)) and (not (Key in ['x','X'])) then - Key := #0; -end; - -procedure TfrmMain.edBPSizeKeyPress(Sender: TObject; var Key: Char); -begin - if not (Key in ['0'..'9',Char(VK_BACK),Char(VK_DELETE)]) then Key := #0; -end; -{ -function LaunchAsChild(EXEName:String;EXEClass:PAnsiChar;EXECaption:PAnsiChar;Parent:HWND):HWND; -var -Win:HWND; -r:TRect; -GWL:LongInt; -begin - Result := 0; - if (not FileExists(EXEName)) then Exit; - - Win := FindWindow(EXEClass,EXECaption); - - if Win = 0 then - begin - ShellExecute(Parent,'open',PAnsiChar(EXEName),#0,#0,SW_HIDE); - Sleep(150); - Win := FindWindow(EXEClass,EXECaption); - if Win = 0 then Exit; - end; - ShowWindow(Win,SW_HIDE); - SetParent(Win,Parent); - - ShowWindow(Win,SW_HIDE); - SetParent(Win,Parent); - - GWL := GetWindowLong(Win,GWL_STYLE); - -{ if (GWL and WS_BORDER) = WS_BORDER then - GWL := GWL and (not WS_BORDER); - if (GWL and WS_OVERLAPPEDWINDOW) = WS_OVERLAPPEDWINDOW then - GWL := GWL and (not WS_OVERLAPPEDWINDOW); - if (GWL and WS_DLGFRAME) = WS_DLGFRAME then - GWL := GWL and (not WS_DLGFRAME); -} { if (GWL and WS_THICKFRAME) = WS_THICKFRAME then - GWL := GWL and (not WS_THICKFRAME); - if (GWL and WS_POPUP) = WS_POPUP then - GWL := GWL and (not WS_POPUP); } -{ if (GWL and WS_MINIMIZEBOX) = WS_MINIMIZEBOX then - GWL := GWL and (not WS_MINIMIZEBOX); -} { if (GWL and WS_MAXIMIZEBOX) = WS_MAXIMIZEBOX then - GWL := GWL and (not WS_MAXIMIZEBOX); } -{ if (GWL and WS_SYSMENU) = WS_SYSMENU then - GWL := GWL and (not WS_SYSMENU); -}{ if (GWL and WS_OVERLAPPED) = WS_OVERLAPPED then - GWL := GWL and (not WS_OVERLAPPED); } -{ if (GWL and WS_CAPTION) = WS_CAPTION then - GWL := GWL and (not WS_CAPTION); } -// GWL := GWL or WS_CHILD; - { SetWindowLong(Win,GWL_STYLE,GWL); - - GWL := GetWindowLong(Win,GWL_EXSTYLE); - if (GWL and WS_EX_CLIENTEDGE) = WS_EX_CLIENTEDGE then - GWL := GWL and (not WS_EX_CLIENTEDGE); - if (GWL and WS_EX_DLGMODALFRAME) = WS_EX_DLGMODALFRAME then - GWL := GWL and (not WS_EX_DLGMODALFRAME); - if (GWL and WS_EX_APPWINDOW) = WS_EX_APPWINDOW then - GWL := GWL and (not WS_EX_APPWINDOW); } - -// GWL := GWL or WS_EX_TOOLWINDOW; -{ GWL := GWL or WS_EX_STATICEDGE; - GWL := GWL or WS_EX_CONTROLPARENT; - SetWindowLong(Win,GWL_EXSTYLE,GWL); - - GetWindowRect(Win,r); - ShowWindow(Win,SW_SHOW); - MoveWindow(Win,0,0,r.Right-r.Left+1,r.Bottom-r.Top,true); - - Result := Win; -end; - } -procedure TfrmMain.FormDestroy(Sender: TObject); -var -Counter:Integer; -begin - for Counter := 0 to Length(Tools)-1 do - if Tools[Counter].Handle <> 0 then PostMessage(Tools[Counter].Handle, WM_QUIT,0,0); - - if (moNotes.Lines.Count > 0) then - moNotes.Lines.SaveToFile('xdkassist.notes') - else - if FileExists('xdkassist.notes') then DeleteFile('xdkassist.notes'); -end; - -procedure TfrmMain.ConnectToggle(Tog:Boolean); -begin - ProgStatus := stNorm; - - try - if Server.DefaultPort <> -1 then - Server.Active := tog; - except - on E: Exception do Log.AddLn('Server Toggle: ' + E.Message); - end; - - hxMemView.Enabled := Tog; - edInput.Enabled := Tog; - lvBreak.Enabled := Tog; - lvDump.Enabled := Tog; - edBPOffset.Enabled := Tog; - edBPDesc.Enabled := Tog; - edBPSize.Enabled := Tog; - cmbBPType.Enabled := Tog; - bpSet.Enabled := Tog; - bpUnset.Enabled := Tog; - grpConvOffset.Enabled := Tog; - grpMemEdit.Enabled := Tog; - pbDump.Enabled := Tog; - lbBPType.Enabled := Tog; - edViewoffset.Enabled := Tog; - edByteSearch.Enabled := Tog; - btMemSrchReset.Enabled := Tog; - lvRegisters.Enabled := Tog; - btGetRegisters.Enabled := Tog; - - if Tog then - begin - try - ClientThread.Start; - except - on E: Exception do Log.AddLn('Recv Startup: ' + E.Message); - end; - frmmain.Connect1.Caption := 'Disconnect'; - frmMain.Connect1.ImageIndex := 6; - end - else - begin - ClientThread.Stop; - frmmain.Connect1.Caption := 'Connect'; - frmMain.Connect1.ImageIndex := 7; - - lvBreak.Items.Clear; - lvDump.Items.Clear; - pbDump.Position := 0; -// MemBuffer.Clear; - DebugBox.Memory.Buffer.Clear; - SavedDump.Clear; -// if hxMemView.DataSize > 0 then -// hxMemView.LoadFromStream(SavedDump); -// hxMemView.CreateEmptyFile('Empty'); - - end; -end; - -procedure TfrmMain.OnNewText(var Msg: TMessage); -var -Change:String; -begin - try - begin - if (Msg.WParam < 0) then Exit; - Log.Seek(Msg.WParam,soFromBeginning); - Change := Log.ReadString(Msg.Lparam); - richlog.SelStart := richlog.GetTextLen; - richLog.SelText := Change; - end - except - on E: Exception do ShowMessage('Logging update: ' + E.Message); - end; -end; - -procedure TfrmMain.edViewOffsetKeyPress(Sender: TObject; var Key: Char); -begin - if (not IsValidHexBoxInput(Key)) and (not (Key in ['x','X'])) then Key := #0; -end; - -procedure TfrmMain.edViewOffsetKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -var -Off:Cardinal; -Sect:Integer; -ret:Integer; -begin - if Key <> VK_RETURN then Exit; - - if AnsiPos('0X',edViewOffset.Text) <= 0 then - edViewOffset.Text := Format('0x%.8x',[StrToInt64Def('0x' + edViewOffset.Text,0)]); - - //if (MemBuffer.Size <= 0) or - // (Length(Sections) <= 0) then - if (DebugBox.Memory.Buffer.Size <= 0) or - (Length(DebugBox.Memory.Sections) <= 0) then - begin - log.AddLn('There is no dump.'); - Exit; - end; - - ret := ConvXBOX2PC(StrToInt64Def(edViewOffset.Text,0),@Sect,@Off); - if ret <> EConvOkay then - log.AddLn(ConvError(ret)); - - if (Sect >= 0) then - hxMemView.SetTopLeftPosition(Off - - //Cardinal(Membuffer.Memory) - Cardinal(DebugBox.Memory.Buffer.Memory) - ,false); - -end; - -procedure TfrmMain.edByteSearchKeyPress(Sender: TObject; var Key: Char); -begin - if not IsValidHexBoxInput(Key) then Key := #0; -end; - -procedure TfrmMain.edByteSearchKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -var -BinBuf:PAnsiChar; -BinLen:Integer; -begin - if Key <> VK_RETURN then Exit; - - BinLen := Length(edByteSearch.Text) div 2 + Length(edByteSearch.Text) mod 2; - - if (BinLen <= 0) or - //(MemBuffer.Size <= 0) - (DebugBox.Memory.Buffer.Size <= 0) - then Exit; - - BinBuf := StrAlloc(BinLen); - - HexToBin(PAnsiChar(edByteSearch.Text),BinBuf,BinLen); - - BinBuf := PansiChar(hxMemView.PrepareFindReplaceData(String(BinBuf),false,false)); - - MemSrchPos := hxMemView.Find(BinBuf,BinLen,MemSrchPos,hxMemView.DataSize,false); - - if MemSrchPos > -1 then - begin - hxMemView.Seek(MemSrchPos,0); - hxMemView.SelStart := MemSrchPos; - hxMemView.SelEnd := MemSrchPos + BinLen - 1; - Inc(MemSrchPos); - end - else - log.AddLn('Pattern not found.'); - -end; - -procedure TfrmMain.OnNewDump(var Msg:TMessage); -var -Count:Integer; -ti:TListItem; -Searcher:THandle; -pid:Cardinal; -phandle:THandle; -data:Cardinal; -bytes:Cardinal; -off:Cardinal; -state:WORD; -begin - try - begin - hxMemView.OffsetFormat := '1%1!10:0x|'; -// hxMemView.LoadFromStream(MemBuffer); - hxMemView.LoadFromStream(DebugBox.Memory.Buffer); - - PostMessage(ProgressBar,PBM_SETPOS, - SendMessage(ProgressBar,PBM_GETRANGE,wparam(false),lparam(nil)),0); - - if chkDumpAutoStop.Checked then SendData('GO'); - -// for Count := 0 to High(Sections) do - for Count := 0 to High(DebugBox.Memory.Sections) do - begin - with DebugBox.Memory.Sections[Count] do -// with Sections[Count] do - begin - ti := lvDump.Items.Add; - ti.Caption := IntToStr(ti.Index+1); - ti.SubItems.Add('0x' + IntToHex(Offset,8));//Offset - ti.SubItems.Add('0x' + IntToHex(Size,8));//Size - ti.SubItems.Add('0x' + IntToHex(Flags,8));//Flags -// ti.SubItems.Add('0x' + IntToHex(Cardinal(MemBuffer.Memory) + Loc-Size,8));//Start -// ti.SubItems.Add('0x' + IntToHex(Cardinal(MemBuffer.Memory) +Loc,8));//End - ti.SubItems.Add('0x' + IntToHex(Cardinal(DebugBox.Memory.Buffer.Memory) + Loc - Size, 8)); - ti.SubItems.Add('0x' + IntToHex(Cardinal(DebugBox.Memory.Buffer.Memory) + Loc, 8)); - end; - end; - - end - except - on E: Exception do log.Addln(E.Message); - end; - - ProgStatus := stNorm; - - if(chkUseSearchRange.Checked) then - begin - Searcher := FindWindow(PAnsiChar(edSearcherClass.Text+#0),PAnsiChar(edSearcherCaption.Text+#0)); - if(Searcher <> 0) then - begin - GetWindowThreadProcessId(Searcher,@pid); - phandle := OpenProcess(PROCESS_ALL_ACCESS,false,pid); - if phandle <> 0 then - begin - off := StrToInt64(MakeOffset(edSearcherStart.Text)); - if (off <> 0) then - begin -// data := Cardinal(MemBuffer.Memory); - data := Cardinal(DebugBox.Memory.Buffer.Memory); - WriteProcessMemory(phandle,Pointer(off),@data,4,bytes); - end; - - off := StrToInt64(MakeOffset(edSearcherEnd.Text)); - if (off <> 0) then - begin -// data := Cardinal(MemBuffer.Memory) + Cardinal(MemBuffer.Size); - Data := Cardinal(DebugBox.Memory.Buffer.Memory) + Cardinal(DebugBox.Memory.Buffer.Size); - WriteProcessMemory(phandle,Pointer(off),@data,4,bytes); - end; - - off := StrToInt64(MakeOffset(edSearcherState.Text)); - if (off <> 0) then - begin - state := 1; - WriteProcessMemory(phandle,Pointer(off),@state,2,bytes); - end; - - log.AddLn(Format('Patched %s (%s) at %s and %s',[edSearcherCaption.Text,edSearcherClass.Text,edSearcherStart.Text,edSearcherEnd.Text])); - CloseHandle(phandle); - end - else - log.addln('Couldn''t set range in your search application. Is it running?') - end - else - log.addln('Couldn''t set range in your search application. Is it running?') - end; -end; - -procedure TfrmMain.btMemSrchResetClick(Sender: TObject); -begin - MemSrchPos := 0; -end; - -function IsValidHexBoxInput(var Key: Char):Boolean; -begin - Result := false; - - if (Key in ['A'..'F','a'..'f','0'..'9',Char(VK_BACK),Char(VK_DELETE)]) or - (Key in ['V','v','X','x'{,#22,#3,#24}]) or - (Key < ' ') then Result := true; - -end; - -function IsValidIP(const AAddr : String): Boolean; -var LIP : TIdIPAddress; -begin - LIP := TIdIPAddress.MakeAddressObject(AAddr); - Result := Assigned(LIP); - if Result then - begin - FreeAndNil(LIP); - end; -end; - -procedure TfrmMain.SetXBOXAddress1Click(Sender: TObject); -var -NewIP:String; -begin - NewIP := InputBox('Enter a new IP','Enter in the new address for your XBOX.',XClient.Host); - - while (not IsValidIP(NewIP)) do - begin - if InputQuery('Enter a new, valid, IP.', - 'The IP that was entered into the box was invalid. Please enter a new one.', - NewIP) = false then Exit; - end; - - XClient.Host := NewIP; -end; - -procedure TfrmMain.SetListenPort1Click(Sender: TObject); -var -NewPort:String; -begin - NewPort := InputBox('Enter a new port.','Type in the port you would like the XBOX to connect to your machine on.' + #13#10 + - 'Enter -1 if you want to disable this feature, however this is not recommended because you will miss out in nice information, and ' + - 'some features will not work properly.',IntToStr(Server.DefaultPort)); - - while not IsNumeric(NewPort) do - begin - if InputQuery('Enter a new, valid, port', - 'The port that was entered into the box was invalid. Please enter a new one.', - NewPort) = false then Exit; - end; - - Server.DefaultPort := StrToInt(NewPort); -end; - -procedure TfrmMain.JumpbyXBOXAddress1Click(Sender: TObject); -var -Offset:String; -begin - if InputQuery('Jump by XBOX addy.','This will let you jump around the dump using an xbox address.',Offset) = false then Exit; - -end; - -procedure TfrmMain.JumpbyPCAddress1Click(Sender: TObject); -var -Offset:String; -begin - if InputQuery('Jump by PC addy.','This will let you jump around the dump using a PC address.',Offset) = false then Exit; - -end; - -procedure TfrmMain.SavetoFile1Click(Sender: TObject); -var -CurDir:String; -begin - CurDir := GetCurrentDir; - SaveDialog.InitialDir := GetCurrentDir; - - if SaveDialog.Execute then - begin - hxMemView.SaveToFile(SaveDialog.FileName); - log.addln('Saved the dump to ' + SaveDialog.filename); - SetCurrentDir(CurDir); - end; - -end; - -procedure TfrmMain.hxMemViewChange(Sender: TObject); -var -Pos:Integer; -Mem:Char; -XBOX:Cardinal; -begin - if(not XClient.Connected) then Exit; - if(ProgStatus = stDump) then Exit; - Pos := hxMemView.GetCursorPos; - Mem := hxMemView.GetMemory(Pos); -// Pos := ConvPC2XBOX(Cardinal(MemBuffer.Memory) + Cardinal(Pos),@xbox); - Pos := ConvPC2XBOX(Cardinal(DebugBox.Memory.Buffer.Memory) + Cardinal(Pos),@XBOX); - if (Pos <> EConvOkay) then - Log.AddLn(ConvError(Pos)) - else - SendData(Format('SETMEM ADDR=0x%.80x DATA=%s',[xbox,IntToHex(Integer(Mem),2)])); -end; - -procedure TfrmMain.cbMemEditChange(Sender: TObject); -begin - if (cbMemEdit.Text = 'GETMEM') then - edMemEditParam.EditLabel.Caption := 'Length:' - else - edMemEditParam.EditLabel.Caption := 'Data:'; - -end; - -procedure TfrmMain.btMemEditClick(Sender: TObject); -begin - if(cbMemEdit.Text = 'GETMEM') then - SendData(Format('GETMEM ADDR=0x%s LENGTH=%s',[edMemEditOffset.Text,edMemEditParam.Text])) - else //Setmem - SendData(Format('SETMEM ADDR=0x%s DATA=%s',[edMemEditOffset.Text,edMemEditParam.Text])); -end; - -procedure TfrmMain.edConvOffsetFromKeyPress(Sender: TObject; var Key: Char); -begin - if (not IsValidHexBoxInput(Key)) and (not (Key in ['x','X'])) then Key := #0; -end; - -procedure TfrmMain.edConvOffsetFromKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -var -ConvOffset:Cardinal; -Original:Cardinal; -Ret:Integer; -begin - if Key <> VK_RETURN then Exit; - - if (not IsHexidecimal(edConvOffsetFrom.Text) and - (not IsNumeric(edConvOffsetFrom.Text))) then - begin - lbConvOffStat.Caption := 'Bad input'; - Log.AddLn('An invalid input string was specified. Please make sure that the string was a hexidecimal string. The 0x is optional.'); - Exit; - end; - - if (not AnsiStartsStr('0X',Uppercase(edConvOffsetFrom.Text))) then - edConvOffsetFrom.Text := '0x' + edConvOffsetFrom.Text; - - Original := StrToInt(edConvOffsetFrom.Text); - - if(cbOffsetConvert.Text = 'PC') then begin - Ret := ConvPC2XBOX(Original,@ConvOffset); - end else begin //XBOX - Ret := ConvXBOX2PC(Original,nil,@ConvOffset); - end; - - case Ret of - EConvOkay: lbConvOffStat.Caption := 'Converted.'; - EConvNotFound: lbConvOffStat.Caption := 'Not found.'; - EConvBadPointer: lbConvOffStat.Caption := 'Bad pointer.'; - EConvOutOfRange: lbConvOffStat.Caption := 'Out of range.'; - EConvNoSections: lbConvOffStat.Caption := 'Missing sections.'; - end; - - if (Ret <> EConvOkay) then - begin - Log.AddLn(ConvError(ret)); - end - else - begin - Log.AddLn(edConvOffsetFrom.Text + ' converted to 0x' + IntTohex(ConvOffset,8)); - edConvOffsetTo.Text := '0x' + IntTohex(ConvOffset,8); - if (chkCopyOffToClip.Checked) then - TextToClip(IntToHex(ConvOffset,8)); - end; - -end; - -procedure TfrmMain.edMemEditParamKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if Key <> VK_RETURN then Exit; - - btMemEditClick(Sender); - -end; - -procedure TfrmMain.GenericMenuItemClick(Sender: TObject); -begin - - if ((TMenu(Sender).Tag < Low(Tools)) or (TMenu(Sender).Tag > High(Tools))) then - begin - Log.AddLn('Tool index was out of valid range.'); - Exit; - end; - - with Tools[TMenu(Sender).Tag] do - begin -{ if( Load ) then - LaunchAsChild(Name,PAnsiChar(WinClass+#0),PAnsiChar(WinText+#0),frmMain.Handle) - else} - ShellExecute(0{frmMain.Handle},'open',PAnsiChar(Name),#0,#0,SW_NORMAL); - end; -end; - -procedure TfrmMain.lvBreakChange(Sender: TObject; Item: TListItem; - Change: TItemChange); -var -buf:String; -begin - if ( Change <> ctState) then Exit; - - if (Boolean(Item.Data) <> Item.Checked) then - begin - buf := Format('BREAK %s=%s SIZE=%s', - [Item.SubItems.Strings[0], - Item.Caption, - Item.SubItems.Strings[1]]); - - if (not Item.Checked) then - buf := buf + ' CLEAR'; - SendData(buf); - Item.Data := Pointer(Item.Checked); - end; -end; - -procedure TfrmMain.lvDumpSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); -var -Flags:Cardinal; -begin - if not Selected then Exit; - - for Flags := 0 to lbSectFlags.Items.Count-1 do - lbSectFlags.Checked[Flags] := false; - - Flags := StrToInt64Def(Item.SubItems.Strings[2],0); - - if (Flags and PAGE_NOACCESS) = PAGE_NOACCESS then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_NOACCESS')] := true; - - - if (Flags and PAGE_READONLY) = PAGE_READONLY then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_READONLY')] := true; - - if (Flags and PAGE_READWRITE) = PAGE_READWRITE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_READWRITE')] := true; - - if (Flags and PAGE_EXECUTE) = PAGE_EXECUTE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_EXECUTE')] := true; - - if (Flags and PAGE_EXECUTE_READ) = PAGE_EXECUTE_READ then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_EXECUTE_READ')] := true; - - if (Flags and PAGE_EXECUTE_READWRITE) = PAGE_EXECUTE_READWRITE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_EXECUTE_READWRITE')] := true; - - if (Flags and PAGE_GUARD) = PAGE_GUARD then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_GUARD')] := true; - - if (Flags and PAGE_NOCACHE) = PAGE_NOCACHE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_NOCACHE')] := true; - - if (Flags and PAGE_WRITECOMBINE) = PAGE_WRITECOMBINE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('PAGE_WRITECOMBINE')] := true; - - if (Flags and MEM_COMMIT) = MEM_COMMIT then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_COMMIT')] := true; - - if (Flags and MEM_DECOMMIT) = MEM_DECOMMIT then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_DECOMMIT')] := true; - - if (Flags and MEM_RELEASE) = MEM_RELEASE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_RELEASE')] := true; - - if (Flags and MEM_RESERVE) = MEM_RESERVE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_RESERVE')] := true; - - if (Flags and MEM_FREE) = MEM_FREE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_FREE')] := true; - - if (Flags and MEM_PRIVATE) = MEM_PRIVATE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_PRIVATE')] := true; - - if (Flags and MEM_MAPPED) = MEM_MAPPED then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_MAPPED')] := true; - - if (Flags and MEM_RESET) = MEM_RESET then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_RESET')] := true; - - if (Flags and MEM_TOP_DOWN) = MEM_TOP_DOWN then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_TOP_DOWN')] := true; - - if (Flags and MEM_LARGE_PAGES) = MEM_LARGE_PAGES then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_LARGE_PAGES')] := true; - - if (Flags and MEM_4MB_PAGES) = MEM_4MB_PAGES then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('MEM_4MB_PAGES')] := true; - - if (Flags and SEC_RESERVE) = SEC_RESERVE then - lbSectFlags.Checked[lbSectFlags.Items.IndexOf('SEC_RESERVE')] := true; - -end; -procedure TfrmMain.btDumpClick(Sender: TObject); -begin - DumpMemory1Click(Sender); -end; - -procedure TfrmMain.RestartTitle1Click(Sender: TObject); -begin - if (DebugBox.XBE.Name <> '') then - DebugBox.Reboot(0,DebugBox.XBE.Name) -// if (XBEName <> '') then -// SendData('magicboot title="'+XBEName+'" debug') - else - Log.AddLn('Please run the XBE Info command from the menu first.'); - -end; - -procedure TfrmMain.lvBreakSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); -begin - edBPOffset.Text := Item.Caption; - edBPSize.Text := Item.SubItems.Strings[1]; - edBPDesc.Text := Item.SubItems.Strings[3]; - cmbBPType.ItemIndex := cmbBPType.Items.IndexOf(Item.SubItems.Strings[2]); - -end; - -procedure TfrmMain.SaveLog1Click(Sender: TObject); -begin - Log.SaveToFile('xdkassist.log'); -end; - -procedure TfrmMain.hxMemViewTopLeftChanged(Sender: TObject); -var -i:Integer; -DStart,DEnd:Integer; -begin - if (not chkHighlightDumpChanges.Checked) or - (SavedDump.Size <= 0) or - (hxMemView.DataSize <= 0) then Exit; - - - DStart := hxMemView.DisplayStart; - DEnd := hxMemView.DisplayEnd; - - if ((DStart > SavedDump.Size) or (DEnd > SavedDump.Size)) then - begin - //New dump is larger than old dump - for i := DStart to DEnd do - begin - if (i > hxMemView.DataSize-1) then break; - hxMemView.ByteChanged[i] := true; - end; - Exit; - end; - - for i := DStart to DEnd do - begin - if (i > hxMemView.DataSize-1) then break; - - if ((PByteArray(SavedDump.Memory)[i]) <> hxMemView.Data[i]) then - hxMemView.ByteChanged[i] := true; - end; -end; - -procedure TfrmMain.btGetRegistersClick(Sender: TObject); -begin - if(not XClient.Connected) then Exit - else if (ProgStatus <> stNorm) then - begin - log.AddLn('Busy with another action.'); - Exit; - end; - - ProgStatus := stGetContext; - - SendData('HALT'); - SendData('GETCONTEXT THREAD=28 CONTROL INT FP'); - SendData('CONTINUE THREAD=28'); - SendData('GO'); -end; - -procedure TfrmMain.chkShowMainLogClick(Sender: TObject); -begin - if chkShowMainLog.Checked then - begin - pgControl.Top := grpConsole.Top + grpConsole.Height + pgControl.Left; - pgControl.Height := frmMain.ClientHeight - (pgControl.Left * 4) - grpConsole.height; - grpConsole.Visible := true; - end - else - begin - grpConsole.Visible := false; - pgControl.Top := grpConsole.Top; - pgControl.Height := frmMain.ClientHeight - (pgControl.left*3); - end; - - -end; - -procedure TfrmMain.btnToolSelectClick(Sender: TObject); -begin - odToolSelect.FileName := ''; - if not odToolSelect.Execute() then Exit; - edToolPath.Text := odToolSelect.FileName; -end; - -end. diff --git a/src/MainForm.dfm b/src/MainForm.dfm new file mode 100644 index 0000000..03389a8 --- /dev/null +++ b/src/MainForm.dfm @@ -0,0 +1,403 @@ +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'XDK Assist v2' + ClientHeight = 253 + ClientWidth = 348 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object tsTabs: TTabSet + Left = 0 + Top = 209 + Width = 348 + Height = 25 + Align = alBottom + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ShrinkToFit = True + SoftTop = True + Style = tsSoftTabs + Tabs.Strings = ( + 'Main' + 'Dump' + 'Debug' + 'Settings') + TabIndex = 0 + OnChange = tsTabsChange + end + object nbMaintabs: TNotebook + Left = 0 + Top = 0 + Width = 348 + Height = 209 + Align = alClient + TabOrder = 1 + OnPageChanged = nbMaintabsPageChanged + object TPage + Left = 0 + Top = 0 + Caption = 'Main' + DesignSize = ( + 348 + 209) + object edInput: TEdit + Left = 8 + Top = 182 + Width = 330 + Height = 21 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 0 + OnKeyPress = edInputKeyPress + end + object memoLog: TMemo + Left = 8 + Top = 8 + Width = 330 + Height = 168 + Anchors = [akLeft, akTop, akRight, akBottom] + ScrollBars = ssVertical + TabOrder = 1 + end + end + object TPage + Left = 0 + Top = 0 + Caption = 'Dump' + ExplicitWidth = 0 + ExplicitHeight = 0 + DesignSize = ( + 348 + 209) + object lbDumpProg: TLabel + Left = 8 + Top = 16 + Width = 258 + Height = 13 + Anchors = [akLeft, akTop, akRight] + AutoSize = False + Caption = 'Progress: 0/0KB - 0%' + EllipsisPosition = epWordEllipsis + end + object pbDumpStatus: TProgressBar + Left = 9 + Top = 32 + Width = 257 + Height = 17 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + end + object btnDump: TBitBtn + Left = 272 + Top = 16 + Width = 65 + Height = 33 + Anchors = [akTop, akRight] + TabOrder = 1 + Glyph.Data = { + 76080000424D7608000000000000360000002800000020000000160000000100 + 18000000000040080000C40E0000C40E00000000000000000000FFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFF9F9F7EBECF0F3F4F0EBECEAD1D1D2CECECEA7A7A7C2C2C1AA + ACAE8D8D8C8787869696959697997676756B6B6B6F6F6DE7E7E5FFFFFE787A76 + 7D7D7E6667685152503535347174753F41417778788687857375777A7B768486 + 858F90907E7F80A9A9AD4E4F460000000000000000000000004E51534245488A + 8E910000000000006C6F724D4E4B909295FFFFFFFEFEFEFFFFFFFFFFFFFFFFFF + 4B4B490000000000005D5F6270716E6F6F6D494A4B4F514E7A7B7F5151503B3B + 3B0000007A7E80474A438083884E504F53565700000000000067696A95958E41 + 423F48494D5153565556515454555A5D5FFFFFFFFFFFFFFFFFFFFFFFFFCDCECE + 1B1B1B29292A07060777797B4C4D4C37393347494E7B796996978AC2C1BBE6E7 + E96363605A5C5F5D5F5F868990666B646E71760000000E0E0B8083860D0E0B2B + 2C2D515354494B4755575A0B0B0A525557D8D8D8C1C1BFFFFFFFECECED000000 + 3334383B3E363E443B53565B7F807C8A8B8714161ABEBBA3858986D7D6D5878C + 817B7B7A64676C7072716163655B5E5E5D5F620000001D1E1C393B377274786C + 6F711718151D1E1A4749476264691A191A000000000000FFFFFFFFFFFF000000 + 0000008EA57974885F20201D313531292C2B626552817E776B6F6790908B5857 + 4D4546433132312627252A2B281A1A1B71727388898C0D0E081E1E1D0D0E0D00 + 00001E1F1A11110E00000011140D7D8A6C3F3C39000000FFFFFFFFFFFF383938 + 000000829B6B908E8E8A91847F7F7681807881847BCECFCED3D4D3D5D6D8ADAE + A0838483FFFFFFFCFCFCFBFBFBFEFEFEFFFFFF6565664848475656560F0E0B34 + 37300C0D0900000041453A9CB98286A36F8F8A84000000FFFFFFFFFFFF5D5F56 + 0000006B8453BFBCC2D7D7D8D3D4D5D7D8D8B3B5B8D5D5D2C8C9C8DBDCDC9092 + 936D6C6CFFFFFFFFFFFFFFFFFFFFFFFFD9D9D750504A5454570508013F443600 + 000016171488A371929084697A5988A1717F8B6F1F1C1AFFFFFFFFFFFFE2E2E0 + 6E76624D5841B3B2B3A3A5A3BBBAB4B3B5B8939595676A6BBFC0BF83837C676E + 60686768FFFFFFFFFFFFFFFFFFFFFFFFA4A49F0000012E3526383E2F00000042 + 3F3C8EA77788A072778967716B6888A37289A673575449FAF9FAFFFFFFFFFFFF + FFFFFFFAF9FCD9D9D8D6D5D3C4C5C38C865FE5E0CF6C69598B886EFFFFF55053 + 53F0F0F0FFFFFFFFFFFFFFFFFF232320000100454D3B0F100D00000080966B7E + 8D6C84877887A17085A06F868377657755697D58545749F0F0F3FFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFDAD8CCC3BB92FFFFFF9A947AA7A086F7F0D09A9B + A0FFFFFFFFFFFFF9F9F9333432383937343B2C01000235402B949D8489A37284 + 9E6E7C7D6F768A638CA575697E5A76716676756DFCFBFEFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFBBBBB7656950E6E7E16F6A53868769BDBDB0CCCE + CCFFFFFFA3A5A00000000000000203010000007E936B93B17B857F757D986986 + 9E70708160818472627650545547BEBCBBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB8B9BBC6C7C7FFFFFFEBECEFFFFF + FF4C4D4D0000000001000000002F36297C7D6F85A06F849C6F7B916883847788 + A47286A27057564977726AF4F6F4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF00000002030203040300000092AB7B7E916A838A75859E6E86A06F8F918168 + 7C574B4E3DADACA7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF6B6C6B0000000304030000002F352997B47D737667859E6E88A270373E2F91 + 8D81E2E1E0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFF00000002030202040200000090A97981996C71776245443FC0C1B2FD + FEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFF6D6D6D0000000203020000003941305363488C887DA5A89BFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFF000000000000000000000000908E807F7D6CFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFEFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFF616754848A7281816E7375686C6A5BDADADDFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7F7F7FFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFF585A4B9A9A85B3AB9D9695831F221FF1F1F1FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFB7B7BAA3A3A4898B896B6E6AFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} + Layout = blGlyphTop + end + object grpDumpInfo: TGroupBox + Left = 9 + Top = 55 + Width = 168 + Height = 148 + Anchors = [akLeft, akTop, akRight, akBottom] + Caption = 'Information:' + Padding.Bottom = 2 + TabOrder = 2 + DesignSize = ( + 168 + 148) + object lvDumpInfo: TListView + Left = 3 + Top = 16 + Width = 162 + Height = 127 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + end + item + end> + ColumnClick = False + FlatScrollBars = True + GridLines = True + RowSelect = True + SortType = stText + TabOrder = 0 + ViewStyle = vsReport + OnResize = lvDumpInfoResize + end + end + object grpOffset: TGroupBox + Left = 184 + Top = 55 + Width = 153 + Height = 146 + Anchors = [akTop, akRight, akBottom] + Caption = 'Offsets:' + TabOrder = 3 + end + end + object TPage + Left = 0 + Top = 0 + Caption = 'Debug' + ExplicitWidth = 0 + ExplicitHeight = 0 + end + object TPage + Left = 0 + Top = 0 + Caption = 'Settings' + ExplicitWidth = 0 + ExplicitHeight = 0 + DesignSize = ( + 348 + 209) + object vlSettings: TValueListEditor + Left = 8 + Top = 8 + Width = 332 + Height = 195 + Anchors = [akLeft, akTop, akRight, akBottom] + Strings.Strings = ( + 'IP Address=192.168.153' + 'Notify Port=1500' + 'Notification Enabled=1' + 'Retry Attempts=4') + TabOrder = 0 + TitleCaptions.Strings = ( + 'Option' + 'Value') + OnStringsChange = vlSettingsStringsChange + ColWidths = ( + 147 + 179) + end + end + end + object sBar: TStatusBar + Left = 0 + Top = 234 + Width = 348 + Height = 19 + Panels = < + item + Text = 'Application started....' + Width = 50 + end + item + Alignment = taCenter + Text = 'X' + Width = 12 + end> + SizeGrip = False + OnResize = sBarResize + end + object btConnect: TBitBtn + Left = 56 + Top = 228 + Width = 25 + Height = 17 + TabOrder = 3 + OnClick = btConnectClick + end + object tcpClient: TIdTCPClient + OnStatus = tcpClientStatus + ConnectTimeout = 30 + Host = '192.168.1.153' + IPVersion = Id_IPv4 + OnConnected = tcpClientConnected + Port = 731 + ReadTimeout = 60 + Left = 288 + Top = 224 + end + object tcpServer: TIdTCPServer + Bindings = <> + DefaultPort = 2500 + Left = 256 + Top = 224 + end + object thrdClient: TIdThreadComponent + Active = False + Loop = True + Priority = tpNormal + StopMode = smSuspend + OnRun = thrdClientRun + OnStopped = thrdClientStopped + Left = 224 + Top = 224 + end + object thrdConnect: TIdThreadComponent + Active = False + Loop = False + Priority = tpNormal + StopMode = smSuspend + OnRun = thrdConnectRun + OnStopped = thrdConnectStopped + Left = 192 + Top = 224 + end + object imgList: TImageList + ShareImages = True + Left = 160 + Top = 224 + Bitmap = { + 494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001001000000000000008 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000E003E003E003000000000000000000000000000000000000000000000000 + 0000100210021042786300000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000E003E003E003000000000000000000000000000000000000000000000000 + 0000186300000000FE7F00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000E003E003000000000000000000000000000000000000000000000000 + 0000000000000000104200000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FE7FE003E003E00300000000000000000000000000000000000000000000 + 0000FE7F00000000104210020000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FE7FE003E003E003 + 0000E003E003E003E0030000000000000000000000000000FE7F004000401042 + 7863000000000000004000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF7FE003E003E003 + E003E003E003E003E0030000000000000000000000000000FF7F000000000000 + 0000000000000000104200000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000E003E003E003 + E003E003E003E003000000000000000000000000000000000000100200000000 + 0000000000000000786300000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000E003E003 + E003E003E003E003000000000000000000000000000000000000000010020000 + 0000000000000000FE7F00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E003 + E003E003E003E003E00300000000000000000000000000000000000000001042 + 0000000000000000004000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000E003E003 + E003E003E003E003E00300000000000000000000000000000000000018631863 + 1042104200000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000E003E003 + 0000E003FE7FE003E00300000000000000000000000000000000000010420000 + 78631002FE7F1042000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000E0030000 + 0000000000000000000000000000000000000000000000000000000018630000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00FFFFFFFF00000000FFFFFFFF00000000 + FF1FFF0F00000000FF1FFF0F00000000FF9FFF8F00000000FF0FFF0700000000 + E10FE00F00000000E00FE00F00000000F01FF00F00000000F81FF80F00000000 + FC0FFC0F00000000F80FF80F00000000F90FF80F00000000FBFFFBFF00000000 + FFFFFFFF00000000FFFFFFFF0000000000000000000000000000000000000000 + 000000000000} + end +end diff --git a/src/MainForm.pas b/src/MainForm.pas new file mode 100644 index 0000000..e7629f7 --- /dev/null +++ b/src/MainForm.pas @@ -0,0 +1,449 @@ +unit MainForm; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, Tabs, DockTabSet, ExtCtrls, ComCtrls, IdCustomTCPServer, + IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, + IdThreadComponent, CommCtrl, Buttons, CXboxManager, Global, IdIPAddress, Log, + ImgList, IdGlobal, AppStrings, Grids, ValEdit; + + const + WM_NEWLOG = WM_USER+1; + WM_NEWDUMP = WM_NEWLOG+1; + +type + TfrmMain = class(TForm) + tsTabs: TTabSet; + nbMaintabs: TNotebook; + edInput: TEdit; + memoLog: TMemo; + pbDumpStatus: TProgressBar; + tcpClient: TIdTCPClient; + tcpServer: TIdTCPServer; + sBar: TStatusBar; + thrdClient: TIdThreadComponent; + btnDump: TBitBtn; + lbDumpProg: TLabel; + grpDumpInfo: TGroupBox; + grpOffset: TGroupBox; + thrdConnect: TIdThreadComponent; + imgList: TImageList; + btConnect: TBitBtn; + vlSettings: TValueListEditor; + lvDumpInfo: TListView; + procedure vlSettingsStringsChange(Sender: TObject); + procedure lvDumpInfoResize(Sender: TObject); + procedure thrdClientStopped(Sender: TIdThreadComponent); + procedure edInputKeyPress(Sender: TObject; var Key: Char); + procedure thrdConnectStopped(Sender: TIdThreadComponent); + procedure thrdConnectRun(Sender: TIdThreadComponent); + procedure tcpClientStatus(ASender: TObject; const AStatus: TIdStatus; + const AStatusText: string); + procedure tcpClientConnected(Sender: TObject); + procedure nbMaintabsPageChanged(Sender: TObject); + procedure btConnectClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure sBarResize(Sender: TObject); + procedure thrdClientRun(Sender: TIdThreadComponent); + procedure tsTabsChange(Sender: TObject; NewTab: Integer; + var AllowChange: Boolean); + procedure OnNewLog(var msg:TMessage);message WM_NEWLOG; + procedure ConnectButtonUpdate(); + private + { Private declarations } + public + { Public declarations } + end; + +var + Xbox:TXBOX; + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +procedure TfrmMain.btConnectClick(Sender: TObject); +var +sTemp:String; +ret:Boolean; +begin + tcpClient.Port := Xbox._XDKPort; + + if (not IsValidIP(tcpClient.Host)) then //IP Address assigned to host is invalid + begin + + if (Length(tcpClient.Host) <= 0) then //If host is empty + sTemp := '' + else + sTemp := tcpClient.Host; + + AppLog.addItem('IP Address ( ' + sTemp + ' ) input in settings is invalid.',ltError); + + while( not IsValidIP(tcpClient.Host) ) + do begin + ret := InputQuery('Error: Bad IP Address','The IP Address entered on the settings page is invalid. Please enter a correct value.' + + #13#10 + #13#10 + 'Current value is: ' + sTemp, sTemp); + + if (ret = false) then Exit; //Exit out if user cancels input request + + if (IsValidIP(sTemp)) then //Entered IP was valid this time? + tcpClient.Host := sTemp; //Set host to entered value + Xbox.setIP(tcpClient.Host); + end; + end; + + if (thrdClient.Stopped AND thrdConnect.Stopped) then begin + thrdConnect.Start; + AppLog.addItem('Starting connection thread.',ltQuick); + AppLog.addItem('Initializing connection thread.',ltStatus); + end else if (not thrdConnect.Stopped) then begin //Connection thread running + thrdConnect.Stop; + AppLog.addItem('Stopping connection thread.', ltQuick); + AppLog.addItem('Closing connection thread.',ltStatus); + end else if (not thrdClient.Stopped) then begin //Processing thread running + Xbox.Disconnect(); + thrdClient.Stop; + AppLog.addItem('Stopping processing thread.', ltQuick); + AppLog.addItem('Closing processing thread.',ltStatus); + end; +end; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + AppLog := TLog.Create(frmMain.Handle,WM_NEWLOG); + AppLog.addItem('Application started.',ltStatus); + AppLog.addItem('Started.',ltQuick); + + btConnect.Parent := sBar; + tcpClient := TIdTCPClient.Create(); + Xbox := TXBOX.Create(@tcpClient); + tcpClient.Host := Xbox.IP.IPv4AsString; + tcpClient.Port := Xbox.XDKPort; + + ConnectButtonUpdate(); + + tsTabs.TabIndex := nbMaintabs.PageIndex; +// tsTabs.DitherBackground := false; +// tsTAbs.UnselectedColor := clBlack; +// tsTabs.BackgroundColor := clBlack; + +end; + +procedure TfrmMain.lvDumpInfoResize(Sender: TObject); +begin + lvDumpInfo.Columns.Items[0].Width := (lvDumpInfo.ClientWidth div lvDumpInfo.Columns.Count); + lvDumpInfo.Columns.Items[0].Width := (lvDumpInfo.ClientWidth div lvDumpInfo.Columns.Count); +end; + +procedure TfrmMain.nbMaintabsPageChanged(Sender: TObject); +var +row_idx:Integer; +begin + if (nbMaintabs.PageIndex = nbMaintabs.Pages.IndexOf('Settings')) then //Checks to see if Settings tab was selected + begin + if vlSettings.FindRow('Notify Port',row_idx) then + vlSettings.Keys[row_idx] := IntToStr(Xbox.EventPort); + + if vlSettings.FindRow('IP Address',row_idx) then + vlSettings.Keys[row_idx] := Xbox.IP.IPv4AsString; +// leIP.Text := Xbox.IP.IPv4AsString; +// lePort.Text := IntToStr(Xbox.EventPort); + end; +end; + +procedure TfrmMain.sBarResize(Sender: TObject); +var +sbar_rect:TRect; +begin + sBar.Panels.Items[0].Width := sBar.Width - 19;//sBar.Height; + + SendMessage(sBar.Handle,SB_GETRECT,1,Integer(@sbar_rect)); + btConnect.Top := sbar_rect.Top; + btConnect.Left := sbar_rect.Left; + btConnect.width := 19;//sBar.Panels.Items[1].Width; + btConnect.height := sBar.Height; +end; + +procedure TfrmMain.tsTabsChange(Sender: TObject; NewTab: Integer; + var AllowChange: Boolean); +begin + nbMaintabs.PageIndex := NewTab; +end; + +procedure TfrmMain.vlSettingsStringsChange(Sender: TObject); +var +row_idx:Integer; +begin + if (not vlSettings.FindRow('Notify Port',row_idx)) then Exit; + + Xbox.EventPort := StrToIntDef(vlSettings.Keys[row_idx],Xbox._NotifyPort); + + if (not vlSettings.FindRow('IP Address',row_idx)) then Exit; + + if (not Xbox.setIP(vlSettings.Keys[row_idx])) then + begin + ShowMessage('Invalid ip address'); + Exit; + end; + + if (not vlSettings.FindRow('Notification Enabled',row_idx)) then Exit; + +// Xbox.EnableNotify := vlSettings.Keys[row_idx]; + + tcpClient.Host := Xbox.IP.IPv4AsString; + tcpServer.DefaultPort := Xbox.EventPort; + +end; + +procedure TfrmMain.tcpClientConnected(Sender: TObject); +begin + AppLog.addItem('tcpConnected.',ltStatus); +end; + +procedure TfrmMain.tcpClientStatus(ASender: TObject; const AStatus: TIdStatus; + const AStatusText: string); +begin +AppLog.addItem(Astatustext,ltNormal); + case AStatus of + hsResolving: ; //Hostname being resolved to an IP address + hsConnecting: AppLog.addItem(AStatusText,ltNormal); //Connection being opened + hsConnected: AppLog.addItem(AStatusText,ltNormal); //Connection made + hsDisconnecting: ; //Connection being closed + hsDisconnected: ; //Connection closed + hsStatusText: ; //Connection generating information message + else AppLog.addItem('Unhandled client state.',ltWarning); + end; + +end; + +procedure TfrmMain.thrdClientRun(Sender: TIdThreadComponent); +var +stream:TMemoryStream; +buf:String; +ret:Boolean; +strlist:TStringList; +pbuf:PAnsiChar; +idx:Integer; +begin + {TODO Read data, parse, and act appropriately} + + stream := TMemoryStream.Create; + strlist := TSTringList.Create; + Xbox.Memory.Buffer.SetSize(64 * 1024 * 1024); + + while (Xbox.IsConnected() and (not thrdClient.Stopped)) do + begin + + buf := Xbox.Link.IOHandler.ReadLn(IdGlobal.EOL,300); + + if (buf = '') then Continue; + strlist.Clear; + + AppLog.addItem('buf_r: ' + buf,ltNormal); + + if (buf = PROT_CONNECTED) then + begin + Xbox.SendCmd(DEBUGGER + ' ' + DEBUGGER_CONNECT); + if (Xbox.IsNotify) then Xbox.Notify(true); + end + else if (buf = PROT_BYE) then + begin + ret := Xbox.Disconnect(); + thrdClient.Stop; + end + else if (buf = PROT_MULTILINE) then + begin + //Reads until there is no more data and adds info to string list + ret := Xbox.getLines(@strlist); + + for idx := 0 to strlist.count - 1 do + AppLog.addItem('r: ' + strlist[idx],ltNormal); + + end + else if (buf = PROT_VIRTUAL) then + begin + ret := Xbox.getLines(@strlist); + ret := Xbox.Memory.fillPages(strlist); + Xbox.dumpMem(); + + if (not Xbox.Link.IOHandler.InputBufferIsEmpty) and (XBox.IsConnected()) then + begin + AppLog.addItem(IntToStr(Xbox.Link.IOHandler.InputBuffer.Size) + ' ' + NON_EMPTY_INPUT,ltWarning); + Xbox.Link.IOHandler.ReadStream(stream); + end; + + end + else if (buf = PROT_BINARY) then + begin + //Reads until there is no more data and adds info to string list +// ret := Xbox.getLines(@strlist); + {while (not Xbox.Link.IOHandler.InputBufferIsEmpty) do + begin + Xbox.Link.IOHandler.ReadStream(tmpstream,-1,false); + + if (tmpstream.Size = 0) then Continue; + + strlist.Add(''); + pbuf := StrAlloc(tmpstream.Size + 1); + tmpstream.Read(pbuf,tmpstream.Size); + + pbuf2 := StrAlloc(tmpstream.size * 2 + 1); + BinToHex(pbuf2,pbuf,tmpstream.size); + strlist.Strings[strlist.Count-1] := pbuf2; + StrDispose(pbuf); + StrDispose(pbuf2); + end;} + + //Takes data from above and puts it into a single string + if (strlist.Count > 0) then begin + strlist.Add(''); + idx := 0; + strlist.Exchange(0,strlist.Count - 1); + + while idx < strlist.Count do begin + strlist[0] := strlist[0] + strlist[idx]; + Inc(idx); + end; + + pbuf := StrAlloc(Length(strlist[0]) * 2 + 1); + BinToHex(pbuf,PAnsiCHar(strlist[0]),Length(strlist[0])); + {TODO -cBugs: Is this an issue? pbuf to string} + AppLog.addItem(pbuf,ltNormal); + FreeAndNil(pbuf); + strlist.Clear; + end; + end; + + {TODO -cReading: Try to eliminate double stream } +{ while (0 < Xbox.Link.IOHandler.InputBuffer.Size) do + begin + Xbox.Link.IOHandler.ReadStream(tmpstream, + Xbox.Link.IOHandler.InputBuffer.Size,false); + + stream.CopyFrom(tmpstream,0); + end; +} + + end; + +// FreeAndNil(tmpstream); + FreeAndNil(stream); + FreeAndNil(strlist); +end; + +procedure TfrmMain.thrdClientStopped(Sender: TIdThreadComponent); +begin + if (Xbox.IsConnected()) then + Xbox.Disconnect(); +end; + +procedure TfrmMain.thrdConnectRun(Sender: TIdThreadComponent); +var +iConnectAttempt:Integer; +begin + {Needs to attempt to connect until it reaches X tries (defined in settings), or + it encounters a serious error that requires stopping. If it is connected, them it needs + to break out of the loop and then continue the thread processing. Otherwise, stop the + thread.} + + + if (tcpClient.Connected) then //This should never be true, because this thread shouldnt + begin //be able to be run while connected + AppLog.addItem('Already connected - Logic error in program.', ltWarning); + AppLog.addItem('Already connected',ltQuick); + thrdConnect.Stop; + Exit; + end + else + begin + {TODO -cCandy: Replace 4 with setting} + for iConnectAttempt := 1 to 4 do + begin + if (tcpClient.Connected or thrdConnect.Stopped) then break; + + AppLog.AddItem('Trying to connect. Attempt ' + IntToStr(iConnectAttempt) + ' of 4.', ltStatus); + AppLog.addItem('Connecting ' + IntToStr(iConnectAttempt) + '/4', ltQuick); + + try + tcpClient.Connect; + except + on E : Exception do + begin + AppLog.addItem('Error: ' + e.Message, ltError); + AppLog.addItem('Connect error.', ltQuick); + end; + end; + end; + end; + + if (not tcpClient.Connected) then + begin + AppLog.addItem('Could not connect. Abandoning thread.',ltError); + AppLog.addItem('Thread abandoned.',ltQuick); + end + else //Connected + begin + thrdClient.Start; + AppLog.addItem('Connected, starting processing thread.',ltStatus); + AppLog.addItem('Connected.', ltQuick); + end; + + thrdConnect.Stop; //Regardless of failing or succeeding to connect we need to quit trying +end; + +procedure TfrmMain.thrdConnectStopped(Sender: TIdThreadComponent); +begin + ConnectButtonUpdate(); +end; + +procedure TfrmMain.ConnectButtonUpdate(); +begin +{TODO -cBugs: Button does not update graphic properly } + if (Xbox.IsConnected()) then imgList.GetBitmap(0,btConnect.Glyph) + else imgList.GetBitmap(1,btConnect.Glyph); + + if (not btConnect.Enabled) then btConnect.Enabled := true; +end; + +procedure TfrmMain.edInputKeyPress(Sender: TObject; var Key: Char); +begin + if (Key = Char(VK_RETURN)) then + begin + if (Xbox.SendCmd(edInput.Text)) then + begin + AppLog.addItem('s: ' + edInput.Text,ltNormal); + edInput.Text := ''; + end; + end; +end; + +procedure TfrmMain.OnNewLog(var msg:TMessage); +var +logmsg:^TLogMessage; +begin + logmsg := Pointer(msg.wparam); + + case TLogType(msg.LParam) of + Log.ltQuick: + begin + sBar.Panels[0].Text := logmsg.sMessage; + end; + + Log.ltError, Log.ltWarning, Log.ltStatus, log.ltNormal, Log.ltSystem: + begin + {TODO 1 -cLogging: Normal logging} + {TODO 5 -cLogging: Color/icon coded logging} + memoLog.Lines.Add(logmsg.sMessage); + end + else + begin + memoLog.Lines.Add(INVALID_LOG_TYPE); + {TODO 3 -cError checking: Logging for undefined types} + end; + end; +end; + +end. diff --git a/src/Settings.pas b/src/Settings.pas deleted file mode 100644 index 7933363..0000000 --- a/src/Settings.pas +++ /dev/null @@ -1,101 +0,0 @@ -unit Settings; - -interface - -uses INIFiles, Forms, SysUtils; - -type TConnection = record - Host:String; - Port:Integer; -end; - -type TDumping = record - AutoStop:Boolean; - AutoCopy:Boolean; - Verbose:Boolean; -end; - -type TBP = record - LastType:String; -end; - -type TWindow = record - Width,Height,LastTab:Integer; - State:TWindowState; -end; - -type TSettings = class - Connection:TConnection; - Dumping:TDumping; - Breakpoint:TBP; - Window:TWindow; - - function Save(FileName:String):Boolean; - function Load(FileName:String):Boolean; -end; - -implementation - -function TSettings.Load(FileName:String):Boolean; -var -iniSet:TINIFile; -begin - Result:= false; - - try - iniSet := TINIFile.Create(FileName); - except - on E: Exception do - begin - Exit; - end; - end; - - Connection.Host := iniSet.ReadString('Connection','Host','192.168.1.153'); - Connection.Port := iniSet.ReadInteger('Connection','Port',2000); - Breakpoint.LastType := iniSet.ReadString('Breakpoints','Type','Read'); - Window.Width := iniSet.ReadInteger('Window','Width',614); - Window.Height := iniSet.ReadInteger('Window','Height',713); - Window.State := TWindowState(iniSet.ReadInteger('Window','State',Integer(wsNormal))); - Window.LastTab := iniSet.ReadInteger('Window','LastTab',0); - Dumping.AutoStop :=iniSet.ReadBool('Dumping','AutoStop',true); - Dumping.AutoCopy := iniSet.ReadBool('Dumping','AutoCopy',true); - Dumping.Verbose := iniSet.ReadBool('Dumping','Verbose',true); - - FreeAndNil(iniSet); - - Result := true; -end; - -function TSettings.Save(FileName:String):Boolean; -var -iniSet:TINIFile; -begin - Result := false; - - try - iniSet := TINIFile.Create(FileName); - except - on E: Exception do - begin - Exit; - end; - end; - - iniSet.WriteString('Connection','Host',Connection.Host); - iniSet.WriteInteger('Connection','Port',Connection.Port); - iniSet.WriteBool('Dumping','AutoStop',Dumping.AutoStop); - iniSet.WriteBool('Dumping','AutoCopy',Dumping.AutoCopy); - iniSet.WriteBool('Dumping','Verbose',Dumping.Verbose); - iniSet.WriteString('Breakpoints','Type',Breakpoint.LastType); - iniSet.WriteInteger('Window','Width',Window.Width); - iniSet.WriteInteger('Window','Height',Window.Height); - iniSet.WriteInteger('Window','LastTab',Window.LastTab); - iniSet.WriteInteger('Window','State',Integer(Window.State)); - - FreeAndNil(iniSet); - - Result := true; -end; - -end. diff --git a/src/Tool.pas b/src/Tool.pas deleted file mode 100644 index 7f89840..0000000 --- a/src/Tool.pas +++ /dev/null @@ -1,15 +0,0 @@ -unit Tool; - -interface -uses StdCtrls; -type TTool = record - Name:String; - WinClass:String; - WinText:String; - Load:Boolean; - Handle:Cardinal; -end; - -implementation - -end. diff --git a/src/XBOXManager.pas b/src/XBOXManager.pas deleted file mode 100644 index 22e00e5..0000000 --- a/src/XBOXManager.pas +++ /dev/null @@ -1,194 +0,0 @@ -unit XBOXManager; - -interface - -uses Classes,SysUtils,IdTCPClient; - -type TRegisters = record - EBP,ESP,EIP,EAX,EBX,ECX,EDX,EDI,ESI,EFlags,Cr0NpxState:Cardinal; -end; - -type TMemSection = record - Offset,Size,Flags,Loc:Cardinal; -end; - -//type TBPTypes = (Read,Write,Addr,Execute); - { -type - TBreakpoint = record - Enabled:Boolean; - Offset: Cardinal; - Size: Cardinal; - BPType:TBPTypes; - Desc: String; -end; } - -type TXBOXMemManage = class - Sections: array of TMemSection; - Buffer:TMemoryStream; - constructor Create(); - destructor Free(); -end; - -type TXBOXBreakpointManage = class -// Item: array of TBreakpoint; -// function Add(); -// function Delete(); -// function IndexOf(); -end; - -type TXBE = record - Name:String; - TimeStamp:Cardinal; -end; - -type PIdTCPClient = ^TIdTCPClient; - -type TXBOX = class - Registers:TRegisters; - Memory:TXBOXMemManage; - XBE:TXBE; - Link:PIdTCPClient; - NotifyPort:Cardinal; - - function Reboot(Flags:Cardinal;Title:String):Boolean; - function SendCmd(Cmd:String):Boolean; - function IsConnected():Boolean; - function Disconnect():Boolean; - function Connect(Port:Cardinal):Boolean; - function Notify(Port:Cardinal;Drop:Boolean):Boolean; - constructor Create(TCPCon:PIdTCPClient); - destructor Free(); - -const - rbWait = $00000001; - rbStop = $00000002; - rbWarm = $00000004; - rbNoDebug = $00000008; -end; - -implementation - -constructor TXBOXMemManage.Create; -begin - Buffer := TMemoryStream.Create; -end; - -destructor TXBOXMemManage.Free; -begin - Buffer.Free; - Buffer := nil; -end; - - - -function TXBOX.IsConnected():Boolean; -begin - Result := Link.Connected; -end; - -function TXBOX.Connect(Port:Cardinal):Boolean; -begin - if not IsConnected then - begin - Result := false; - Exit; - end; - - Result := true; - - SendCmd('DEBUGGER CONNECT'); - if(Port > 0) then Notify(Port,false); -end; - -function TXBOX.Disconnect():Boolean; -begin - if not IsConnected then - begin - Result := false; - Exit; - end; - - if NotifyPort > 0 then Notify(NotifyPort,true); - - SendCmd('DEBUGGER DISCONNECT'); - Result := SendCmd('BYE'); -end; - -function TXBOX.Notify(Port:Cardinal;Drop:Boolean):Boolean; -var -Send:String; -begin - if (Port = 0) or (not IsConnected) then - begin - Result := false; - Exit; - end; - - Send := 'NOTIFYAT PORT=' + IntToStr(Port); - - if Drop then - begin - Send := Send + ' DROP'; - NotifyPort := 0; - end - else - begin - NotifyPort := Port; - end; - - Result := SendCmd(Send); -end; - -function TXBOX.Reboot(Flags:Cardinal;Title:String):Boolean; -var -Style,Send:String; -begin - if ((Flags and rbWarm) = rbWarm) then - Style := ' WARM'; - - if ((Flags and rbWait) = rbWait) then - Style := Style + ' WAIT' - else if ((Flags and rbStop) = rbStop) then - Style := Style + ' STOP'; - - if(Title = '') then - begin - if ((Flags and rbNoDebug) = rbNoDebug) then - Style := Style + ' NODEBUG'; - Send := Format('REBOOT%s',[Style]); - end - else - begin - if ((Flags and rbNoDebug) <> rbNoDebug) then - Style := Style + ' DEBUG'; - Send := Format('magicboot title=%s%s',[Title,Style]); - end; - Result := SendCmd(Send); -end; - -function TXBOX.SendCmd(Cmd:String):Boolean; -begin - if(not Link.Connected) then - begin - Result := false; - Exit; - end; - - Link.IOHandler.WriteLn(Cmd); - Result := true; -end; - -constructor TXBOX.Create(TCPCon:PIdTCPClient); -begin - Memory := TXBOXMemManage.Create; - Link := TCPCon; -end; - -destructor TXBOX.Free; -begin - Memory.Free; - Memory := nil; -end; - -end.