首页
社区
课程
招聘
[原创]ODPlugin :Delphi写的提取Delphi字符串控件(开源)
发表于: 2008-4-28 20:52 15692

[原创]ODPlugin :Delphi写的提取Delphi字符串控件(开源)

2008-4-28 20:52
15692
软件名称: ForDelphi
软件作者: sandy
源码语言: Delphi
编译环境: Delphi2007
软件简介: 提取Delphi字符串
其他说明:
1.学习一下Od控件的编写
2:争取向dede一样,以后将会增加获取delphi的类信息功能
3:呵呵,就想开源骗精了

修改查询头长为四字节字符串的错误

[招生]科锐逆向工程师培训(2024年11月15日实地,远程教学同时开班, 第51期)

上传的附件:
收藏
免费 0
支持
分享
最新回复 (23)
雪    币: 223
活跃值: (25)
能力值: ( LV4,RANK:50 )
在线值:
发帖
回帖
粉丝
2
晕,附件怎么没了??
2008-4-28 20:53
0
雪    币: 223
活跃值: (25)
能力值: ( LV4,RANK:50 )
在线值:
发帖
回帖
粉丝
3
晕死了,只能贴贴代码了!!

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.
2008-4-28 20:58
0
雪    币: 47147
活跃值: (20375)
能力值: (RANK:350 )
在线值:
发帖
回帖
粉丝
4
再上传一次。
“管理附件”->上传即可
2008-4-28 21:09
0
雪    币: 223
活跃值: (25)
能力值: ( LV4,RANK:50 )
在线值:
发帖
回帖
粉丝
5
呵呵老了
2008-4-29 08:03
0
雪    币: 201
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
6
正想学习一下插件的编写,下去学习一下。支持开源顶顶顶顶[/COLOR
2008-4-29 08:18
0
雪    币: 200
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
7
这个好,研究一下。
2008-4-29 08:53
0
雪    币: 196
活跃值: (2162)
能力值: ( LV4,RANK:50 )
在线值:
发帖
回帖
粉丝
8
和invisible.dll OllyDbg Hiding Plugin By okdodo
插件有冲突 二者只能用其一 没完完毕
2008-4-29 18:25
0
雪    币: 275
活跃值: (130)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
9
跟AdvancedOlly 1.26 Bate12也冲突!!
报告完毕
2008-5-1 00:51
0
雪    币: 196
活跃值: (2162)
能力值: ( LV4,RANK:50 )
在线值:
发帖
回帖
粉丝
10
跟AdvancedOlly 1.26 Bate12没有冲突
只是和别的有才引起AdvancedOlly 1.26 Bate12出错
2008-5-1 03:31
0
雪    币: 150
活跃值: (1100)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
11
晕,附件怎么没了??
2008-5-1 12:54
0
雪    币: 200
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
12
怎么提取不了??
提取到的是英文字符~
2008-5-14 21:04
0
雪    币: 126
活跃值: (179)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
13
其实就是mov和push后面的地址如果落到代码段,那么99%就是Delphi的字符串常量
2008-5-21 10:29
0
雪    币: 200
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
14
会出错,而且找到的字串效果也不是很好
希望作者继续努力下。。。
2008-5-21 13:23
0
雪    币: 174
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
15
好东西啊,谢谢分享!
2008-5-26 19:10
0
雪    币: 218
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
16
跟AdvancedOlly 1.26 Bate12没有冲突
只是和别的有才引起AdvancedOlly 1.26 Bate12出错
2008-6-4 21:08
0
雪    币: 124
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
17
希望高手完善代码
2008-6-11 16:01
0
雪    币: 590
活跃值: (177)
能力值: ( LV9,RANK:680 )
在线值:
发帖
回帖
粉丝
18
正在学习Delphi,谢谢分享
2008-7-21 19:14
0
雪    币: 231
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
19
OD  加载  提示异常发生  ADDRESS:08什么什么  没记全
2008-10-2 03:57
0
雪    币: 156
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
20
希望作者再处理下bug,报错。支持共享
2008-10-24 15:02
0
雪    币: 563
活跃值: (95)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
21
谢谢下载看看
2009-1-16 19:39
0
雪    币: 201
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
22
感谢分享 辛苦了
2009-3-17 12:14
0
雪    币: 563
活跃值: (95)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
23
希望继续改进
2009-3-29 22:55
0
雪    币: 43
活跃值: (87)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
24
有更新嘛,类信息提示不支持
2018-5-8 05:03
0
游客
登录 | 注册 方可回帖
返回
//