这个程序为啥不能在高版本的Delphi上编译通过？
这个程序为啥不能在高版本的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 of Byte;
bSignature: array 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:= $74;
bSignature:= $0E;
bSignature:= $8B;
bSignature:= $D3;
bSignature:= $8B;
bSignature:= $83;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= $FF;
bSignature:= $93;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
SetLength(bMemory, StrToInt(ListView3.Selected.SubItems) - 1);
ReadProcessMemory(hProcess, Pointer(StrToInt(ListView3.Selected.SubItems)), bMemory, StrToInt(ListView3.Selected.SubItems), dwLength);
dwBase:= StrToInt(ListView3.Selected.SubItems);
for dwPoint:= 0 to StrToInt(ListView3.Selected.SubItems) - 14 do
begin
CopyMemory(@bFind, @bMemory, 16);
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
if CompareMem(@bSignature, @bFind, 16) then
begin
dwArray:= dwArray + 1;
SetLength(stBreak, dwArray);
stBreak.dwAddr:= dwPoint + dwBase + $A;
stBreak.bOld:= $74;
stBreak.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.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.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.dwAddr), @b, 1, a);
end;
with ListView1.Items.Add do
begin
Caption:= '调试结束！';
end;
end;
面向论坛编程. 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 ; 呢 明明三个函数,格式都一样,你硬是漏一个; 没有dfm就懒去 试了 freecat 发表于 2024-11-15 07:57
没有dfm就懒去 试了
https://wwgc.lanzouj.com/ikyDT2f4a7wb 在d7上没有问题啊
lz的错误信息是什么 本帖最后由 冥界3大法王 于 2024-11-15 16:12 编辑
firstrose 发表于 2024-11-15 11:17
在d7上没有问题啊
lz的错误信息是什么
@firstrose
Unit1.pas(190): E2033 Types of actual and formal var parameters must be identical Unit1.pas(221): E2033 Types of actual and formal var parameters must be identical Unit1.pas(249): E2033 Types of actual and formal var parameters must be identical Unit1.pas(268): E2033 Types of actual and formal var parameters must be identical Unit1.pas(305): E2033 Types of actual and formal var parameters must be identical Unit1.pas(329): W1044 Suspicious typecast of string to PAnsiChar Unit1.pas(329): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar' Unit1.pas(338): W1044 Suspicious typecast of string to PAnsiChar Unit1.pas(338): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar' Unit1.pas(347): W1044 Suspicious typecast of string to PAnsiChar Unit1.pas(347): E2010 Incompatible types: 'PWideChar' and 'PAnsiChar' Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'{:301_974:}{:301_974:}{:301_974:}
后面的改成 PWideChar过了。
上面的 identical 不会转。{:301_1008:} 本帖最后由 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 of Byte;
bSignature: array 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:= $74;
bSignature:= $0E;
bSignature:= $8B;
bSignature:= $D3;
bSignature:= $8B;
bSignature:= $83;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= $FF;
bSignature:= $93;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
bSignature:= 0;
SetLength(bMemory, StrToInt(ListView3.Selected.SubItems) - 1);
ReadProcessMemory(hProcess, Pointer(StrToInt(ListView3.Selected.SubItems)), bMemory, StrToInt(ListView3.Selected.SubItems), dwLength);
dwBase:= StrToInt(ListView3.Selected.SubItems);
for dwPoint:= 0 to StrToInt(ListView3.Selected.SubItems) - 14 do
begin
CopyMemory(@bFind, @bMemory, 16);
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
bFind:= 0;
if CompareMem(@bSignature, @bFind, 16) then
begin
dwArray:= dwArray + 1;
SetLength(stBreak, dwArray);
stBreak.dwAddr:= dwPoint + dwBase + $A;
stBreak.bOld:= $74;
stBreak.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.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.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.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));
end;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
if ListView1.Selected <> nil then
begin
Clipboard.Clear;
Clipboard.SetTextBuf(PChar(ListView1.Selected.SubItems));
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
ListView1.Clear;
end;
end. 用 NativeUInt 代替 Cardinal 可以同时兼容 x64 x86 除排指定4byte或8byte
页:
[1]