-2

如何在 64BitOS 中运行 64Bit Compiled PE 并在 64BitOS 中停止 32Bit Compiled PE？
我有一个Delphi XE2 项目来在 Windows 注册表中创建一些节点和子节点，如下所述：

和我的项目编译器选项如下：

我已经定义了以下代码：

function GetWinDir: string;
var
  WindowsDirectory: array[0..MAX_PATH] of Char;
begin
   GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
   SetLength(Result, StrLen(WindowsDirectory));
   Result := IncludeTrailingPathDelimiter(WindowsDirectory);
end;

function GetSysDir: string;
var
  SystemDirectory: array[0..MAX_PATH] of Char;
begin
  GetSystemDirectory(SystemDirectory, MAX_PATH - 1);
  SetLength(Result, StrLen(SystemDirectory));
  Result := IncludeTrailingPathDelimiter(SystemDirectory);
end;

function GetSysNativeDir: string;
var
  WindowsDirectory: array[0..MAX_PATH] of Char;
begin
   GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
   SetLength(Result, StrLen(WindowsDirectory));
   Result := IncludeTrailingPathDelimiter(WindowsDirectory)  + 'Sysnative\';
end;

procedure TMainForm.BitBtn01Click(Sender: TObject);
var
  RegistryEntry : TRegistry;
  RegistryEntryValue : string;   
