(转)TComboBox patch for Delphi 7
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的更多相关文章
- Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox、TComboEdit
Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox.TComboEdit TListBox 有两个兄弟 TComboListBox.TComboEditL ...
- delphi连接sql存储过程
针对返回结果为参数的 一. 先建立自己的存储过程 ALTER PROCEDURE [dbo].[REName] ) AS BEGIN select ROW_NUMBER() over(order by ...
- 转:Delphi 6 实用函数
来自: daocaoren0824, 时间: -- ::, ID: 再给你一份 程序员实用函数 {▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎} {▎ ▎} {▎ 大 ...
- delphi里动态创建AlphaControls实现换肤
AlphaControls是一套Delphi下的优秀的皮肤vcl控件.几年前,一般用得比较多的是vclskin,使用很方便,可惜这套2010年已经停止维护了.后来就看到更多的人开始推崇AlphaCon ...
- delphi.指针.应用
注:初稿...有点乱,可能增删改... 因为指针应用,感觉不好写,请大家指出错误,谢谢. 注意: 本文着重点讲的是指针的各类型的应用或使用,而不是说这种方法不应该+不安全+危险+不提倡使用. 其它:本 ...
- Delphi完成的断点续传例子 转
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms ...
- Delphi经验总结(1)
先人的DELPHI基础开发技巧 ◇[DELPHI]网络邻居复制文件 uses shellapi; copyfile(pchar('newfile.txt'),pchar('//computername ...
- Delphi xe7 FireMonkey / Mobile (Android, iOS)生成 QR Code完整实例
这个实例在windows.OS X.IOS和Android等平台运行正常.本文参考这个网站提供的方法:http://zarko-gajic.iz.hr/firemonkey-mobile-androi ...
- 2年后的Delphi XE6
1.有幸下载到Delphi XE6,下载地址如下: http://altd.embarcadero.com/download/radstudio/xe6/delphicbuilder_xe6_win. ...
随机推荐
- Marionettejs
Marionette是牵线木偶的意思,这个库是对Backbone的一次更高层次封装.这样的封装有两个目标: 减少重复的工作,提高使用Backbonejs时的生产效率给复杂应用页面提供更多的结构,以支撑 ...
- 学习Web前端的好网站推荐
说明:将其他技术技术网址也搜藏到下面,与君共同进步 1.Jquery专题 http://kb.cnblogs.com/zt/jquery/ 2.Entity Framwork专题 http://kb. ...
- WSDL入门
WSDL: 网络服务描述语言, 是Web Service的描述语言,它全名:Web Services Description Language,是一门基于 XML 的语言,用于描述 Web Servi ...
- Maven Cargo 远程部署到tomcat7x
pom.xml中加入cargo的Plugin声明: <plugin> <groupId>org.codehaus.cargo</groupId> <artif ...
- TCP/IP四层体系结构
1.数据链路层 2.网络层 3.传输层 4.应用层 , 其中IP是在第二层网络层中,TCP是在第3层传输层中, Internet体系结构最重要的是TCP/IP协议,是实现互联网络连接性和互操作性 ...
- Sharepoint商务智能学习笔记之PowerPviot Service安装与配置(七)
1) PowerPviot Service多服务器部署注意事项 PowerPviot Service不是Sharepoint自带的服务,要想使用PowerPviot Service需要先在sharep ...
- 开发过程中--使用base64解决传输字符串加密问题!
反正上周在解决开发公司小工具时,需要将用户输入的字符串加密处理传输,那就直接贴上代码吧,希望能帮上你们: strToArrayBufferToBase64(str) { let pos = 0, le ...
- JSONCPP开发环境搭建
环境设置 项目地址 https://github.com/open-source-parsers/jsoncpp.git 操作系统 64位 Fedora 24 安装jsoncpp $ git clon ...
- [CentOS7] 常用工具 之 防暴力破解工具 Fail2ban
防止暴力破解密码: Fail2ban ==> 用于自动ban掉ip 先用yum search fail2ban看看是否yum源含有fail2ban这个package,若没有的话请yum inst ...
- [Windows]获取当前时间(年/月/日/时/分/秒)
struct tm* GetCurTime(time_t inTime) { struct tm* curTime = localtime(&inTime); curTime->tm_y ...