将 SafeArray 从 Delphi 传递到 ms-uiautomation 库

Question

关于previous question，我现在有一个部分工作的实现，它封装了 TStringGrid，并允许自动化访问它。

Sort of anyway.

我需要实现 ISelectionProvider 的 GetSelection 方法，但即使我认为我已经创建了一个 pSafeArray，当我使用 ms-uiautomation 获取结果数组时，它也有 0 个条目。下面的代码肯定会被调用，因为我可以在方法中设置一个断点并停止它。

我尝试了几种创建和填充数组的方法，这是我最新的（基于different question on StackOverflow..

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  obj : TAutomationStringGridItem;
  outBuffer : PSafeArray;
  offset : integer;
begin
  obj := TAutomationStringGridItem.create(self);
  obj.Row := self.row;
  obj.Column := self.Col;
  obj.Value := self.Cells[self.Col, self.Row];

  offset := 0;
  outBuffer := SafeArrayCreateVector(VT_VARIANT, 0, 1);
  SafeArrayPutElement(outBuffer, offset, obj);
  pRetVal := outBuffer;
  result := S_OK;
end;

对我做错了什么有什么想法吗？

更新：

澄清一下，被调用的自动化代码如下..

  var
    collection : IUIAutomationElementArray;
  ...
  // Assume that we have a valid pattern
  FSelectionPattern.GetCurrentSelection(collection);
  collection.Get_Length(length);

Get_Length 返回的值为 0。

Answer 1

您的GetSelection() 实现预计将返回SAFEARRAY 的IRawElementProviderSimple 接口指针。但是，您正在创建 SAFEARRAY 的 VARIANT 元素，然后使用 TAutomationStringGridItem 对象指针填充元素。 SafeArrayPutElement() 要求您向其传递与数组类型匹配的值（在您的代码中，该值将是指向 VARIANT 的指针，然后将复制其值）。因此，在为客户端应用程序初始化 IUIAutomationElementArray 时，UIAutomation 将无法使用格式错误的数组是有道理的。

尝试类似的方法：

type
  TAutomationStringGridItem = class(TInterfacedObject, IRawElementProviderSimple, IValueProvider, ...)
    ...
  public
    constructor Create(AGrid: TAutomationStringGrid; ARow, ACol: Integer; const AValue: string);
    ...
  end;

constructor TAutomationStringGridItem.Create(AGrid: TAutomationStringGrid; ARow, ACol: Integer; const AValue: string);
begin
  ...
  Self.Row := ARow;
  Self.Column := ACol;
  Self.Value := AValue;
  ...
end;

