晕，附件怎么没了？？

晕死了，只能贴贴代码了！！

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.

再上传一次。
“管理附件”->上传即可

呵呵老了

正想学习一下插件的编写，下去学习一下。支持开源顶顶顶顶[/COLOR

这个好，研究一下。

和invisible.dll OllyDbg Hiding Plugin By okdodo
插件有冲突 二者只能用其一 没完完毕

跟AdvancedOlly 1.26 Bate12也冲突！！
报告完毕

跟AdvancedOlly 1.26 Bate12没有冲突
只是和别的有才引起AdvancedOlly 1.26 Bate12出错

晕，附件怎么没了？？

怎么提取不了??
提取到的是英文字符~

其实就是mov和push后面的地址如果落到代码段,那么99%就是Delphi的字符串常量

会出错，而且找到的字串效果也不是很好
希望作者继续努力下。。。

好东西啊，谢谢分享！

跟AdvancedOlly 1.26 Bate12没有冲突
只是和别的有才引起AdvancedOlly 1.26 Bate12出错

希望高手完善代码

正在学习Delphi，谢谢分享

OD  加载  提示异常发生  ADDRESS:08什么什么  没记全

希望作者再处理下bug，报错。支持共享

谢谢下载看看

感谢分享 辛苦了

希望继续改进

有更新嘛，类信息提示不支持