2016-01-20 90 views
0

我有一個Delphi XE2應用程序,帶有一個TEmbeddedWB,用於模擬用戶操作。應用程序導航到一個URL,用數據填充相關的表單域並提交數據。問題是有一個<input type=file />字段接受上載的文件。Delphi:模擬從剪貼板拖放到EmbeddedWB的IHTMLElement

在完成了大量關於此事的閱讀之後,我明白有一個安全問題以編程的方式執行此操作,但也發現有人提出了一個建議,即可以將文件從剪貼板'拖動'到'放下'位置。我已經成功地將相關文件(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); 

回答

0

我來關於此問題的解決方案。我沒有使用剪貼板,而是使用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;