begin
  RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
  RegistryEntry.RootKey := HKEY_CLASSES_ROOT;
  if (not RegistryEntry.KeyExists('CLSID\{BE800AEB-A440-4B63-94CD-AA6B43647DF9}\')) then
    begin
      RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
      if RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\',true) then
        begin
          Memo01.Font.Color := 3992580;
          Memo01.Lines.Add('Windows Registry Entry Has Been Found In Your System');
          RegistryEntry.WriteString('', 'Delphi Application Wizard');
          RegistryEntry.OpenKey('Subnode 01\',true);
          RegistryEntry.WriteExpandString('', '%SystemRoot%\System32\Application Wizard 01.dll');
          RegistryEntry.WriteString('Subnode String 01', '00001');
          RegistryEntry.CloseKey();
          RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 02\',true);
          RegistryEntry.WriteExpandString('', '%SystemRoot%\System32\Application Wizard 02.dll');
          RegistryEntry.WriteString('Subnode String 02', '00002');
          RegistryEntry.CloseKey();
          RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 03\',true);
          RegistryEntry.WriteExpandString('', '%SystemRoot%\System32\Application Wizard 03.dll');
          RegistryEntry.WriteString('Subnode String 03', '00003');
          RegistryEntry.CloseKey();
          RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 04\',true);
          RegistryEntry.WriteExpandString('', '%SystemRoot%\System32\Application Wizard 04.dll');
          RegistryEntry.WriteString('Subnode String 04', '00004');
          RegistryEntry.CloseKey();
          RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 05\',true);
          RegistryEntry.WriteExpandString('', '%SystemRoot%\System32\Application Wizard 05.dll');
          RegistryEntry.WriteString('Subnode String 05', '00005');
          Memo01.Font.Color := 3992580;
          Memo01.Lines.Add('Windows Registry Entry Has Been Created Successfully')
        end
      else if RegistryEntry.OpenKey('CLSID\{00000000-0000-0000-0000-000000000001}\',false) then
        begin
          Memo01.Font.Color := 7864575;
          Memo01.Lines.Add('Windows Registry Entry Has Not Been Created Successfully')
        end
    end
  else
    begin
      if (RegistryEntry.KeyExists('CLSID\{00000000-0000-0000-0000-000000000001}\')) then
        begin
          Memo01.Font.Color := 7864575;
          Memo01.Lines.Add('Windows Registry Entry Has Been Found In Your System')
        end;
    end;
  RegistryEntry.CloseKey();
  RegistryEntry.Free;
end;

我的问题是：

尽管我正在尝试为%SystemRoot%\System32\Application Wizard 01.dll尚未%SystemRoot%\SysWow64\Application Wizard 01.dll写入的每个子节点编写默认字符串。如何避免这种情况？

我已经尝试过Rufo 爵士的解决方案。我尝试了以下代码：

const
  RegistryEntry = 'CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 01';
  RegistryEntryString = '%SystemRoot%\System32\Application Wizard 01.dll';

type
  TGetInfoFunc = function : WideString; stdcall;

function ExpandEnvironmentStringsStr( const AStr : string ) : string;
begin
  SetLength( Result, ExpandEnvironmentStrings( PChar( AStr ), nil, 0 ) );
  ExpandEnvironmentStrings( PChar( AStr ), PChar( Result ), Length( Result ) );
end;

function GetWinDir: string;
var
  WindowsDirectory: array[0..MAX_PATH] of Char;
begin
   GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
   SetLength(Result, StrLen(WindowsDirectory));
   Result := IncludeTrailingPathDelimiter(WindowsDirectory);
end;

function GetSysDir: string;
var
  SystemDirectory: array[0..MAX_PATH] of Char;
begin
  GetSystemDirectory(SystemDirectory, MAX_PATH - 1);
  SetLength(Result, StrLen(SystemDirectory));
  Result := IncludeTrailingPathDelimiter(SystemDirectory);
end;

function GetSysNativeDir: string;
var
  WindowsDirectory: array[0..MAX_PATH] of Char;
begin
   GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
   SetLength(Result, StrLen(WindowsDirectory));
   Result := IncludeTrailingPathDelimiter(WindowsDirectory)  + 'Sysnative\';
end;

procedure TMainForm.BitBtn01Click(Sender: TObject);
var
  LReg          :     TRegistry;
  LRegDataInfo  :     TRegDataInfo;
  LDllFileName  :     string;
  LLib          :     HMODULE;
  LFunc         :     TGetInfoFunc;
  LStr          :     string;
begin
  LReg := TRegistry.Create;
  try
    LReg.RootKey := HKEY_CLASSES_ROOT;

    if LReg.OpenKeyReadOnly( RegistryEntry )
    then
      if LReg.GetDataInfo( '', LRegDataInfo )
      then
        begin
          case LRegDataInfo.RegData of
            rdString :  //Just Read The Existing String
              LDllFileName := LReg.ReadString( '' );
            rdExpandString :  //String Needs To Be Expanded
              LDllFileName := ExpandEnvironmentStringsStr( LReg.ReadString( '' ) );
          end;
        end;

  finally
    LReg.Free;
  end;

  Label01.Caption := LDllFileName;  //Just For Information

  //No Information From Registry
  if LDllFileName = ''
  then
    raise Exception.Create( 'Not registered' );

  //Load The Library
  LLib := LoadLibrary( PChar( LDllFileName ) );
  if LLib <> 0
  then
    try
      @LFunc := GetProcAddress( LLib, 'GetInfo' );
      LStr   := LFunc;
    finally
      FreeLibrary( LLib );
    end
  else
    raise Exception.CreateFmt( 'Dll-File "%s" not found!', [LDllFileName] );

  //Show The Information
  ShowMessage( LStr );
end;

procedure TMainForm.BitBtn02Click(Sender: TObject);
var
  LReg : TRegistry;
begin
  LReg := TRegistry.Create;
  try
    LReg.RootKey := HKEY_CLASSES_ROOT;

    if LReg.OpenKey( RegistryEntry, True )
    then
      try

        //We Write As REG_EXPAND_SZ To Flag That This Contain Environment Variables That Has To Be Expanded

        LReg.WriteExpandString( '', RegistryEntryString );

      finally
        LReg.CloseKey;
      end
    else
      raise Exception.CreateFmt( 'Not allowed to create the registry key HKCR\%s', [RegistryEntryString] );
  finally
    LReg.Free;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Caption := Application.Title{$IFDEF WIN64} + ' Win64'{$ELSE} + ' Win32'{$ENDIF};
end;

但它不起作用。注册表项写在下面[HKEY_CLASSES_ROOT\Wow6432Node\CLSID\{00000000-0000-0000-0000-000000000001}\Subnode 01]虽然不是实际问题，但可以用 解决RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY，但实际问题是32Bit编译器版本是在64Bit环境下运行的，字符串写成%SystemRoot%\SysWow64\Application Wizard 01.dll而不是%SystemRoot%\System32\Application Wizard 01.dll.

64-Bit PE我认为，如果我只能在不允许的 Windows 64Bit 操作系统中运行，我的问题可以解决32Bit PE，尽管我的项目同时具有 32 位和 64 位平台。我不需要基于编译两个不同的 PETarget Platforms

%SystemRoot%\SysNative\Application Wizard 01.dll检测后我也试过了IsWow64Process Function。

我也尝试过BasePointer 的解决方案，它也不起作用。

初学者可以进行所有排列和组合，我已经尝试过，但我的问题仍然存在。

4

1 回答 1

1

假设您确实需要写入注册表的 32 位和 64 位视图，解决方案就像我在前面的问题中描述的那样。您需要从 32 位代码编写 32 位 DLL 的注册表项，并从 64 位代码编写 64 位 DLL 的注册表项。

您的问题都源于尝试从 32 位进程修改注册表的 64 位视图。注册表重定向器妨碍了您执行此操作。我在您的另一个问题中提供的信息足以表明您无法将所需的信息从 32 位进程写入 64 位视图。

于 2013-05-07T19:03:32.823 回答