【转】解决Delphi WebBrowser 无法调用当前浏览器的版本 复制代码

复制代码
procedure TregedtIE.FormCreate(Sender: TObject);  
begin  
  WriteAppNameToReg;  
  WebBrowser1.Navigate('C:\a.html');  
end;  
{--}  
{需要注意是GetNativeSystemInfo 函数从Windows XP 开始才有, 
 而 IsWow64Process 函数从 Windows XP with SP2 以及 Windows Server 2003 with SP1 开始才有。 
 所以使用该函数的时候最好用GetProcAddress 。 
}  
function TregedtIE.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 TregedtIE.WriteAppNameToReg: Boolean;  
var  
  reg :TRegistry;  
  sPath,sAppName:String;  
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);  
     if not reg.ValueExists(sAppName) then  
        reg.WriteInteger(sAppName,0);  
    end;  
    reg.CloseKey;  
  finally  
    FreeAndNil(reg);  
  end;  
end;  
{--}  
procedure TregedtIE.WebBrowser1DocumentComplete(ASender: TObject;  
  const pDisp: IDispatch; var URL: OleVariant);  
begin  
  WebBrowser1.OleObject.Document.Body.Scroll :'no';  
  WebBrowser1.OleObject.Document.Body.style.border :'none';  
  webbrowser1.OleObject.Document.Body.Style.margin :'0px';  
end;  
复制代码
相关文章
相关标签/搜索