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;