Delphi: 模拟从剪贴板拖放到 EmbeddedWB 的 IHTMLElement

Question

我有一个 Delphi XE2 应用程序，其中包含用于模拟用户操作的 TEmbeddedWB。应用程序导航到 URL，用数据填充相关的表单字段并提交数据。问题是有一个 <input type=file /> 字段接受上传的文件。

在阅读了大量有关此事的资料后，我了解到以编程方式执行此操作存在安全问题，但也发现有人建议可以将文件从剪贴板“拖”到适当的位置。我已经成功地将相关文件（jpeg 图像）加载到剪贴板（感谢 CCR.Clipboard）并将它们放到我的 EmbeddedWB 上。但是，您很可能知道，将图像拖放到 TWebBrowser 上会使用正在显示的图像。

我的问题是我正在访问的网页有一个特定的 DIV 元素可以接受要删除的文件。虽然我已经成功地获得了 DIV 作为 IHTMLElement 的坐标，甚至将鼠标光标移动到适当的位置（用于视觉确认），但将图像放在那里仍然会打开它进行显示而不是上传它。好像拖放区域没有检测到拖放，只有网络浏览器可以。

如有任何关于此事的指导，我们将不胜感激。以下是相关代码。

方法：

type
  TElementsArray = array of IHTMLElement;
...
    function TSiteRobot.FindElementByTagAttributeValue(const Document: IHTMLDocument2; TagName, Attribute, AttributeValue: String; out Info: String): IHTMLElement;
    var i:            integer;
        HTMLElem:     IHTMLElement;
        ElementCount: integer;
        OleElem:      OleVariant;
        ElementsArray:  TElementsArray;
    begin
      Result := nil; //initialise
      ElementsArray := GetElementsByTagName(Document, TagName);
      if Length(ElementsArray) = 0 then
      begin
        Info := 'No elements with "'+TagName+'" tag found.';
        Exit
      end;
      Info := 'No element found for tag "'+TagName+'" and attribute "'+Attribute+'" with Value "'+AttributeValue+'"';
      for i := Low(ElementsArray) to High(ElementsArray) do
      begin
        HTMLElem := ElementsArray[i];
        try
          OleElem := HTMLElem.getAttribute(Attribute,0);
          if (not varIsClear(OleElem)) and (OleElem <> null) then
          begin
            if (String(OleElem) = AttributeValue) then
            begin
              if HTMLElem <> nil then Result := HTMLElem;
              Break;
            end;
          end;
        except raise; end;
      end;
    end;

    function TSiteRobot.GetElementScreenPos(WebBrowser: TEmbeddedWB; HTMLElement: IHTMLElement): TPoint;
    var WinRect:        TRect;
        elTop, elLeft:  integer;
        HTMLElem2:      IHTMLElement2;
    begin
      HTMLElement.scrollIntoView(True);
      Application.ProcessMessages; //let the coordinates get updated since the page moved
      GetWindowRect(WebBrowser.Handle, WinRect);
      HTMLElem2 := (HTMLElement as IHTMLElement2);
      elLeft  := HTMLElem2.getBoundingClientRect.left + WinRect.Left;
      elTop   := HTMLElem2.getBoundingClientRect.top + WinRect.Top;
      Result  := Point(elLeft, elTop);
    end;

    procedure TfrmMain.DropFilesAtPoint(Area: TPoint; Wnd: HWND);
    var DropTarget:     IDropTarget;
        DataObj:        IDataObject;
        DropFiles:      PDropFiles;
        StgMed:         TSTGMEDIUM;
        FormatEtc:      TFORMATETC;
        EnumFormatEtc:  IEnumFORMATETC;
        dwEffect:       integer;
    begin
      DropTarget := IDropTarget(GetProp(Wnd, 'OleDropTargetInterface'));
      OleGetClipboard(dataObj);
      DataObj.EnumFormatEtc(DATADIR_GET, EnumFormatEtc);
      while (EnumFormatEtc.Next(1, FormatEtc,  nil) <> S_FALSE) do
      begin
        if (FormatEtc.cfFormat = CF_HDROP) and (DataObj.QueryGetData(FormatEtc) = S_OK) then
        begin
          DataObj.GetData(FormatEtc, StgMed);
          DropFiles := GlobalLock(StgMed.hGlobal);
          dwEffect := DROPEFFECT_COPY;
          DropTarget.Drop(DataObj, Integer(DropFiles), Area, dwEffect); // This is where the image opens in the web browser
          GlobalFree(StgMed.hGlobal);
          ReleaseStgMedium(StgMed);
        end;
      end; //while
      DataObj._Release;
    end;

调用代码：

    var  HTMLElem: IHTMLElement;
         dndArea:  TPoint;
    …
    HTMLElem := SiteRobot.FindElementByTagAttributeValue(Document, 'SPAN', 'id', 'dndArea', Info);
    dndArea := SiteRobot.GetElementScreenPos(WebBrowser, HTMLElem);
    dndArea.X := dndArea.X+24; //go ‘deeper’ into the drop area
    dndArea.Y := dndArea.Y+24;
    SetCursorPos(dndArea.X, dndArea.Y); //cursor moves onto the correct spot in the website every time
    (HTMLElem as IHTMLElement2).focus;
    DropFilesAtPoint(dndArea, webBrowser.Handle);

Answer 1

我已经找到了解决这个问题的方法。我没有使用剪贴板，而是借助了 Melander 的拖放式 PIDLDemo。将 TListView 组件添加到表单并赋予其将文件拖放到 shell 的能力就可以了。使用 Windows' MOUSE_EVENT 我能够（以编程方式）将文件从 TListView 拖放到正确位置的 TEmbeddedWB 上。急！文件被接受并上传到网站。

现在的调用代码如下所示：

function TfrmMain.GetMickey(val: TPoint): TPoint;
begin
  {
    http://delphi.xcjc.net/viewthread.php?tid=43193
    Mouse Coordinates given are in "Mickeys", where their are 65535 "Mickeys"
    to a screen's width.
  }
  Result.X := Round(val.X * (65535 / Screen.Width));
  Result.Y := Round(val.Y * (65535 / Screen.Height));
end;

procedure TfrmMain.DropFilesAtPoint(const Area: TPoint; Wnd: HWND);
var Rect:               TRect;
    DropPoint,
    ListViewPoint,
    ListViewItemPoint:  TPoint;
begin
  GetWindowRect(ListView1.Handle, Rect);
  ListViewItemPoint := ListView1.Items.Item[0].GetPosition;
  ListViewPoint := Point(Rect.Left + ListViewItemPoint.X+10, 
                         Rect.Top + ListViewItemPoint.Y+10);
  ListView1.SelectAll; //ensures all files are dragged together

  SetCursorPos(ListViewPoint.X, ListViewPoint.Y);
  ListViewPoint := GetMickey(ListViewPoint);
  MOUSE_EVENT(MOUSEEVENTF_LEFTDOWN, 
              ListViewPoint.X, ListViewPoint.Y, 0, 0); //left mouse button down
  Sleep(500);

  DropPoint := ClientToScreen(Area);
  DropPoint := GetMickey(DropPoint);
  MOUSE_EVENT(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or 
              MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 
              DropPoint.X, DropPoint.Y, 0, 0); //move and drop
  Application.ProcessMessages;
end;

Delphi: 模拟从剪贴板拖放到 EmbeddedWB 的 IHTMLElement

Delphi: Simulating a drag and drop from the clipboard to EmbeddedWB’s IHTMLElement

html

delphi

idispatch

delphi-xe2