这个程序为啥不能在高版本的Delphi上编译通过？

冥界3大法王 · 发表于 2024-11-14 20:18

[Delphi] 纯文本查看 复制代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, TlHelp32,
  Dialogs, XPMan, ComCtrls, StdCtrls, Menus, Clipbrd;

type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    ListView1: TListView;
    GroupBox1: TGroupBox;
    ListView2: TListView;
    ListView3: TListView;
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Button5: TButton;
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListView2Click(Sender: TObject);
    procedure ListView2CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure ListView3CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function RtlAdjustPrivilege(Privilege: ULONG; Enable: BOOL; CurrentThread: BOOL; var Enabled: BOOL):DWORD; stdcall; external 'ntdll';
function   OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall external 'kernel32' name 'OpenThread';
function DebugActiveProcessStop(dwProcessID: Cardinal): BOOL; stdcall; external 'kernel32.dll';

type
  BreakInfo = record
    dwAddr: Cardinal;
    bOld: Byte;
    szStr: string;
  end;

var
  stBreak: array of BreakInfo;
  hProcess: Cardinal;
  bCC: Byte;
  bResume: Boolean;
{$R *.dfm}

procedure RefProcessList();
var
  hTool: Cardinal;
  dwResume: LongBool;
  stPi: TPROCESSENTRY32;
begin
  hTool:= CreateToolhelp32Snapshot(2, 0);
  stPi.dwSize:= SizeOf(stPi);
  dwResume:= Process32First(hTool, stPi);
  while(dwResume) do
  begin
    with Form1.ListView2.Items.Add do
    begin
    Caption:= IntToStr(stPi.th32ProcessID);
    SubItems.Add(stPi.szExeFile);
    SubItems.Add(IntToStr(stPi.th32ParentProcessID));
    end;
    dwResume:= Process32Next(hTool, stPi);
  end;
  CloseHandle(hTool);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ListView2.Clear;
  ListView3.Clear;
  RefProcessList();
  
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Enabled: BOOL;
begin
  RefProcessList();
  bCC:= $CC;
  RtlAdjustPrivilege($14, true, false, Enabled);
end;

procedure TForm1.ListView2Click(Sender: TObject);
var
  hTool: Cardinal;
  dwResume: LongBool;
  stMi: TModuleEntry32;
begin
  if ListView2.Selected <> nil then
  begin
    ListView3.Clear;
    hTool:= CreateToolhelp32Snapshot(8, StrToInt(ListView2.Selected.Caption));
    stMi.dwSize:= SizeOf(stMi);
    dwResume:= Module32First(hTool, stMi);
    while(dwResume) do
    begin
      with ListView3.Items.Add do
      begin
        Caption:= stMi.szModule;
        SubItems.Add('$' + IntToHex(Integer(stMi.modBaseAddr), 8));
        SubItems.Add('$' + IntToHex(stMi.modBaseSize, 8));
      end;
      dwResume:= Module32Next(hTool, stMi);
    end;
    CloseHandle(hTool);
  end;
end;

procedure TForm1.ListView2CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item.Selected then
    Sender.Canvas.Brush.Color := clRed;
end;

procedure TForm1.ListView3CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item.Selected then
    Sender.Canvas.Brush.Color := clRed;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bMemory: array of Byte;
  bFind: array[0..15] of Byte;
  bSignature: array[0..15] of Byte;
  dwPID: Cardinal;
  dwPoint: Cardinal;
  dwBase: Cardinal;
  dwLength: Cardinal;
  dwArray: Cardinal;
  stDbg: DEBUG_EVENT;
  stCONTEXT: CONTEXT;
  hThread: Cardinal;
  bOld: Byte;

  dwLast: Cardinal;

