unit D7ComboBoxStringsGetPatch;

// The patch fixes TCustomComboBoxStrings.Get method for empty string item in Delphi .

interface

{$IF RTLVersion <> 15.0}

'This patch is intended for Delphi 7 only';

{$IFEND}

implementation

uses

  Windows, SysUtils, StdCtrls;

resourcestring

  RsPatchingFailed = 'TCustomComboBoxStrings.Get patching failed.';

type

  TPatchResult = (prNotNeeded, prOk, prError);

function PatchCode(RoutineStartAddr: Pointer; PatchOffset: Cardinal; OriginalCode: Pointer;

  OriginalCodeLen: Cardinal; PatchedCode: Pointer; PatchedCodeLen: Cardinal): TPatchResult;

const

  JmpOpCode = $25FF;

type

  PPackageThunk = ^TPackageThunk;

  TPackageThunk = packed record

    JmpInstruction: Word;

    JmpAddress: PPointer;

  end;

var

  CodeStart: Pointer;

  BytesWritten: DWORD;

begin

  if FindClassHInstance(System.TObject) <> HInstance then

    with PPackageThunk(RoutineStartAddr)^ do

      if JmpInstruction = JmpOpCode then

        RoutineStartAddr := JmpAddress^

      else

      begin

        Result := prError;

        Exit;

      end;

  CodeStart := Pointer(LongWord(RoutineStartAddr) + PatchOffset);

  if CompareMem(CodeStart, OriginalCode, OriginalCodeLen) then

  begin

    if WriteProcessMemory(GetCurrentProcess, CodeStart, PatchedCode, PatchedCodeLen, BytesWritten) and

      (BytesWritten = PatchedCodeLen) then

    begin

      FlushInstructionCache(GetCurrentProcess, CodeStart, PatchedCodeLen);

      Result := prOk;

    end

    else

      Result := prError;

  end

  else

    Result := prNotNeeded;

end;

type

  TCustomComboBoxStringsHack = class(TCustomComboBoxStrings);

function AddrOfTCustomComboBoxStringsGet: Pointer;

begin

  Result := @TCustomComboBoxStringsHack.Get;

end;

procedure PatchTCustomComboBoxStringsGet;

const

  OriginalCode: Cardinal  = $74FFF883; // CMP EAX, - | JZ  +$

  PatchedCode: Cardinal   = $7E00F883; // CMP EAX,   | JLE +$

  PatchOffset             = $1F;

  // for DEBUG DCU by Pavel Rogulin

  OriginalCodeD: Cardinal = $FFF07D83;

  PatchedCodeD: Cardinal  = $00F07D83;

  PatchOffsetD            = $2E;

var

  PatchResult: TPatchResult;

begin

  PatchResult := PatchCode(AddrOfTCustomComboBoxStringsGet, PatchOffset, @OriginalCode, SizeOf(OriginalCode),

    @PatchedCode, SizeOf(PatchedCode));

  if PatchResult = prNotNeeded then

    PatchResult := PatchCode(AddrOfTCustomComboBoxStringsGet, PatchOffsetD, @OriginalCodeD, SizeOf(OriginalCodeD),

      @PatchedCodeD, SizeOf(PatchedCodeD));

  case PatchResult of

    prError:

      begin

        if IsConsole then

          WriteLn(ErrOutput, RsPatchingFailed)

        else

          MessageBox(, PChar(RsPatchingFailed), nil, MB_OK or MB_ICONSTOP or MB_TASKMODAL);

        RunError();

      end;

  end;

end;

initialization

  PatchTCustomComboBoxStringsGet;

end.

官方BUG解决地址:

http://cc.embarcadero.com/item/18872

