声明:其中的代码基本是完全Copy过来的,见这个链接(https://www.cnblogs.com/zhqian/p/6067820.html)
整理代码原因:1)没有使用说明;2)有 if else 的多次嵌套容易眼花;3)有 HTML 换行符与注释混淆,且有窗体的东西嵌在其中,所以并不是在D7中贴上代码就能运行。
代码这里开始:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ComCtrls, Registry, StrUtils;
type
TFrmMain = class(TForm)
MainTree: TTreeView;
ImageList1: TImageList;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
function WriteAppNameToReg: Boolean; //关键这个函数,写注册表
implementation
{$R *.dfm} {
------------------------------------------------------------------------------------------------------------------------}
function IsWin64:Boolean;
var
Kernel32Handle:THandle;
IsWow64Process: function(Handle:Windows.THandle; var Res:Windows.BOOL):Windows.BOOL; stdcall;
GetNativeSystemInfo: procedure(var lpSystemInfo:TSystemInfo); stdcall;
isWoW64:Bool; SystemInfo:TSystemInfo;
const
PROCESSOR_ARCHITECTURE_AMD64 =9;
PROCESSOR_ARCHITECTURE_IA64 =6;
begin
Kernel32Handle:= GetModuleHandle('KERNEL32.DLL');
if Kernel32Handle = 0 then Kernel32Handle:= LoadLibrary('KERNEL32.DLL');
if Kernel32Handle <> 0 then
begin
IsWOW64Process:= GetProcAddress(Kernel32Handle,'IsWow64Process');
GetNativeSystemInfo:= GetProcAddress(Kernel32Handle,'GetNativeSystemInfo');
if Assigned(IsWow64Process) then
begin
IsWow64Process(GetCurrentProcess, isWoW64);
Result:= isWoW64 and Assigned(GetNativeSystemInfo);
if Result then
begin
GetNativeSystemInfo(SystemInfo); Result:=
(SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64) or
(SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_IA64);
end;
end else Result:= False;
end else Result:= False;
end;{
------------------------------------------------------------------------------------------------------------------------}
function GetIEVersionStr: string;
var
Reg:TRegistry; // registry access object
begin
Result:=''; Reg:= TRegistry.Create;
try
Reg.RootKey:= Windows.HKEY_LOCAL_MACHINE;
//这儿新版本IE的取值位置不同所以要判断:
if Reg.OpenKeyReadOnly('Software\Microsoft\Internet Explorer') then
begin
if Reg.ValueExists('svcVersion') then Result:= Reg.ReadString('svcVersion') else
if Reg.ValueExists('Version') then Result:= Reg.ReadString('Version');
end;
finally
Reg.Free;
end;
end;{
------------------------------------------------------------------------------------------------------------------------}
function WriteAppNameToReg: Boolean;
var
reg: TRegistry;
sPath,sAppName: String;
Sver: string;
lenver: Integer;
begin
Result:= True;
reg:= TRegistry.Create;
try
reg.RootKey:=HKEY_LOCAL_MACHINE;
sPath:='SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION';
if isWin64 then sPath:= 'SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION';
if reg.OpenKey(sPath,True) then
begin
sAppName:= ExtractFileName(Application.ExeName);
Sver:= GetIEVersionStr;
Lenver:= StrToInt(leftstr(Sver, Pos('.',Sver)-1));
// if not reg.ValueExists(sAppName)then
if lenver <=7 then reg.WriteInteger(sAppName, 7000);
if lenver = 8 then reg.WriteInteger(sAppName, 8000);
if lenver = 9 then reg.WriteInteger(sAppName, 9000);
if lenver =10 then reg.WriteInteger(sAppName,10000);
if lenver =11 then reg.WriteInteger(sAppName,11001);
end;
reg.CloseKey;
finally
FreeAndNil(reg);
end;
end;
end.