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

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

Я пришел к решению по этой проблеме. Вместо того, чтобы использовать буфер обмена, я по-прежнему поддерживал перетаскивание PANDLDemo от Melander. Добавление компонента TListView в форму и предоставление ему возможности перетаскивания файлов в оболочку делает трюк. Используя Windows MOUSE_EVENT, я могу (программно) перетащить файлы из TListView и поместить их на TEmbeddedWB в нужном месте. Presto! Файлы принимаются и загружаются на веб-сайт.

Вызывающий код теперь выглядит следующим образом:

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;