(转)TComboBox patch for Delphi 7的更多相关文章

  1. Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox、TComboEdit

    Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox.TComboEdit TListBox 有两个兄弟 TComboListBox.TComboEditL ...

  2. delphi连接sql存储过程

    针对返回结果为参数的 一. 先建立自己的存储过程 ALTER PROCEDURE [dbo].[REName] ) AS BEGIN select ROW_NUMBER() over(order by ...

  3. 转:Delphi 6 实用函数

    来自: daocaoren0824, 时间: -- ::, ID: 再给你一份 程序员实用函数 {▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎} {▎ ▎} {▎ 大 ...

  4. delphi里动态创建AlphaControls实现换肤

    AlphaControls是一套Delphi下的优秀的皮肤vcl控件.几年前,一般用得比较多的是vclskin,使用很方便,可惜这套2010年已经停止维护了.后来就看到更多的人开始推崇AlphaCon ...

  5. delphi.指针.应用

    注:初稿...有点乱,可能增删改... 因为指针应用,感觉不好写,请大家指出错误,谢谢. 注意: 本文着重点讲的是指针的各类型的应用或使用,而不是说这种方法不应该+不安全+危险+不提倡使用. 其它:本 ...

  6. Delphi完成的断点续传例子 转

    unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms ...

  7. Delphi经验总结(1)

    先人的DELPHI基础开发技巧 ◇[DELPHI]网络邻居复制文件 uses shellapi; copyfile(pchar('newfile.txt'),pchar('//computername ...

  8. Delphi xe7 FireMonkey / Mobile (Android, iOS)生成 QR Code完整实例

    这个实例在windows.OS X.IOS和Android等平台运行正常.本文参考这个网站提供的方法:http://zarko-gajic.iz.hr/firemonkey-mobile-androi ...

  9. 2年后的Delphi XE6

    1.有幸下载到Delphi XE6,下载地址如下: http://altd.embarcadero.com/download/radstudio/xe6/delphicbuilder_xe6_win. ...

随机推荐

  1. 【LeetCode】060. Permutation Sequence

    题目: The set [1,2,3,…,n] contains a total of n! unique permutations. By listing and labeling all of t ...

  2. “Hello World”—— 第一个汇编程序

    Hello World这是每一门编程语言的第一个最简单程序,下面那个程序就是汇编语言的Hello World.学汇编一段时间了,到现在才记录下自己的第一个汇编程序笔记.虽然这是个相当简单的小程序,但这 ...

  3. 逐步改用 IronPython 开发你的 ASP.NET 应用程序

    IronPython for ASP.NET 的 CTP 已经发布有一段时间了,我们在看了官方提供的范例之后,相信对一个 ASP.NET 应用程序中完全使用 IronPython 开发还是有一些担心的 ...

  4. 洛谷【P1138】第k小整数

    题目传送门:https://www.luogu.org/problemnew/show/P1138 桶排: 对于值域在可以接受的范围内时,我们可以用不依赖比较的桶排去将数据排序.因为桶排不依赖比较排序 ...

  5. mybatis 学习四 源码分析 mybatis如何执行的一条sql

    总体三部分,创建sessionfactory,创建session,执行sql获取结果 1,创建sessionfactory      这里其实主要做的事情就是将xml的所有配置信息转换成一个Confi ...

  6. shell入门-tr替换字符和split切割大文件

    命令:tr 说明:替换字符 格式tr ‘原字符’ ‘新字符’ 可以是范围字符,指定字符 命令:split 选项:-b 50m 1.txt  根据大小分割 单位是b不用单位,单位是兆加m -l 100 ...

  7. SSDB VS redis

    现在有不少团队开始使用了一个新型高效的 NoSQL数据库 - SSDB,如 京东.唱吧 …… SSDB 官网的定义 一个高性能的支持丰富数据结构的 NoSQL 数据库,用于替代 Redis 官网 ht ...

  8. C++中的对象的赋值和复制

    对象的赋值 如果对一个类定义了两个或多个对象,则这些同类的对象之间可以互相赋值,或者说,一个对象的值可以赋给另一个同类的对象.这里所指的对象的值是指对象中所有数据成员的值. 对象之间的赋值也是通过赋值 ...

  9. Learning Python 012 函数式编程 1 高阶函数

    Python 函数式编程 1 高阶函数 高阶函数 Q:什么是高阶函数? A:一个函数接收另一个函数作为参数,这种函数就称之为高阶函数. 简单举个例子: def add(x, y, f): return ...

  10. 内核启动流程2-C语言部分的最后一个函数init_post()

    最后分析最终调用用户空间init进程的函数init_post(). static noinline int init_post(void)这是一个非_init函数.强制让它为非内联函数,以防gcc让它 ...