如何在OD中为Delphi程序添加按钮点击事件

如何在OD中为Delphi程序添加按钮点击事件,第1张

用 OD 捕获按钮事件,可以尝试以下办法:

1、通过编写好的脚本来获取按钮事件:

先将以下脚本保存至 .txt 文件中:

var Addr

mov Addr,401000

loop:

find Addr,#740E8BD38B83????????FF93????????#

cmp $RESULT,0

je Exit

add $RESULT,0A

bp $RESULT

add $RESULT,1

mov Addr,$RESULT

jmp loop

Exit:

ret

用OD载入 Delphi 程序,右键 运行脚本-->打开,选择上面保存的文件,运行,如果d出了script finished 窗口就表示找到按钮事件断点位置。

2、用资源编辑工具+十六进制编辑工具来查找:

首先用ResScope或者其他工具打开目标程序,在RCData中能够找到窗体的资源信息,例如

  object Form1: TForm1

    object Button1: TButton

      Caption = 'Button1'

      OnClick = Button1Click

    end

  end

  此时假设我们要找“Button1”按钮事件,记住OnClick的名字(在这里就是Button1Click)

  然后再用WinHex打开程序,查找事件名“Button1Click”,如下图所示: 事件名的前一个字节就是事件名的长度,再前面就是事件地址了:

找到地址后,用 OD载入程序,直接Ctrl+G前往该地址。

unit Unit1

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, Buttons, DdeMan, StdCtrls

type

TTitleBtnForm = class(TForm)

Button1: TButton

procedure FormResize(Sender: TObject)

private

TitleButton : TRect

procedure DrawTitleButton

{Paint-related messages}

procedure WMSetText(var Msg : TWMSetText) message WM_SETTEXT

procedure WMNCPaint(var Msg : TWMNCPaint) message WM_NCPAINT

procedure WMNCActivate(var Msg : TWMNCActivate) message WM_NCACTIVATE

{Mouse down-related messages}

procedure WMNCHitTest(var Msg : TWMNCHitTest) message WM_NCHITTEST

procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown) message WM_NCLBUTTONDOWN

function GetVerInfo : DWORD

end

var

TitleBtnForm: TTitleBtnForm

const

htTitleBtn = htSizeLast + 1

implementation

{$R *.DFM}

procedure TTitleBtnForm.DrawTitleButton

var

bmap : TBitmap {Bitmap to be drawn - 16 X 16 : 16 Colors}

XFrame, {X and Y size of Sizeable area of Frame}

YFrame,

XTtlBit, {X and Y size of Bitmaps in caption}

YTtlBit : Integer

begin

{Get size of form frame and bitmaps in title bar}

XFrame := GetSystemMetrics(SM_CXFRAME)

YFrame := GetSystemMetrics(SM_CYFRAME)

XTtlBit := GetSystemMetrics(SM_CXSIZE)

YTtlBit := GetSystemMetrics(SM_CYSIZE)

{$IFNDEF WIN32}

TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),

YFrame - 1,

XTtlBit + 2,

YTtlBit + 2)

{$ELSE} {Delphi 2.0 positioning}

if (GetVerInfo = VER_PLATFORM_WIN32_NT) then

TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),

YFrame - 1,

XTtlBit + 2,

YTtlBit + 2)

else

TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,

XFrame + 2,

XTtlBit + 2,

YTtlBit + 2)

{$ENDIF}

 

Canvas.Handle := GetWindowDC(Self.Handle) {Get Device context for drawing}

try

{Draw a button face on the TRect}

DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False)

bmap := TBitmap.Create

bmap.LoadFromFile('c:\windows\desktop\aaa.bmp')

with TitleButton do

{$IFNDEF WIN32}

Canvas.Draw(Left + 2, Top + 2, bmap)

{$ELSE}

if (GetVerInfo = VER_PLATFORM_WIN32_NT) then

Canvas.Draw(Left + 2, Top + 2, bmap)

else

Canvas.StretchDraw(TitleButton, bmap)

{$ENDIF}

finally

ReleaseDC(Self.Handle, Canvas.Handle)

bmap.Free

Canvas.Handle := 0

end

end

{Paint triggering events}

procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate)

begin

Inherited

DrawTitleButton

end

procedure TTitleBtnForm.FormResize(Sender: TObject)

begin

Perform(WM_NCACTIVATE, Word(Active), 0)

end

{Painting events}

procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint)

begin

Inherited

DrawTitleButton

end

procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText)

begin

Inherited

DrawTitleButton

end

{Mouse-related procedures}

procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest)

begin

Inherited

{Check to see if the mouse was clicked in the area of the button}

with Msg do

if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then

Result := htTitleBtn

end

procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown)

begin

inherited

if (Msg.HitTest = htTitleBtn) then

ShowMessage('You pressed the new button')

end

function TTitleBtnForm.GetVerInfo : DWORD

var

verInfo : TOSVERSIONINFO

begin

result:=0

verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo)

if GetVersionEx(verInfo) then

Result := verInfo.dwPlatformID

{Returns:

VER_PLATFORM_WIN32s Win32s on Windows 3.1

VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95

VER_PLATFORM_WIN32_NT Windows NT }

end

end.

procedure TForm1.CreateButton

var

button: TButton //定义

begin

button := TButton.Create(Self) //创建控件关键的一句(参数为self的时候不需要释放内存)

button.Parent := Self //此行必须要,不然不能显示在Form1上面

button.Left := 30

button.Top := 30

end


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/bake/11731795.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-18
下一篇 2023-05-18

发表评论

登录后才能评论

评论列表(0条)

保存