Delphi: имитация перетаскивания из буфера обмена в IHTMLElement EmbeddedWB

У меня есть приложение 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);

html delphi delphi-xe2 idispatch
person JorgeJ    schedule 20.01.2016    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Я пришел к решению этой проблемы. Вместо того, чтобы использовать буфер обмена, я воспользовался PIDLDemo Меландера с функцией перетаскивания. Добавление компонента TListView в форму и предоставление ему возможности перетаскивать файлы в оболочку делает свое дело. Используя 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;
person JorgeJ    schedule 04.02.2016