begin
  dwPID:= 0;
  dwLast:= 0;
	bOld:= $FF;
  if (ListView2.Selected <> nil) or (ListView3.Selected <> nil) then
  begin
    dwPID:= StrToInt(ListView2.Selected.Caption);
    hProcess:= OpenProcess(2035711, False, dwPID);
    dwArray:= 0;
    bSignature[0]:= $74;
    bSignature[1]:= $0E;
    bSignature[2]:= $8B;
    bSignature[3]:= $D3;
    bSignature[4]:= $8B;
    bSignature[5]:= $83;
    bSignature[6]:= 0;
    bSignature[7]:= 0;
    bSignature[8]:= 0;
    bSignature[9]:= 0;
    bSignature[10]:= $FF;
    bSignature[11]:= $93;
    bSignature[12]:= 0;
    bSignature[13]:= 0;
    bSignature[14]:= 0;
    bSignature[15]:= 0;
    SetLength(bMemory, StrToInt(ListView3.Selected.SubItems[1]) - 1);
    ReadProcessMemory(hProcess, Pointer(StrToInt(ListView3.Selected.SubItems[0])), bMemory, StrToInt(ListView3.Selected.SubItems[1]), dwLength);
    dwBase:= StrToInt(ListView3.Selected.SubItems[0]);
    for dwPoint:= 0 to StrToInt(ListView3.Selected.SubItems[1]) - 14 do
    begin
      CopyMemory(@bFind, @bMemory[dwPoint], 16);
      bFind[6]:= 0;
      bFind[7]:= 0;
      bFind[8]:= 0;
      bFind[9]:= 0;
      bFind[12]:= 0;
      bFind[13]:= 0;
      bFind[14]:= 0;
      bFind[15]:= 0;
      if CompareMem(@bSignature, @bFind, 16) then
      begin
          dwArray:= dwArray + 1;
          SetLength(stBreak, dwArray);
          stBreak[dwArray - 1].dwAddr:= dwPoint + dwBase + $A;
          stBreak[dwArray - 1].bOld:= $74;
          stBreak[dwArray - 1].szStr:= '触发控件事件';
      end;
    end; //搜索所有按钮事件
    SetLength(bMemory, 0);
    if High(stBreak) = -1 then
    begin
      MessageBox(0, '没有搜索到任何特征码，这可能不是一个Delphi程序', '提示', MB_ICONINFORMATION);
    	exit;
    end;
    DebugActiveProcess(dwPID); //附加调试进程
    for dwPoint:= Low(stBreak) to High(stBreak) do //循环设置断点
    begin
      WriteProcessMemory(hProcess, Pointer(stBreak[dwPoint].dwAddr), @bCC, 1, dwLength);
    end;
    bResume:= True;
    while(bResume) do
    begin
      if not WaitForDebugEvent(stDbg, 20) then //如果还没有收到调试信息
      begin
        Application.ProcessMessages;
        ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
        Continue;
      end;
      if stDbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then //如果被调试程序退出了
      begin
        with ListView1.Items.Add do
        begin
          Caption:= '被调试程序退出！';
        end;
        bResume:= False;
      end;
      if stDbg.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then //如果是调试事件
      begin
        if stDbg.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_BREAKPOINT then
        begin
					for dwBase := 0 to High(stBreak) do
          begin
            if Cardinal(stBreak[dwBase].dwAddr) = Cardinal(stDbg.Exception.ExceptionRecord.ExceptionAddress) then
            begin
              dwLast:= Cardinal(stDbg.Exception.ExceptionRecord.ExceptionAddress);
              WriteProcessMemory(hProcess, Pointer(stDbg.Exception.ExceptionRecord.ExceptionAddress), @bOld, 1, dwLength);
              hThread:= OpenThread(2032639, False, stDbg.dwThreadId);
              stCONTEXT.ContextFlags:= CONTEXT_FULL;
              GetThreadContext(hThread, stCONTEXT);
              stCONTEXT.EFlags:= stCONTEXT.EFlags or $100;
              stCONTEXT.Eip:= stCONTEXT.Eip - 1;
              SetThreadContext(hThread, stCONTEXT);
              CloseHandle(hThread);
              Break;
            end;
          end;
        end
        else
        begin
          if stDbg.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_SINGLE_STEP then
          begin
            hThread:= OpenThread(2032639, False, stDbg.dwThreadId);
            stCONTEXT.ContextFlags:= CONTEXT_FULL;
            GetThreadContext(hThread, stCONTEXT);
          	WriteProcessMemory(hProcess, Pointer(dwLast), @bCC, 1, dwBase);
            with ListView1.Items.Add do
            begin
              Caption:= IntToHex(stCONTEXT.Eip, 4);
              SubItems.Add(IntToHex(dwLast, 4));
              SubItems.Add('触发控件事件！');
            end;
            CloseHandle(hThread);
          end;
        end;
        ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_CONTINUE);
        Continue;
      end;
      ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_CONTINUE);
      Application.ProcessMessages;
    end;
  end
  else
  begin
    ShowMessage('您还没有选择好进程模块哦');
  end;



  DebugActiveProcessStop(dwPID); //卸载调试进程
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  dwP: integer;
  a: Cardinal;
  b: Byte;
