Question

我们开始使用Thinfinity UI在浏览器中虚拟化我们的应用程序。虚拟化时，我们的应用程序的主窗口最大化到浏览器画布的边界。这意味着，实际上，我们的桌面缩小到浏览器画布的大小。这也意味着当弹出菜单等控件定位时，它们通常会超出浏览器画布的范围。

如果我们可以将对Vcl.Forms.TScreen.WorkAreaRect的调用结果设置为浏览器画布的边界，我相信我们可以克服这个问题。这可能吗？

Answer 1

基于@GadDLord中的How to change the implementation (detour) of an externally declared function，您可以挂钩在TScreen.GetWorkAreaRect中使用的SystemParametersInfoW。我复制了他的部分代码以防止死链接。

type
  //strctures to hold the address and instructions to patch
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;

var
 DataCompareBackup: TXRedirCode; //Store the original address of the function to patch

//get the address of a procedure or method of a function
function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

//patch the original function or procedure
procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: {$IFDEF VER230}NativeUInt{$ELSE}DWORD{$ENDIF};
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  //store the address of the original procedure to patch
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    //replace the target procedure address  with the new one.
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;
//restore the original address of the hooked function or procedure
procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: {$IFDEF VER230}NativeUInt{$ELSE}Cardinal{$ENDIF};
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;


function MySystemParametersInfo(uiAction, uiParam: UINT;
  pvParam: Pointer; fWinIni: UINT): BOOL; stdcall;
begin
  Result := SystemParametersInfoA(uiAction, uiParam,pvParam,fWinIni);
  if uiAction=SPI_GETWORKAREA then
      begin
        // Fake just for demo
        TRect(pvParam^).Right := 1234;
      end
end;


procedure TForm3.Button1Click(Sender: TObject);
begin
    Caption := IntToStr(Screen.WorkAreaRect.Right)
end;

initialization
 HookProc( @SystemParametersInfoW, @MySystemParametersInfo, DatacompareBackup);
finalization
 UnHookProc( @SystemParametersInfoW, DatacompareBackup);

是否可以更改Vcl.Forms.TScreen.WorkAreaRect返回的值？

1 个答案: