晕死了,只能贴贴代码了!!
unit uDelphiHandle;
interface
uses
classes, Plugin, StrUtils, SysUtils, Windows, Messages, Menus;
type
TDelphiSortHeader = packed record
addr: ULONG; // Base address of the entry
size: ULONG; // Size address of the entry
type_ul: ULONG; // Entry type, TY_xxx
index: Cardinal; // ustrref index
atype: Cardinal; // Type of entry, always 0
iscureip: Cardinal; // Is Current EIP? 0: No, 1: Yes.
end;
PDelphiSortHeader = ^TDelphiSortHeader;
TDelphiStringItem = class(TCollectionItem)
private
FStr: string;
FDASM: string;
FAddr: Cardinal;
procedure SetAddr(const Value: Cardinal);
procedure SetDASM(const Value: string);
procedure SetStr(const Value: string);
public
property Addr: Cardinal read FAddr write SetAddr;
property DASM: string read FDASM write SetDASM;
property Str: string read FStr write SetStr;
end;
TDelphiHandle = class
private
FErrorStrings: TStrings;
FDelphiStrs: TCollection;
FStringtable: t_table;
FDelphistringclass: string;
FPluginName: string;
FHOllyModule: HMODULE;
FWinClass: string;
FHOllyWnd: HWND;
function GetCurEIP: Cardinal;
procedure SetStringtable(const Value: t_table);
procedure SetPluginName(const Value: string);
procedure SetHOllyModule(const Value: HMODULE);
procedure SetDelphiStrs(const Value: TCollection);
procedure SetWinClass(const Value: string);
procedure SetHOllyWnd(const Value: HWND);
function FindString(Addr: Cardinal): string;
public
Constructor Create;
destructor destroy;
procedure CreateStringWindow;
procedure GetDelphiString;
procedure RegisterClass;
procedure IniParam;
property Stringtable: t_table read FStringtable write SetStringtable;
property PluginName: string read FPluginName write SetPluginName;
property HOllyModule: HMODULE read FHOllyModule write SetHOllyModule;
property HOllyWnd: HWND read FHOllyWnd write SetHOllyWnd;
property DelphiStrs: TCollection read FDelphiStrs write SetDelphiStrs;
property WinClass: string read FWinClass write SetWinClass;
end;
var
gDelphiHandle: TDelphiHandle;
function OnGetDelphiString(s: PChar; mask: PChar; select: PInteger;
ps: p_sortheader; column: Integer): Integer; cdecl;
implementation
function OnGetDelphiString(s: PChar; mask: PChar; select: PInteger;
ps: p_sortheader; column: Integer): Integer; cdecl;
var
aPDelphiSortHeader: PDelphiSortHeader;
aStringItem: TDelphiStringItem;
str: string;
begin
aPDelphiSortHeader := Pointer(Ps);
Result := 0;
aStringItem := TDelphiStringItem(
gDelphiHandle.DelphiStrs.Items[aPDelphiSortHeader.index]);
select := nil;
case column of
0: // Address
begin
str := Format('%0.8x',[aStringItem.addr]);
end;
1: // Disassembly
begin
str := aStringItem.DASM;
end;
2: // Text String
begin
str := aStringItem.Str;
end;
end;
//s[Result] := Char(0);
Result := Length(str);
StrCopy(s, PChar(str));
end;
function TableWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
PSortHeader: PDelphiSortHeader;
aHMenu: HMENU;
begin
Result := 0;
case Msg of
WM_DESTROY,
WM_MOUSEMOVE,
WM_LBUTTONDOWN,
WM_LBUTTONDBLCLK,
WM_LBUTTONUP,
WM_RBUTTONDOWN,
WM_RBUTTONDBLCLK,
WM_HSCROLL,
WM_VSCROLL,WM_TIMER,WM_SYSKEYDOWN:
begin
Tablefunction(@(gDelphiHandle.Stringtable), hWnd, msg, wParam, lParam);
end;
WM_USER_SCR,
WM_USER_VABS,
WM_USER_VREL,
WM_USER_VBYTE,
WM_USER_STS,
WM_USER_CNTS,
WM_USER_CHGS,WM_WINDOWPOSCHANGED,WM_USER_MENU,WM_KEYDOWN:
begin
Result := Tablefunction(@(gDelphiHandle.Stringtable), hWnd, msg, wParam, lParam);
exit;
end;
WM_USER_DBLCLK:
begin
PSortHeader := Getsortedbyselection(@(gDelphiHandle.Stringtable.data),
gDelphiHandle.Stringtable.data.selected);
if Assigned(PSortHeader) then
begin
Setcpu(0, PSortHeader.addr, 0, 0,
CPU_ASMHIST and CPU_ASMCENTER and CPU_ASMFOCUS);
end;
Result := 1;
exit;
end;
WM_USER_CHALL,
WM_USER_CHMEM:
begin
InvalidateRect(hWnd, nil, FALSE);
exit;
end;
WM_PAINT:
begin
Painttable(hWnd, @(gDelphiHandle.Stringtable),
@OnGetDelphiString);
Result := 0;
exit;
end;
end;
Result := DefMDIChildProc(hWnd, msg, wParam, lParam);
end;
{ TDelphiHandle }
constructor TDelphiHandle.Create;
begin
FErrorStrings := TStringList.Create;
FDelphiStrs := TCollection.Create(TDelphiStringItem);
FillChar(PChar(@Stringtable)^, SizeOf(Stringtable) ,0);
end;
procedure TDelphiHandle.CreateStringWindow;
begin
if FStringtable.bar.nbar = 0 then
begin
FStringtable.bar.name[0] := 'Address';
FStringtable.bar.defdx[0] := 9;
FStringtable.bar.mode[0] := Char(BAR_NOSORT);
FStringtable.bar.name[1] := 'Disassembly';
FStringtable.bar.defdx[1] := 40;
FStringtable.bar.mode[1] := Char(BAR_NOSORT);
FStringtable.bar.name[2] := 'Text String';
FStringtable.bar.defdx[2] := 256;
FStringtable.bar.mode[2] := Char(BAR_NOSORT);
FStringtable.bar.nbar := 3;
FStringtable.mode :=
TABLE_COPYMENU or
TABLE_SORTMENU or
TABLE_APPMENU or
TABLE_SAVEPOS or TABLE_ONTOP;
FStringtable.drawfunc := OnGetDelphiString;
end;
Quicktablewindow(
@FStringtable,
15,
3,
PChar(WinClass),
PChar(PluginName)
);
end;
destructor TDelphiHandle.destroy;
begin
FErrorStrings.Free;
FDelphiStrs.Free;
end;
function TDelphiHandle.FindString(Addr: Cardinal): string;
const
strEnglishSign: string = ',./<>?''";:]}[{\|=+-_)(*&^%$#@!~` ';
strNumberSign: string = '0123456789';
strCharSign: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
istrLen, istrTail: Cardinal;
bstrLen, bstrTail: byte;
PFindMem: P_memory;
i: Integer;
pReadBuf: PChar;
iLoop: integer;
begin
Result := '';
try
PFindMem := Findmemory(Addr);
if Assigned(PFindMem) and (PFindMem.sect[0] <> Char(0)) then
begin
//双字节
Readmemory(@istrLen, Addr - 4, 4, MM_RESTORE and MM_SILENT);
if (istrLen < 10240) and (istrLen > 1) then
begin
Readmemory(@istrTail, Addr + istrLen, 4, MM_RESTORE and MM_SILENT);
if istrTail = 0 then
begin
SetLength(Result, istrLen);
Readmemory(@Result[1], Addr ,istrLen, MM_RESTORE and MM_SILENT);
Result := string(PChar(Result));
for i := 1 to Length(Result) -1 do
begin
if (Result[i] = Char(0)) then
begin
Result := '';
exit;
end;
end;
Exit;
end;
end;
//单字节
Readmemory(@bstrLen, Addr - 1, 1, MM_RESTORE and MM_SILENT);
if bstrLen > 0 then
begin
Readmemory(@bstrTail, Addr + bstrLen, 1, MM_RESTORE and MM_SILENT);
if bstrTail = 0 then
begin
SetLength(Result, istrLen);
Readmemory(@Result[1], Addr ,bstrLen, MM_RESTORE and MM_SILENT);
Result := string(PChar(Result));
for i := 1 to Length(Result) do
begin
if not (
(Pos(Result[i], strEnglishSign) > 0) or
(Pos(Result[i], strNumberSign) > 0) or
(Pos(Result[i], strCharSign) > 0)
) then
begin
Result := '';
exit;
end;
end;
end;
end;
//pchar
iLoop := 0;
Result := '';
GetMem(pReadBuf, 16);
try
while True do
begin
Readmemory(
pReadBuf,
Addr + 16 * iLoop,
16, MM_RESTORE and MM_SILENT);
for i := 0 to 15 do
begin
if (Pos(pReadBuf[i], strEnglishSign) > 0) or
(Pos(pReadBuf[i], strNumberSign) > 0) or
(Pos(pReadBuf[i], strCharSign) > 0)
then
begin
Result := Result + pReadBuf[i];
end
else if pReadBuf[i] = Char(0) then
begin
exit;
end
else
begin
Result := '';
exit;
end;
end;
inc(iLoop, 16);
end;
finally
FreeMem(pReadBuf, 16);
end;
end;
except
on E: Exception do
begin
FErrorStrings.Add('Error:' + e.Message + ',at ' +
IntToStr(Addr)) ;
end;
end;
end;
function TDelphiHandle.GetCurEIP: Cardinal;
var
aPThread: P_thread;
begin
aPThread := Findthread(Cardinal(Getcputhreadid()));
Result := aPThread.reg.ip;
end;
procedure TDelphiHandle.GetDelphiString;
var
i: integer;
data: t_disasm;
DasmBase: Cardinal;
DasmSize: Cardinal;
Mark: TDelphiSortHeader;
CurEIP: Cardinal;
index: Cardinal;
Cmd: array[0..MAXCMDSIZE-1] of Char;
CmdSize: Cardinal;
strIndex: Cardinal;
DisasmRet: string;
StrLen: Cardinal;
strTail: integer;
strRead: string;
aStrItem: TDelphiStringItem;
begin
strIndex := 0;
FErrorStrings.Clear;
FDelphiStrs.Clear;
if FStringtable.data.n > 0 then
Deletesorteddatarange(@(FStringtable.data), 0, FStringtable.data.n - 1);
CurEIP := GetCurEIP;
Getdisassemblerrange(@DasmBase, @DasmSize);
index := 0;
while index < DasmSize do
begin
Readcommand(DasmBase + index, Cmd);
CmdSize := Disasm(Cmd, MAXCMDSIZE, DasmBase + index, nil, @Data,
DISASM_CODE, 0);
if CurEIP = (DasmBase + index) then
begin
Mark.index := strIndex;
Mark.size := 1;
Mark.atype := 0;
Mark.addr := CurEIP;
Mark.iscureip := 1;
Addsorteddata(@(FStringtable.data), @Mark);
aStrItem := TDelphiStringItem(FDelphistrs.Add);
aStrItem.Str := '(Initial CPU EIP)';
aStrItem.Addr := DasmBase + index;
aStrItem.DASM := '';
Inc(strIndex);
end;
DisasmRet := LowerCase(data.result);
if (Pos('mov', DisasmRet) > 0) or
(Pos('push', DisasmRet) > 0) or
(Pos('lea', DisasmRet) > 0)
then
begin
strRead := FindString(data.immconst);
if strRead <> '' then
begin
//数据头
Mark.index := strIndex;
Mark.size := 1;
Mark.atype := 0;
Mark.addr := DasmBase + index;
Mark.iscureip := 1;
Addsorteddata(@(FStringtable.data), @Mark);
aStrItem := TDelphiStringItem(FDelphistrs.Add);
aStrItem.Str := strRead;
aStrItem.Addr := DasmBase + index;
aStrItem.DASM := DisasmRet;
Inc(strIndex);
end;
end;
Inc(index, CmdSize);
Progress(index * 1000 div DasmSize, 'Delphi Strings found: %d', strIndex);
end;
FErrorStrings.SaveToFile('Error.txt');
Progress(0, '$');
Infoline('Total strings found: %d - ForDelphi String Find', strIndex);
CreateStringWindow;
Selectandscroll(@Stringtable, 0, 2);
end;
procedure TDelphiHandle.IniParam;
var
strCalssName: string;
begin
if Createsorteddata(@(Stringtable.Data),
'ForDelphi', SizeOf(TDelphiSortHeader), 32, nil, nil) = -1 then
begin
Addtolist(0, 0, 'Createsorteddata Error');
Exit;
end;
SetLength(strCalssName,32);
Registerpluginclass(PChar(strCalssName),nil,HOllyWnd,@TableWndProc);
gDelphiHandle.WinClass := string(PChar(strCalssName));
if (Plugingetvalue(VAL_RESTOREWINDOWPOS)<> 0) and
(Pluginreadintfromini(HOllyWnd,'ForDelphi',0) <> 0) then
begin
gDelphiHandle.CreateStringWindow;
end;
end;
procedure TDelphiHandle.RegisterClass;
begin
Registerpluginclass(PChar(FDelphistringclass),
nil, FHOllyModule, nil);
end;
procedure TDelphiHandle.SetDelphiStrs(const Value: TCollection);
begin
FDelphiStrs := Value;
end;
procedure TDelphiHandle.SetHOllyModule(const Value: HMODULE);
begin
FHOllyModule := Value;
end;
procedure TDelphiHandle.SetHOllyWnd(const Value: HWND);
begin
FHOllyWnd := Value;
end;
procedure TDelphiHandle.SetPluginName(const Value: string);
begin
FPluginName := Value;
end;
procedure TDelphiHandle.SetStringtable(const Value: t_table);
begin
FStringtable := Value;
end;
procedure TDelphiHandle.SetWinClass(const Value: string);
begin
FWinClass := Value;
end;
{ TDelphiStringItem }
procedure TDelphiStringItem.SetAddr(const Value: Cardinal);
begin
FAddr := Value;
end;
procedure TDelphiStringItem.SetDASM(const Value: string);
begin
FDASM := Value;
end;
procedure TDelphiStringItem.SetStr(const Value: string);
begin
FStr := Value;
end;
end.