begin
  b:= $FF;
  bResume:= False;
  for dwP:= Low(stBreak) to High(stBreak) do
  begin
    WriteProcessMemory(hProcess, Pointer(stBreak[dwP].dwAddr), @b, 1, a);
  end;
  with ListView1.Items.Add do
  begin
    Caption:= '调试结束！';
  end;
end;

fqbqrr6 · 发表于 2024-11-14 20:21

面向论坛编程.

Kmover · 发表于 2024-11-14 20:53

function RtlAdjustPrivilege(Privilege: ULONG; Enable: BOOL; CurrentThread: BOOL; var Enabled: BOOL):DWORD; stdcall; external 'ntdll';
function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall external 'kernel32' name 'OpenThread';
function DebugActiveProcessStop(dwProcessID: Cardinal): BOOL; stdcall; external 'kernel32.dll';

中间那个函数的stdcall ; 呢明明三个函数,格式都一样,你硬是漏一个;

freecat · 发表于 2024-11-15 07:57

没有dfm就懒去试了

冥界3大法王 · 发表于 2024-11-15 10:06

freecat 发表于 2024-11-15 07:57
没有dfm就懒去试了

https://wwgc.lanzouj.com/ikyDT2f4a7wb

firstrose · 发表于 2024-11-15 11:17

在d7上没有问题啊
lz的错误信息是什么

冥界3大法王 · 发表于 2024-11-15 16:10

本帖最后由冥界3大法王于 2024-11-15 16:12 编辑

firstrose 发表于 2024-11-15 11:17
在d7上没有问题啊
lz的错误信息是什么

@firstrose

[dcc32 Error] Unit1.pas(190): E2033 Types of actual and formal var parameters must be identical
[dcc32 Error] Unit1.pas(221): E2033 Types of actual and formal var parameters must be identical
[dcc32 Error] Unit1.pas(249): E2033 Types of actual and formal var parameters must be identical
[dcc32 Error] Unit1.pas(268): E2033 Types of actual and formal var parameters must be identical
[dcc32 Error] Unit1.pas(305): E2033 Types of actual and formal var parameters must be identical
[dcc32 Warning] Unit1.pas(329): W1044 Suspicious typecast of string to PAnsiChar
[dcc32 Error] Unit1.pas(329): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar'
[dcc32 Warning] Unit1.pas(338): W1044 Suspicious typecast of string to PAnsiChar
[dcc32 Error] Unit1.pas(338): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar'
[dcc32 Warning] Unit1.pas(347): W1044 Suspicious typecast of string to PAnsiChar
[dcc32 Error] Unit1.pas(347): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar'
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'

冥界3大法王 · 发表于 2024-11-15 16:43

后面的改成 PWideChar过了。
上面的 identical 不会转。

freecat · 发表于 2024-11-22 22:46

本帖最后由 freecat 于 2024-11-22 23:04 编辑

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, TlHelp32,
  Dialogs, XPMan, ComCtrls, StdCtrls, Menus, Clipbrd;

type
  TForm1 = class(TForm)