function TAutomationStringGrid.get_CanSelectMultiple(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.get_IsSelectionRequired(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  intf: IRawElementProviderSimple;
  unk: IUnknown;
  outBuffer : PSafeArray;
  offset, iRow, iCol : integer;
begin
  // get the current selected cell, if any...
  iRow := Self.Row;
  iCol := Self.Col;

  // is a cell selected?
  if (iRow > -1) and (iCol > -1) then
  begin
    // yes...
    intf := TAutomationStringGridItem.Create(Self, iRow, iCol, Self.Cells[iCol, iRow]);
    outBuffer := SafeArrayCreateVector(VT_UNKNOWN, 0, 1);
  end else
  begin
    // no ...

    // you would have to check if UIA allows you to return a nil
    // array, possibly with S_FALSE instead of S_OK, so as to
    // avoid having to allocate memory for an empty array...
    {
    // pRetVal is already nil because of 'out'...
    Result := S_FALSE; // or S_OK if S_FALSE is not allowed...
    Exit;
    }

    outBuffer := SafeArrayCreateVector(VT_UNKNOWN, 0, 0);
  end;

  if outBuffer = nil then
  begin
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  if intf <> nil then
  begin
    offset := 0;
    unk := intf as IUnknown;
    Result := SafeArrayPutElement(outBuffer, offset, unk);
    if Result <> S_OK then
    begin
      SafeArrayDestroy(outBuffer);
      Exit;
    end;
  end;

  pRetVal := outBuffer;
end;

话虽如此，TStringGrid 支持多选，GetSelection() 的输出预计会返回所有选定项的数组。因此，更准确的实现看起来更像这样：

function TAutomationStringGrid.get_CanSelectMultiple(out pRetVal: BOOL): HResult;
begin
  pRetVal := goRangeSelect in Self.Options;
  Result := S_OK;
end;

function TAutomationStringGrid.get_IsSelectionRequired(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  intfs: array of IRawElementProviderSimple;
  unk: IUnknown;
  outBuffer : PSafeArray;
  offset, iRow, iCol: Integer;
  R: TGridRect;
begin
  // get the current range of selected cells, if any...
  R := Self.Selection; 

  // are any cells selected?
  if (R.Left > -1) and (R.Right > -1) and (R.Top > -1) and (R.Bottom > -1) then
  begin
    // yes...
    SetLength(intfs, ((R.Right-R.Left)+1)*((R.Bottom-R.Top)+1));
    offset := Low(intfs);
    for iRow := R.Top to R.Bottom do
    begin
      for iCol := R.Left to R.Right do
      begin
        intfs[offset] := TAutomationStringGridItem.Create(Self, iRow, iCol, Self.Cells[iCol, iRow]);
        Inc(offset);
      end;
    end;
  end;

  // you would have to check if UIA allows you to return a nil
  // array, possibly with S_FALSE instead of S_OK, so as to
  // avoid having to allocate memory for an empty array...
  {
  if Length(intfs) = 0 then
  begin
    // pRetVal is already nil because of 'out'...
    Result := S_FALSE; // or S_OK if S_FALSE is not allowed...
    Exit;
  end;
  }

  outBuffer := SafeArrayCreateVector(VT_UNKNOWN, Low(intfs), Length(intfs));
  if outBuffer = nil then
  begin
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  for offset := Low(intfs) to High(intfs) do
  begin
    unk := intfs[offset] as IUnknown;
    Result := SafeArrayPutElement(outBuffer, offset, unk);
    if Result <> S_OK then
    begin
      SafeArrayDestroy(outBuffer);
      Exit;
    end;
  end;

  pRetVal := outBuffer;
  Result := S_OK;
end;

Answer 2

我已经解决了访问冲突，因为我不能在评论中发布代码，所以我会发布一个答案。唯一真正的区别是我将 IUnknown 转换为指向 IUnknown 的指针，因为这解决了我看到的访问冲突。

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  intf : TAutomationStringGridItem;
  outBuffer : PSafeArray;
  offset : integer;
  unk : IUnknown;
  iRow, iCol : integer;
  Bounds : array [0..0] of TSafeArrayBound;

begin
  pRetVal := nil;
  result := S_FALSE;

  iRow := Self.Row;
  iCol := Self.Col;

  // is a cell selected?
  if (iRow > -1) and (iCol > -1) then
  begin
    intf := TAutomationStringGridItem.create(self, iCol, iRow,  self.Cells[self.Col, self.Row]);

    bounds[0].lLbound := 0;
    bounds[0].cElements := 1;
    outBuffer := SafeArrayCreate(VT_UNKNOWN, 1, @Bounds);

    if intf <> nil then
    begin
      offset := 0;
      unk := intf as IUnknown;
      Result := SafeArrayPutElement(&outBuffer, offset, Pointer(unk)^);
      if Result <> S_OK then
      begin
        SafeArrayDestroy(outBuffer);
        pRetVal := nil;
        result := E_OUTOFMEMORY;
      end
      else
      begin
        pRetVal := outBuffer;
        result := S_OK;
      end;
    end;
  end
  else
  begin
    pRetVal := nil;
    result := S_FALSE;
  end;
end;

更新：我已将代码 sn-p 编辑为与下面的 Remy 的 cmets 内联。