Delphi编写内存遍历工具-Delphi&XE-宝峰科技

admin 发表于 2009-11-2 23:38:27

Delphi编写内存遍历工具

unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
PEdit = ^TEdit;
TFilterData = Record
m_Text: string;
m_Int: Integer;
m_UnSign: Cardinal;
m_Float: Single;
m_Double: Double;
End;
PFilterData = ^TFilterData;

TfrmMain = class(TForm)
GroupBox1: TGroupBox;
cbProcess: TComboBox;
btReFresh: TButton;
Label1: TLabel;
edtBaseAddress: TEdit;
Label2: TLabel;
edtOffset1: TEdit;
Label3: TLabel;
edtOffset2: TEdit;
Label4: TLabel;
edtOffset3: TEdit;
Label5: TLabel;
edtOffset4: TEdit;
Label6: TLabel;
edtOffset5: TEdit;
Label7: TLabel;
edtOffset6: TEdit;
Label8: TLabel;
edtOffset7: TEdit;
Label9: TLabel;
edtOffset8: TEdit;
Label10: TLabel;
edtOffset9: TEdit;
Label11: TLabel;
edtOffset10: TEdit;
Label12: TLabel;
edtOffset11: TEdit;
Label13: TLabel;
edtOffset12: TEdit;
Panel1: TPanel;
GroupBox2: TGroupBox;
Label14: TLabel;
cbOffset3: TComboBox;
Label15: TLabel;
edtOffsetCount3: TEdit;
Label16: TLabel;
edtLoopCount3: TEdit;
GroupBox3: TGroupBox;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
cbOffset2: TComboBox;
edtOffsetCount2: TEdit;
edtLoopCount2: TEdit;
GroupBox4: TGroupBox;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
cbOffset1: TComboBox;
edtOffsetCount1: TEdit;
edtLoopCount1: TEdit;
Splitter1: TSplitter;
Panel2: TPanel;
Panel3: TPanel;
Splitter2: TSplitter;
lvResult: TListView;
Label23: TLabel;
Label24: TLabel;
lbRecordCount: TLabel;
Label26: TLabel;
lbSelectCount: TLabel;
Label28: TLabel;
Panel4: TPanel;
GroupBox6: TGroupBox;
rbText: TRadioButton;
rbInt: TRadioButton;
rbUnSign: TRadioButton;
rbFloat: TRadioButton;
rbDouble: TRadioButton;
GroupBox7: TGroupBox;
rbEqual: TRadioButton;
rbLarge: TRadioButton;
rbLess: TRadioButton;
rbUnequal: TRadioButton;
rbLargeOrEqual: TRadioButton;
rbLessOrEqual: TRadioButton;
rbBetween: TRadioButton;
lbFitler: TLabel;
edtFilter: TEdit;
lbLargeOrEqual: TLabel;
edtSmall: TEdit;
lbLessOrEqual: TLabel;
edtLarge: TEdit;
cbFilterInProcess: TCheckBox;
btFilterInResult: TButton;
btSave: TButton;
btStart: TButton;
btSelect: TButton;
btSaveToFile: TButton;
btClear: TButton;
chkFloatToInt: TCheckBox;
chkOffset1: TCheckBox;
chkOffset2: TCheckBox;
chkOffset3: TCheckBox;
chkTextMatch: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure btReFreshClick(Sender: TObject);
procedure rbEqualClick(Sender: TObject);
procedure chkOffset1Click(Sender: TObject);
procedure chkOffset2Click(Sender: TObject);
procedure chkOffset3Click(Sender: TObject);
procedure btClearClick(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure cbProcessChange(Sender: TObject);
procedure lvResultClick(Sender: TObject);
procedure lvResultResize(Sender: TObject);
procedure btFilterInResultClick(Sender: TObject);
procedure rbTextClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btSaveClick(Sender: TObject);
procedure btSaveToFileClick(Sender: TObject);
procedure btSelectClick(Sender: TObject);
private
{ Private declarations }
aryEdit: array of PEdit;
ProcessHandel: THandle;
FResultCount: Cardinal;
FSelCount: Cardinal;
procedure SetResultCount(const Value: Cardinal);
procedure SetSelCount(const Value: Cardinal);
procedure SetSingleFilter(bSingle: Boolean);
procedure rbClick;
procedure rbTypeClick;
procedure ClearListView;
property ResultCount: Cardinal read FResultCount write SetResultCount;
property SelCount: Cardinal read FSelCount write SetSelCount;
public
{ Public declarations }
procedure GetProcessInf;
procedure ReadMemData(P: Pointer; pData: PFilterData);
procedure ReadToListView(P: Pointer; Offset1,Offset2,Offset3: Cardinal);
procedure AddListItem(pData: PFilterData; Offset1,Offset2,Offset3: Cardinal);
procedure SaveSetting;
procedure ReadSetting;
function DebugPrivilege(bEnable: Boolean): Boolean;
function GetSelProcessHandel: THandle;
function DataFilter(pData: PFilterData): Boolean;
function StrToFloatEx(str: string): Extended;
function FloatToStrEx(flt: Extended): string;
function HexToCardinal(hex: string): Cardinal;
function IsFloat(f: Extended): Boolean;
function TruncEx(r: Real): Int64;
function ReadPointer(pAddress: Pointer): Pointer;
function ReadCardinal(pAddress: Pointer): Cardinal;
function ReadInteger(pAddress: Pointer): Integer;
function ReadSingle(pAddress: Pointer): Single;
function ReadDouble(pAddress: Pointer): Double;
function ReadUnicode(pAddress: Pointer): string;
end;

var
frmMain: TfrmMain;
implementation
uses Tlhelp32, psapi, IniFiles;
{$R *.dfm}
{ TfrmMain }
function TfrmMain.FloatToStrEx(flt: Extended): string;
begin
try
   Result := FloatToStr(flt);
except
   Result := '0.0';
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearListView;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DebugPrivilege(True);
GetProcessInf;
SetSingleFilter(True);
aryEdit := @edtOffset1;
aryEdit := @edtOffset2;
aryEdit := @edtOffset3;
aryEdit := @edtOffset4;
aryEdit := @edtOffset5;
aryEdit := @edtOffset6;
aryEdit := @edtOffset7;
aryEdit := @edtOffset8;
aryEdit := @edtOffset9;
aryEdit := @edtOffset10;
aryEdit := @edtOffset11;
aryEdit := @edtOffset12;
ReadSetting;
end;
procedure TfrmMain.GetProcessInf;
var
lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
ProcessId:DWORD;
ProcessName:string;
begin
cbProcess.Clear;
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
lppe.dwSize := SizeOf(TProcessEntry32);
found := Process32First(Hand,lppe);
while found do
begin
   ProcessName := StrPas(lppe.szExeFile);
   if lppe.th32ProcessID>0 then
   begin
         ProcessId := lppe.th32ProcessID;
         cbProcess.Items.AddObject(ProcessName,TObject(ProcessId));
   end;
   found := Process32Next(Hand,lppe);
end;
end;
function TfrmMain.GetSelProcessHandel: THandle;
var
ProcessId: DWORD;
begin
Result := 0;
if cbProcess.ItemIndex < 0 then exit;
ProcessId := DWORD(cbProcess.Items.Objects);
Result := OpenProcess(PROCESS_ALL_ACCESS, FALSE, ProcessId);
end;
procedure TfrmMain.rbClick;
begin
if rbBetween.Checked then
   SetSingleFilter(False)
else
   SetSingleFilter(True);
end;
procedure TfrmMain.rbEqualClick(Sender: TObject);
begin
rbClick;
end;
procedure TfrmMain.rbTextClick(Sender: TObject);
begin
rbTypeClick;
end;
procedure TfrmMain.rbTypeClick;
begin
if rbText.Checked then
begin
   rbLarge.Enabled := False;
   rbLess.Enabled := False;
   rbUnequal.Enabled := False;
   rbLargeOrEqual.Enabled := False;
   rbLessOrEqual.Enabled := False;
   rbBetween.Enabled := False;
   rbEqual.Checked := True;
end else
begin
   rbLarge.Enabled := True;
   rbLess.Enabled := True;
   rbUnequal.Enabled := True;
   rbLargeOrEqual.Enabled := True;
   rbLessOrEqual.Enabled := True;
   rbBetween.Enabled := True;
end;
end;
function TfrmMain.ReadCardinal(pAddress: Pointer): Cardinal;
var
tmp: Cardinal;
ReadCount: Cardinal;
begin
Result := 0;
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := tmp;
end;
function TfrmMain.ReadDouble(pAddress: Pointer): Double;
var
tmp: Double;
ReadCount: Cardinal;
begin
Result := 0;
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := tmp;
end;
function TfrmMain.ReadInteger(pAddress: Pointer): Integer;
var
tmp: Integer;
ReadCount: Cardinal;
begin
Result := 0;
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := tmp;
end;
procedure TfrmMain.ReadMemData(P: Pointer; pData: PFilterData);
begin
pData.m_Text := ReadUnicode(P);
pData.m_Int := ReadInteger(P);
pData.m_UnSign := ReadCardinal(P);
try
   pData.m_Float := ReadSingle(P);
except
   pData.m_Float := 0.0;
end;
try
   pData.m_Double := ReadDouble(P);
except
   pData.m_Double := 0.0;
end;
end;
function TfrmMain.ReadPointer(pAddress: Pointer): Pointer;
var
tmp: Cardinal;
ReadCount: Cardinal;
begin
Result := nil;
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := Pointer(tmp);
end;
procedure TfrmMain.ReadSetting;
var
iniFile: TIniFile;
strPath: string;
begin
strPath := GetCurrentDir+'\Readmem.ini';
iniFile := TIniFile.Create(strPath);
edtBaseAddress.Text := iniFile.ReadString('ReadMem','edtBaseAddress','');
edtOffset1.Text := iniFile.ReadString('ReadMem','edtOffset1','');
edtOffset2.Text := iniFile.ReadString('ReadMem','edtOffset2','');
edtOffset3.Text := iniFile.ReadString('ReadMem','edtOffset3','');
edtOffset4.Text := iniFile.ReadString('ReadMem','edtOffset4','');
edtOffset5.Text := iniFile.ReadString('ReadMem','edtOffset5','');
edtOffset6.Text := iniFile.ReadString('ReadMem','edtOffset6','');
edtOffset7.Text := iniFile.ReadString('ReadMem','edtOffset7','');
edtOffset8.Text := iniFile.ReadString('ReadMem','edtOffset8','');
edtOffset9.Text := iniFile.ReadString('ReadMem','edtOffset9','');
edtOffset10.Text := iniFile.ReadString('ReadMem','edtOffset10','');
edtOffset11.Text := iniFile.ReadString('ReadMem','edtOffset11','');
edtOffset12.Text := iniFile.ReadString('ReadMem','edtOffset12','');
chkOffset1.Checked := iniFile.ReadBool('ReadMem','chkOffset1',False);
cbOffset1.ItemIndex := iniFile.ReadInteger('ReadMem','cbOffset1',-1);
edtOffsetCount1.Text := iniFile.ReadString('ReadMem','edtOffsetCount1','2');
edtLoopCount1.Text := iniFile.ReadString('ReadMem','edtLoopCount1','500');
chkOffset2.Checked := iniFile.ReadBool('ReadMem','chkOffset2',False);
cbOffset2.ItemIndex := iniFile.ReadInteger('ReadMem','cbOffset2',-1);
edtOffsetCount2.Text := iniFile.ReadString('ReadMem','edtOffsetCount2','2');
edtLoopCount2.Text := iniFile.ReadString('ReadMem','edtLoopCount2','500');
chkOffset3.Checked := iniFile.ReadBool('ReadMem','chkOffset3',False);
cbOffset3.ItemIndex := iniFile.ReadInteger('ReadMem','cbOffset3',-1);
edtOffsetCount3.Text := iniFile.ReadString('ReadMem','edtOffsetCount3','2');
edtLoopCount3.Text := iniFile.ReadString('ReadMem','edtLoopCount3','500');
end;
function TfrmMain.ReadSingle(pAddress: Pointer): Single;
var
tmp: Single;
ReadCount: Cardinal;
begin
Result := 0;
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := tmp;
end;
function TfrmMain.ReadUnicode(pAddress: Pointer): string;
var
tmp: array of WideChar;
ReadCount: Cardinal;
begin
Result := '';
if ProcessHandel = 0 then exit;
if pAddress = nil then exit;
ReadProcessMemory(ProcessHandel, pAddress, @tmp, SizeOf(tmp), ReadCount);
Result := tmp;
end;
procedure TfrmMain.ReadToListView(P: Pointer; Offset1, Offset2,
Offset3: Cardinal);
var
pData: PFilterData;
begin
New(pData);
ReadMemData(P, pData);
if cbFilterInProcess.Checked then
begin
   if DataFilter(pData) then
         AddListItem(pData,Offset1,Offset2,Offset3)
   else
         Dispose(pData);
end else
   AddListItem(pData,Offset1,Offset2,Offset3);
end;
procedure TfrmMain.SaveSetting;
var
iniFile: TIniFile;
strPath: string;
begin
strPath := GetCurrentDir+'\Readmem.ini';
iniFile := TIniFile.Create(strPath);
with iniFile do
begin
   WriteString('ReadMem', 'edtBaseAddress', edtBaseAddress.Text);
   WriteString('ReadMem', 'edtOffset1', edtOffset1.Text);
   WriteString('ReadMem', 'edtOffset2', edtOffset2.Text);
   WriteString('ReadMem', 'edtOffset3', edtOffset3.Text);
   WriteString('ReadMem', 'edtOffset4', edtOffset4.Text);
   WriteString('ReadMem', 'edtOffset5', edtOffset5.Text);
   WriteString('ReadMem', 'edtOffset6', edtOffset6.Text);
   WriteString('ReadMem', 'edtOffset7', edtOffset7.Text);
   WriteString('ReadMem', 'edtOffset8', edtOffset8.Text);
   WriteString('ReadMem', 'edtOffset9', edtOffset9.Text);
   WriteString('ReadMem', 'edtOffset10', edtOffset10.Text);
   WriteString('ReadMem', 'edtOffset11', edtOffset11.Text);
   WriteString('ReadMem', 'edtOffset12', edtOffset12.Text);
   WriteBool('ReadMem', 'chkOffset1', chkOffset1.Checked);
   WriteInteger('ReadMem', 'cbOffset1', cbOffset1.ItemIndex);
   WriteString('ReadMem', 'edtOffsetCount1', edtOffsetCount1.Text);
   WriteString('ReadMem', 'edtLoopCount1', edtLoopCount1.Text);
   WriteBool('ReadMem', 'chkOffset2', chkOffset2.Checked);
   WriteInteger('ReadMem', 'cbOffset2', cbOffset2.ItemIndex);
   WriteString('ReadMem', 'edtOffsetCount2', edtOffsetCount2.Text);
   WriteString('ReadMem', 'edtLoopCount2', edtLoopCount2.Text);
   WriteBool('ReadMem', 'chkOffset3', chkOffset3.Checked);
   WriteInteger('ReadMem', 'cbOffset3', cbOffset3.ItemIndex);
   WriteString('ReadMem', 'edtOffsetCount3', edtOffsetCount3.Text);
   WriteString('ReadMem', 'edtLoopCount3', edtLoopCount3.Text);
end;
end;
procedure TfrmMain.SetResultCount(const Value: Cardinal);
begin
FResultCount := Value;
lbRecordCount.Caption := IntToStr(FResultCount);
end;
procedure TfrmMain.SetSelCount(const Value: Cardinal);
begin
FSelCount := Value;
lbSelectCount.Caption := IntToStr(FSelCount);
end;
procedure TfrmMain.SetSingleFilter(bSingle: Boolean);
begin
if bSingle then
begin
   lbFitler.Visible := True;
   edtFilter.Visible := True;
   lbLargeOrEqual.Visible := False;
   lbLessOrEqual.Visible := False;
   edtLarge.Visible := False;
   edtSmall.Visible := False;
end else
begin
   lbFitler.Visible := False;
   edtFilter.Visible := False;
   lbLargeOrEqual.Visible := True;
   lbLessOrEqual.Visible := True;
   edtLarge.Visible := True;
   edtSmall.Visible := True;
end;
end;
function TfrmMain.StrToFloatEx(str: string): Extended;
var
tmp: string;
begin
tmp := str;
if Pos('.', tmp) < 1 then
   tmp := tmp + '.0';
try
   Result := StrToFloat(tmp);
except
   ShowMessage(''''+tmp+'''转换为浮点型时出错！');
   Result := 0.0;
end;
end;
function TfrmMain.TruncEx(r: Real): Int64;
var
tmp: string;
p: Integer;
begin
tmp := FloatToStrEx(r);
p := Pos('.', tmp);
if p > 0 then
   tmp := Copy(tmp, 0, p-1);
Result := StrToInt64(tmp);
end;
function TfrmMain.IsFloat(f: Extended): Boolean;
var
tmp: Extended;
begin
try
   tmp := Trunc(f);
   Result := True;
except
   Result := False;
end;
end;
function TfrmMain.HexToCardinal(hex: string): Cardinal;
begin
Result := StrToInt('$'+hex);
end;
procedure TfrmMain.lvResultClick(Sender: TObject);
begin
SelCount := lvResult.SelCount;
end;
procedure TfrmMain.lvResultResize(Sender: TObject);
var
ColWidth: Integer;
tmp: Integer;
begin
ColWidth := 30;
tmp := lvResult.Width div 25;
if (tmp < (ColWidth+2)) then
   tmp := ColWidth;
lvResult.Columns.Width := tmp *4;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
lvResult.Columns.Width := tmp *3;
end;
procedure TfrmMain.AddListItem(pData: PFilterData; Offset1,Offset2,Offset3: Cardinal);
var
lvItem: TListItem;
tmpStr: string;
begin
lvItem := lvResult.Items.Add;
lvItem.Data := pData;
lvItem.Caption := pData.m_Text;

lvItem.SubItems.Add(IntToStr(pData.m_Int));
lvItem.SubItems.Add(IntToStr(pData.m_UnSign));
tmpStr := FloatToStrEx(pData.m_Float);
lvItem.SubItems.Add(tmpStr);
tmpStr := FloatToStrEx(pData.m_Double);
lvItem.SubItems.Add(tmpStr);
lvItem.SubItems.Add(IntToHex(Offset1, 4));
lvItem.SubItems.Add(IntToHex(Offset2, 4));
lvItem.SubItems.Add(IntToHex(Offset3, 4));
ResultCount := ResultCount + 1;
end;
procedure TfrmMain.btClearClick(Sender: TObject);
begin
ClearListView;
end;
procedure TfrmMain.btFilterInResultClick(Sender: TObject);
var
I: Cardinal;
pData: PFilterData;
lstItemCount: Cardinal;
begin
I := 0;
lstItemCount := lvResult.Items.Count;
while lstItemCount > I do
begin
   pData := lvResult.Items.Item.Data;
   if DataFilter(pData) = False then
   begin
         Dispose(pData);
         lvResult.Items.Delete(I);
         lstItemCount := lstItemCount -1;
         ResultCount := ResultCount -1;
   end else
         I := I + 1;
end;
end;
procedure TfrmMain.btReFreshClick(Sender: TObject);
begin
GetProcessInf;
end;
procedure TfrmMain.btSaveClick(Sender: TObject);
begin
SaveSetting;
end;
procedure TfrmMain.btSaveToFileClick(Sender: TObject);
var
i,j: Integer;
s: string;
StrList: TStringList;
SaveDlg: TSaveDialog;
SaveName: string;
begin
with lvResult do
begin
   StrList := TStringList.Create;
   s := '文本'+#9+'整型'+#9+'无符整型'+#9+'浮点型'+#9+'双精度'+#9+'一级偏量'+#9+'二级偏量'+#9+'三级偏量';
   StrList.Add(s);
   for i := 0 to Items.Count-1 do
   begin
         s := Items.Caption;
         for j := 1 to Columns.Count-1 do
         begin
            s := s + #9 + items.subitems;
         end;
         StrList.Add(s);
   end;
end;
SaveDlg := TSaveDialog.Create(nil);
SaveDlg.Filter := 'txt';
if SaveDlg.Execute(self.Handle) = False then exit;
SaveName := SaveDlg.FileName + '.' + SaveDlg.Filter;
SaveDlg.Free;
StrList.SaveToFile(SaveName);
StrList.Free;
end;
procedure TfrmMain.btSelectClick(Sender: TObject);
begin
MessageBox(self.Handle, '作者：ABC'+#13+'QQ:67217629', '内存遍历ABC', MB_OKCANCEL);
end;
procedure TfrmMain.btStartClick(Sender: TObject);
var
I,J,K,L: Integer;
P,BaseAddress: Pointer;
tmpCardinal: Cardinal;
Offset1, Offset2, Offset3: Cardinal;
begin
if ProcessHandel = 0 then
begin
   ShowMessage('请选择要操作的进程.');
   cbProcess.SetFocus;
   exit;
end;
if edtBaseAddress.Text = '' then
begin
   ShowMessage('请设置基址.');
   edtBaseAddress.SetFocus;
   exit;
end;
BaseAddress := Pointer(HexToCardinal(edtBaseAddress.Text));
I := 0; J := 0; K := 0;
if chkOffset1.Checked = False then
begin
   P := BaseAddress;
   Offset1 := 0; Offset2 := 0; Offset3 := 0;
   for L := 0 to 11 do
   begin
         if P = nil then Break;
         if aryEdit.Text = '' then Break;
         P := ReadPointer(P);
         tmpCardinal := HexToCardinal(aryEdit.Text);
         P := Pointer(Cardinal(P) + tmpCardinal);
   end;
   ReadToListView(P, Offset1, Offset2, Offset3);
   Exit;
end;
for I := 0 to StrToInt(edtLoopCount1.Text) do
begin
   if chkOffset2.Checked = False then
   begin
         P := BaseAddress;
         Offset1 := 0; Offset2 := 0; Offset3 := 0;
         for L := 0 to 11 do
         begin
            if P = nil then Break;
            if aryEdit.Text = '' then Break;
            P := ReadPointer(P);
            tmpCardinal := HexToCardinal(aryEdit.Text);
            if L = cbOffset1.ItemIndex then
            begin
               Offset1 := HexToCardinal(edtOffsetCount1.Text)*I;
               tmpCardinal := tmpCardinal + Offset1;
            end;
            P := Pointer(Cardinal(P) + tmpCardinal);
         end;
         ReadToListView(P, Offset1, Offset2, Offset3);
         Continue;
   end;
   for J := 0 to StrToInt(edtLoopCount2.Text) do
   begin
         if chkOffset3.Checked = False then
         begin
            P := BaseAddress;
            Offset1 := 0; Offset2 := 0; Offset3 := 0;
            for L := 0 to 11 do
            begin
               if P = nil then Break;
               if aryEdit.Text = '' then Break;
               P := ReadPointer(P);
               tmpCardinal := HexToCardinal(aryEdit.Text);
               if L = cbOffset1.ItemIndex then
               begin
                     Offset1 := HexToCardinal(edtOffsetCount1.Text)*I;
                     tmpCardinal := tmpCardinal + Offset1;
               end;
               if L = cbOffset2.ItemIndex then
               begin
                     Offset2 := HexToCardinal(edtOffsetCount2.Text)*J;
                     tmpCardinal := tmpCardinal + Offset2;
               end;
               P := Pointer(Cardinal(P) + tmpCardinal);
            end;
            ReadToListView(P, Offset1, Offset2, Offset3);
            Continue;
         end;
         for K := 0 to StrToInt(edtLoopCount3.Text) do
         begin
            P := BaseAddress;
            Offset1 := 0; Offset2 := 0; Offset3 := 0;
            for L := 0 to 11 do
            begin
               if P = nil then Break;
               if aryEdit.Text = '' then Break;
               P := ReadPointer(P);
               tmpCardinal := HexToCardinal(aryEdit.Text);
               if L = cbOffset1.ItemIndex then
               begin
                     Offset1 := HexToCardinal(edtOffsetCount1.Text)*I;
                     tmpCardinal := tmpCardinal + Offset1;
               end;
               if L = cbOffset2.ItemIndex then
               begin
                     Offset2 := HexToCardinal(edtOffsetCount2.Text)*J;
                     tmpCardinal := tmpCardinal + Offset2;
               end;
               if L = cbOffset3.ItemIndex then
               begin
                     Offset3 := HexToCardinal(edtOffsetCount3.Text)*K;
                     tmpCardinal := tmpCardinal + Offset3;
               end;
               P := Pointer(Cardinal(P) + tmpCardinal);
            end;
            ReadToListView(P, Offset1, Offset2, Offset3);
         end;
   end;
end;
end;
procedure TfrmMain.chkOffset2Click(Sender: TObject);
begin
if chkOffset2.Checked then
begin
   cbOffset2.Enabled := True;
   edtOffsetCount2.Enabled := True;
   edtLoopCount2.Enabled := True;
   chkOffset3.Enabled := True;
   cbOffset2.ItemIndex := cbOffset1.ItemIndex+1;
end else
begin
   cbOffset2.Enabled := False;
   edtOffsetCount2.Enabled := False;
   edtLoopCount2.Enabled := False;
   chkOffset3.Checked := False;
   chkOffset3.Enabled := False;
end;
end;
procedure TfrmMain.chkOffset3Click(Sender: TObject);
begin
if chkOffset3.Checked then
begin
   cbOffset3.Enabled := True;
   edtOffsetCount3.Enabled := True;
   edtLoopCount3.Enabled := True;
   cbOffset3.ItemIndex := cbOffset2.ItemIndex+1;
end else
begin
   cbOffset3.Enabled := False;
   edtOffsetCount3.Enabled := False;
   edtLoopCount3.Enabled := False;
end;
end;
procedure TfrmMain.ClearListView;
var
I: Integer;
begin
for I := 0 to lvResult.Items.Count - 1 do
begin
         Dispose(lvResult.Items.Item.Data);
end;
lvResult.Clear;
ResultCount := 0;
SelCount := 0;
end;
procedure TfrmMain.cbProcessChange(Sender: TObject);
begin
if ProcessHandel <> 0 then CloseHandle(ProcessHandel);
ProcessHandel := GetSelProcessHandel;
end;
procedure TfrmMain.chkOffset1Click(Sender: TObject);
var
I: Integer;
begin
if chkOffset1.Checked then
begin
   cbOffset1.Enabled := True;
   edtOffsetCount1.Enabled := True;
   edtLoopCount1.Enabled := True;
   chkOffset2.Enabled := True;
   for I := 0 to 11 do
   begin
         if aryEdit.Text = '' then Break;
   end;
   cbOffset1.ItemIndex := I-1;
end else
begin
   cbOffset1.Enabled := False;
   edtOffsetCount1.Enabled := False;
   edtLoopCount1.Enabled := False;
   chkOffset2.Checked := False;
   chkOffset3.Checked := False;
   chkOffset2.Enabled := False;
   chkOffset3.Enabled := False;
end;
end;
function TfrmMain.DataFilter(pData: PFilterData): Boolean;
var
tmpInt1, tmpInt2, tmpInt3: Int64;
tmpFloat1, tmpFloat2, tmpFloat3: Single;
tmpDouble1, tmpDouble2, tmpDouble3: Double;
begin
Result := False;
tmpInt1:=0; tmpInt2:=0; tmpInt3:=0;
tmpFloat1:=0.0; tmpFloat2:=0.0; tmpFloat3:=0.0;
tmpDouble1:=0.0; tmpDouble2:=0.0; tmpDouble3:=0.0;
if rbText.Checked then
begin
   if rbEqual.Checked then
   begin
         if chkTextMatch.Checked then
            Result := (Pos(edtFilter.Text, pData.m_Text) > 0)
         else
            Result := (edtFilter.Text = pData.m_Text);
         exit;
   end;
   exit;
end;
if rbInt.Checked then
begin
   if rbEqual.Checked then
   begin
         Result := (pData.m_Int = StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLarge.Checked then
   begin
         Result := (pData.m_Int > StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLess.Checked then
   begin
         Result := (pData.m_Int < StrToInt(edtFilter.Text));
         exit;
   end;
   if rbUnequal.Checked then
   begin
         Result := (pData.m_Int <> StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLargeOrEqual.Checked then
   begin
         Result := (pData.m_Int >= StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLessOrEqual.Checked then
   begin
         Result := (pData.m_Int <= StrToInt(edtFilter.Text));
         exit;
   end;
   if rbBetween.Checked then
   begin
         Result := ((pData.m_Int >= StrToInt(edtSmall.Text)) And
                     (pData.m_Int <= StrToInt(edtLarge.Text)));
         exit;
   end;
   exit;
end;
if rbUnSign.Checked then
begin
   if rbEqual.Checked then
   begin
         Result := (pData.m_UnSign = StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLarge.Checked then
   begin
         Result := (pData.m_UnSign > StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLess.Checked then
   begin
         Result := (pData.m_UnSign < StrToInt(edtFilter.Text));
         exit;
   end;
   if rbUnequal.Checked then
   begin
         Result := (pData.m_UnSign <> StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLargeOrEqual.Checked then
   begin
         Result := (pData.m_UnSign >= StrToInt(edtFilter.Text));
         exit;
   end;
   if rbLessOrEqual.Checked then
   begin
         Result := (pData.m_UnSign <= StrToInt(edtFilter.Text));
         exit;
   end;
   if rbBetween.Checked then
   begin
         Result := ((pData.m_UnSign >= StrToInt(edtSmall.Text)) And
                     (pData.m_UnSign <= StrToInt(edtLarge.Text)));
         exit;
   end;
   exit;
end;
if rbFloat.Checked then
begin
   if IsFloat(pData.m_Float) = False then Exit;

   if chkFloatToInt.Checked then
   begin
         tmpInt1 := TruncEx(pData.m_Float);
         tmpInt2 := Trunc(StrToFloatEx(edtFilter.Text));
   end else
   begin
         tmpFloat1 := pData.m_Float;
         tmpFloat2 := StrToFloatEx(edtFilter.Text);
   end;
   if rbEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 = tmpInt2)
         else
            Result := (tmpFloat1 = tmpFloat2);
         exit;
   end;
   if rbLarge.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 > tmpInt2)
         else
            Result := (tmpFloat1 > tmpFloat2);
         exit;
   end;
   if rbLess.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 < tmpInt2)
         else
            Result := (tmpFloat1 < tmpFloat2);
         exit;
   end;
   if rbUnequal.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 <> tmpInt2)
         else
            Result := (tmpFloat1 <> tmpFloat2);
         exit;
   end;
   if rbLargeOrEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 >= tmpInt2)
         else
            Result := (tmpFloat1 >= tmpFloat2);
         exit;
   end;
   if rbLessOrEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 <= tmpInt2)
         else
            Result := (tmpFloat1 <= tmpFloat2);
         exit;
   end;
   if rbBetween.Checked then
   begin
         if chkFloatToInt.Checked then
         begin
            tmpInt2 := Trunc(StrToFloatEx(edtSmall.Text));
            tmpInt3 := Trunc(StrToFloatEx(edtLarge.Text));
            Result := ((tmpInt1 >= tmpInt2) And (tmpInt1 <= tmpInt3));
         end else
         begin
            tmpFloat2 := StrToFloatEx(edtSmall.Text);
            tmpFloat3 := StrToFloatEx(edtLarge.Text);
            Result := ((tmpFloat1 >= tmpFloat2) And (tmpFloat1 <= tmpFloat3));
         end;
         exit;
   end;
   exit;
end;
if rbDouble.Checked then
begin
   if IsFloat(pData.m_Double) = False then Exit;

   if chkFloatToInt.Checked then
   begin
         tmpInt1 := TruncEx(pData.m_Double);
         tmpInt2 := Trunc(StrToFloatEx(edtFilter.Text));
   end else
   begin
         tmpDouble1 := pData.m_Double;
         tmpDouble2 := StrToFloatEx(edtFilter.Text);
   end;
   if rbEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 = tmpInt2)
         else
            Result := (tmpDouble1 = tmpDouble2);
         exit;
   end;
   if rbLarge.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 > tmpInt2)
         else
            Result := (tmpDouble1 > tmpDouble2);
         exit;
   end;
   if rbLess.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 < tmpInt2)
         else
            Result := (tmpDouble1 < tmpDouble2);
         exit;
   end;
   if rbUnequal.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 <> tmpInt2)
         else
            Result := (tmpDouble1 <> tmpDouble2);
         exit;
   end;
   if rbLargeOrEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 >= tmpInt2)
         else
            Result := (tmpDouble1 >= tmpDouble2);
         exit;
   end;
   if rbLessOrEqual.Checked then
   begin
         if chkFloatToInt.Checked then
            Result := (tmpInt1 <= tmpInt2)
         else
            Result := (tmpDouble1 <= tmpDouble2);
         exit;
   end;
   if rbBetween.Checked then
   begin
         if chkFloatToInt.Checked then
         begin
            tmpInt2 := Trunc(StrToFloatEx(edtSmall.Text));
            tmpInt3 := Trunc(StrToFloatEx(edtLarge.Text));
            Result := ((tmpInt1 >= tmpInt2) And (tmpInt1 <= tmpInt3));
         end else
         begin
            tmpDouble2 := StrToFloatEx(edtSmall.Text);
            tmpDouble3 := StrToFloatEx(edtLarge.Text);
            Result := ((tmpFloat1 >= tmpDouble2) And (tmpFloat1 <= tmpDouble3));
         end;
         exit;
   end;
   exit;
