1

ユーザー アクションをシミュレートするために使用する TEmbeddedWB を備えた Delphi XE2 アプリケーションがあります。アプリケーションは URL に移動し、関連するフォーム フィールドにデータを入力して、データを送信します。問題は、<input type=file />アップロードされたファイルを受け入れるフィールドがあることです。

この問題について多くのことを読んだことで、プログラムでこれを行うセキュリティ上の問題があることを理解しましたが、ファイルをクリップボードから「ドラッグ」して所定の位置に「ドロップ」できるという提案をしている人も見つかりました。それ以来、関連ファイル (jpeg 画像) をクリップボード (CCR.Clipboard のおかげ) にロードして、EmbeddedWB にドロップすることに成功しました。ただし、ご存じのとおり、TWebBrowser に画像をドロップすると、表示されている画像が使用されます。

私の問題は、アクセスしている Web ページに、ドロップするファイルを受け入れる特定の DIV 要素があることです。その DIV の座標を IHTMLElement として正常に取得し、(視覚的な確認のために) マウス カーソルを所定の位置に移動しましたが、そこに画像をドロップすると、アップロードする代わりに表示用に開きます。まるで、ドロップ領域がドロップを検出せず、Web ブラウザーだけがドロップを検出するかのようです。

この問題に関するガイダンスは大歓迎です。以下は関連するコードです。

方法:

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

1 に答える 1

0

この問題に関する解決策にたどり着きました。クリップボードを使用する代わりに、Melander のドラッグ アンド ドロップ PIDLDemo に便乗しました。フォームに TListView コンポーネントを追加し、ファイルをシェルにドラッグ アンド ドロップできるようにすると、うまくいきます。Windows の MOUSE_EVENT を使用すると、(プログラムで) TListView からファイルをドラッグし、正しい場所の TEmbeddedWB にドロップできます。プレスト！ファイルが受け入れられ、Web サイトにアップロードされます。

呼び出しコードは次のようになります。

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;
于 2016-02-04T17:42:29.713 に答える