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

问题

I have a Delphi XE2 application with a TEmbeddedWB that I use to simulate user actions. The application navigates to a URL, populates the relevant form fields with data and submits the data. The problem is that there is an <input type=file /> field which accepts files that are uploaded.

Having done a lot of reading on the matter I understand there is a security issue doing this programmatically but also found someone making a suggestion that the files could be ‘dragged’ from the clipboard and ‘dropped’ in place. I have since been successful in loading the relevant files (jpeg images) into the clipboard (thanks to CCR.Clipboard) and drop them onto my EmbeddedWB. However, as you are most likely aware, dropping an image on a TWebBrowser resorts to the image being displayed.

My issue is that the web page I’m accessing has a specific DIV element that accepts files to be dropped. Although I have successfully obtained the coordinates of that DIV as an IHTMLElement and even moved the mouse cursor into position (for visual confirmation), dropping an image there still opens it for display instead of uploading it. It’s as though the drop area doesn’t detect the drop, only the web browser does.

Any guidance on this matter will be greatly appreciated. Following is the relevant code.

Methods:

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;

Calling Code:

    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);

回答1:

I have come to a solution regarding this problem. Rather than using the clipboard, I piggy-backed on Melander’s drag-and-drop PIDLDemo. Adding a TListView component to the form and giving it the ability to drag-and-drop files to the shell does the trick. Using Windows' MOUSE_EVENT I am able to (programmatically) drag the files from the TListView and drop them onto the TEmbeddedWB at the correct location. Presto! The files are accepted and uploaded to the website.

The calling code now looks as follows:

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;

来源：https://stackoverflow.com/questions/34905373/delphi-simulating-a-drag-and-drop-from-the-clipboard-to-embeddedwb-s-ihtmleleme