end;
end;
function TfrmMain.DebugPrivilege(bEnable: Boolean): Boolean;
var
hToken: THandle;
TokenPrivileges: TTokenPrivileges;
RetLength: DWORD;
begin
Result := true;
If OpenProcessToken(GetCurrentProcess(),
                     TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES,
                     hToken) = false then
Begin
   ShowMessage('权限提升失败!');
   exit;
End;
TokenPrivileges.PrivilegeCount := 1;
If bEnable Then
   TokenPrivileges.Privileges.Attributes := SE_PRIVILEGE_ENABLED
Else
   TokenPrivileges.Privileges.Attributes := 0;
LookupPrivilegeValue(nil, 'SeDebugPrivilege', TokenPrivileges.Privileges.Luid);
AdjustTokenPrivileges(hToken, False, TokenPrivileges,
                        sizeof(TokenPrivileges),TokenPrivileges,RetLength);
CloseHandle(hToken);
end;
end.
**** Hidden Message *****

topzhp 发表于 2010-4-17 18:03:08

看起来不错，顶一个！多谢了！

topzhp 发表于 2010-4-17 18:04:52

都不敢乱下了，才下了一个工具，那些辅助版块都进不去了。郁闷！

我叫阿小莫 发表于 2010-5-28 18:47:02

瞧一瞧哈....

bamlan 发表于 2010-6-25 15:11:52

支持一下....

页: [1]

宝峰科技's Archiver

Delphi编写内存遍历工具