XPManifest1: TXPManifest;
ListView1: TListView;
GroupBox1: TGroupBox;
ListView2: TListView;
ListView3: TListView;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Button5: TButton;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListView2Click(Sender: TObject);
procedure ListView2CustomDrawItem(Sender: TCustomListView;
   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ListView3CustomDrawItem(Sender: TCustomListView;
   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
  private
{ Private declarations }
  public
{ Public declarations }
  end;

var
  Form1: TForm1;

implementation

function RtlAdjustPrivilege(Privilege: ULONG; Enable: BOOL; CurrentThread: BOOL; var Enabled: BOOL):DWORD; stdcall; external 'ntdll';
function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall external 'kernel32' name 'OpenThread';
function DebugActiveProcessStop(dwProcessID: Cardinal): BOOL; stdcall; external 'kernel32.dll';

type
  BreakInfo = record
dwAddr: Cardinal;
bOld: Byte;
szStr: string;
  end;

var
  stBreak: array of BreakInfo;
  hProcess: NativeUInt;
  bCC: Byte;
  bResume: Boolean;
{$R *.dfm}

procedure RefProcessList();
var
  hTool: Cardinal;
  dwResume: LongBool;
  stPi: TPROCESSENTRY32;
begin
  hTool:= CreateToolhelp32Snapshot(2, 0);
  stPi.dwSize:= SizeOf(stPi);
  dwResume:= Process32First(hTool, stPi);
  while(dwResume) do
  begin
with Form1.ListView2.Items.Add do
begin
Caption:= IntToStr(stPi.th32ProcessID);
SubItems.Add(stPi.szExeFile);
SubItems.Add(IntToStr(stPi.th32ParentProcessID));
end;
dwResume:= Process32Next(hTool, stPi);
  end;
  CloseHandle(hTool);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ListView2.Clear;
  ListView3.Clear;
  RefProcessList();

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Enabled: BOOL;
begin
  RefProcessList();
  bCC:= $CC;
  RtlAdjustPrivilege($14, true, false, Enabled);
end;

procedure TForm1.ListView2Click(Sender: TObject);
var
  hTool: Cardinal;
  dwResume: LongBool;
  stMi: TModuleEntry32;
begin
  if ListView2.Selected <> nil then
  begin
ListView3.Clear;
hTool:= CreateToolhelp32Snapshot(8, StrToInt(ListView2.Selected.Caption));
stMi.dwSize:= SizeOf(stMi);
dwResume:= Module32First(hTool, stMi);
while(dwResume) do
begin
   with ListView3.Items.Add do
   begin
      Caption:= stMi.szModule;
      SubItems.Add('$' + IntToHex(Integer(stMi.modBaseAddr), 8));
      SubItems.Add('$' + IntToHex(stMi.modBaseSize, 8));
   end;
   dwResume:= Module32Next(hTool, stMi);
end;
CloseHandle(hTool);
  end;
end;

procedure TForm1.ListView2CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item.Selected then
Sender.Canvas.Brush.Color := clRed;
end;

procedure TForm1.ListView3CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item.Selected then
Sender.Canvas.Brush.Color := clRed;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bMemory: array of Byte;
  bFind: array[0..15] of Byte;
  bSignature: array[0..15] of Byte;
  dwPID: Cardinal;
  dwPoint: Cardinal;
  dwBase: NativeUInt;
  dwLength: NativeUInt;
  dwArray: Cardinal;
  stDbg: DEBUG_EVENT;
  stCONTEXT: CONTEXT;
  hThread: Cardinal;
  bOld: Byte;

  dwLast: Cardinal;

begin
  dwPID:= 0;
  dwLast:= 0;
      bOld:= $FF;
  if (ListView2.Selected <> nil) or (ListView3.Selected <> nil) then
  begin
dwPID:= StrToInt(ListView2.Selected.Caption);
hProcess:= OpenProcess(2035711, False, dwPID);
dwArray:= 0;
bSignature[0]:= $74;
bSignature[1]:= $0E;
bSignature[2]:= $8B;
bSignature[3]:= $D3;
bSignature[4]:= $8B;
bSignature[5]:= $83;
bSignature[6]:= 0;
bSignature[7]:= 0;
bSignature[8]:= 0;
bSignature[9]:= 0;
bSignature[10]:= $FF;
bSignature[11]:= $93;
bSignature[12]:= 0;
bSignature[13]:= 0;
bSignature[14]:= 0;
bSignature[15]:= 0;
SetLength(bMemory, StrToInt(ListView3.Selected.SubItems[1]) - 1);
ReadProcessMemory(hProcess, Pointer(StrToInt(ListView3.Selected.SubItems[0])), bMemory, StrToInt(ListView3.Selected.SubItems[1]), dwLength);
dwBase:= StrToInt(ListView3.Selected.SubItems[0]);
for dwPoint:= 0 to StrToInt(ListView3.Selected.SubItems[1]) - 14 do
begin
   CopyMemory(@bFind, @bMemory[dwPoint], 16);
   bFind[6]:= 0;
   bFind[7]:= 0;
   bFind[8]:= 0;
   bFind[9]:= 0;
   bFind[12]:= 0;
   bFind[13]:= 0;
   bFind[14]:= 0;
   bFind[15]:= 0;
   if CompareMem(@bSignature, @bFind, 16) then
   begin
      dwArray:= dwArray + 1;
      SetLength(stBreak, dwArray);
      stBreak[dwArray - 1].dwAddr:= dwPoint + dwBase + $A;
      stBreak[dwArray - 1].bOld:= $74;
      stBreak[dwArray - 1].szStr:= '触发控件事件';
   end;
end; //搜索所有按钮事件
SetLength(bMemory, 0);
if High(stBreak) = -1 then
begin
   MessageBox(0, '没有搜索到任何特征码，这可能不是一个Delphi程序', '提示', MB_ICONINFORMATION);
         exit;
end;
DebugActiveProcess(dwPID); //附加调试进程
for dwPoint:= Low(stBreak) to High(stBreak) do //循环设置断点
begin
   WriteProcessMemory(hProcess, Pointer(stBreak[dwPoint].dwAddr), @bCC, 1, dwLength);
end;
bResume:= True;
while(bResume) do
begin
   if not WaitForDebugEvent(stDbg, 20) then //如果还没有收到调试信息
   begin
      Application.ProcessMessages;
      ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
      Continue;
   end;
   if stDbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then //如果被调试程序退出了
   begin
      with ListView1.Items.Add do
      begin
      Caption:= '被调试程序退出！';
      end;
      bResume:= False;
   end;
   if stDbg.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then //如果是调试事件
   begin
      if stDbg.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_BREAKPOINT then
      begin
                                    for dwBase := 0 to High(stBreak) do
      begin
         if Cardinal(stBreak[dwBase].dwAddr) = Cardinal(stDbg.Exception.ExceptionRecord.ExceptionAddress) then
         begin
            dwLast:= Cardinal(stDbg.Exception.ExceptionRecord.ExceptionAddress);
            WriteProcessMemory(hProcess, Pointer(stDbg.Exception.ExceptionRecord.ExceptionAddress), @bOld, 1, dwLength);
            hThread:= OpenThread(2032639, False, stDbg.dwThreadId);
            stCONTEXT.ContextFlags:= CONTEXT_FULL;
            GetThreadContext(hThread, stCONTEXT);
            stCONTEXT.EFlags:= stCONTEXT.EFlags or $100;
            {$IFDEF WIN64}
            stCONTEXT.Rip := stCONTEXT.Rip - 1;
            {$ELSE}
            stCONTEXT.Eip:= stCONTEXT.Eip - 1;
            {$ENDIF}
            SetThreadContext(hThread, stCONTEXT);
            CloseHandle(hThread);
            Break;
         end;
      end;
      end
      else
      begin
      if stDbg.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_SINGLE_STEP then
      begin
         hThread:= OpenThread(2032639, False, stDbg.dwThreadId);
         stCONTEXT.ContextFlags:= CONTEXT_FULL;
         GetThreadContext(hThread, stCONTEXT);
               WriteProcessMemory(hProcess, Pointer(dwLast), @bCC, 1, dwBase);
         with ListView1.Items.Add do
         begin
            {$IFDEF WIN64}
            Caption:= IntToHex(stCONTEXT.Rip, 8);
            SubItems.Add(IntToHex(dwLast, 8));
            {$ELSE}
            Caption:= IntToHex(stCONTEXT.Eip, 4);
            SubItems.Add(IntToHex(dwLast, 4));
            {$ENDIF}
            SubItems.Add('触发控件事件！');
         end;
         CloseHandle(hThread);
      end;
      end;
      ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_CONTINUE);
      Continue;
   end;
   ContinueDebugEvent(stDbg.dwProcessId, stDbg.dwThreadId, DBG_CONTINUE);
   Application.ProcessMessages;
end;
  end
  else
  begin
ShowMessage('您还没有选择好进程模块哦');
  end;

  DebugActiveProcessStop(dwPID); //卸载调试进程
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  dwP: integer;
  a: NativeUInt;
  b: Byte;
begin
  b:= $FF;
  bResume:= False;
  for dwP:= Low(stBreak) to High(stBreak) do
  begin
WriteProcessMemory(hProcess, Pointer(stBreak[dwP].dwAddr), @b, 1, a);
  end;
  with ListView1.Items.Add do
  begin
Caption:= '调试结束！';
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
MessageBox(0, '程序设计：天下' + #13#10#13#10 + '我的 Q Q：1812286242' +
   #13#10#13#10 + '感谢名单：Nobody' + #13#10#13#10 +
   '我的博客：http://tianxia2002.lofter.com', '关于', MB_OK +
   MB_ICONINFORMATION + MB_TOPMOST);

end;

procedure TForm1.N1Click(Sender: TObject);
begin
  if ListView1.Selected <> nil then
  begin
Clipboard.Clear;
Clipboard.SetTextBuf(PChar(ListView1.Selected.Caption));
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  if ListView1.Selected <> nil then
  begin
Clipboard.Clear;
Clipboard.SetTextBuf(PChar(ListView1.Selected.SubItems[0]));
  end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  if ListView1.Selected <> nil then
  begin
Clipboard.Clear;
Clipboard.SetTextBuf(PChar(ListView1.Selected.SubItems[1]));
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  ListView1.Clear;
end;

end.

freecat · 发表于 2024-11-22 22:48

用 NativeUInt 代替 Cardinal 可以同时兼容 x64 x86 除排指定4byte或8byte

帐号		自动登录	找回密码
密码			注册[Register]

[求助] 这个程序为啥不能在高版本的Delphi上编译通过？