Weird behavior during copy/move to Explorer window

[umbra]

1. Start TC with normal window (not maximized)
2. Select any big file (so the next step takes long enough)
3. Drag it out of TC and drop it on any Explorer window, for example Desktop, to start a copy/move operation

During this operation, TC's window does not respond and mouse has a wrong icon when you hover over the window. But the most interesting thing is, that all single-click mouse actions on the TC's window are queued and executed after the running operation ends. For example you can resize the window and then click on a button bar and all of that executes just after the copy/move operation ends.

Tested with TC 8.01 (both x32 and x64) on Windows 8 (both x32 and x64)

[ghisler(Author)]

Sorry, drag&drop is currently done in the foreground thread. It would be too complex to move this all to a background thread.

[umbra]

That's a pity. Is there a way to ignore such mouse actions at least? Currently the Windows copy dialog behaves like a modal window, since TC's window underneath it doesn't respond. So the user expects that clicking on TC' window won't have any effect - except it has. He can accidentally select some file and/or execute a button bar action.

[ghisler(Author)]

Unfortunately Windows seems to send clicks to hanging programs as soon as they react again - there doesn't seem to be a way to detect this.

[MarcinW]

There is a way to ignore accumulated input messages, when application starts responding again. After finishing drag&drop operation, input messages can be removed using PeekMessage function with PM_REMOVE parameter - call the following piece of code to remove buffered input events (see comments below):

Code: Select all

procedure FlushInputMessages;
var
  TempMsg : TMsg;
  CloseGestureInfoHandle : function(hGestureInfo : THandle) : LongBool; stdcall;
  CloseTouchInputHandle : function(hTouchInput : THandle) : LongBool; stdcall;
begin
  while PeekMessage(TempMsg,0,$A0{WM_NCMOUSEMOVE},$A9{WM_NCMBUTTONDBLCLK},PM_REMOVE) do;
  while PeekMessage(TempMsg,0,$AB{WM_NCXBUTTONDOWN},$AD{WM_NCXBUTTONDBLCLK},PM_REMOVE) do;
  while PeekMessage(TempMsg,0,$200{WM_MOUSEFIRST},$20E{WM_MOUSELAST},PM_REMOVE) do;
  while PeekMessage(TempMsg,0,$100{WM_KEYFIRST},$109{WM_KEYLAST},PM_REMOVE) do;
  while PeekMessage(TempMsg,0,$FF{WM_INPUT},$FF{WM_INPUT},PM_REMOVE) do;
  while PeekMessage(TempMsg,0,WM_HOTKEY,WM_HOTKEY,PM_REMOVE) do;

  CloseGestureInfoHandle:=GetProcAddress(GetModuleHandle(user32),'CloseGestureInfoHandle');
  if Assigned(CloseGestureInfoHandle) then
  while PeekMessage(TempMsg,0,$119{WM_GESTURE},$119{WM_GESTURE},PM_REMOVE) do
  if not CloseGestureInfoHandle(TempMsg.lParam) then
    DefWindowProc(TempMsg.hwnd,TempMsg.message,TempMsg.wParam,TempMsg.lParam);

  CloseTouchInputHandle:=GetProcAddress(GetModuleHandle(user32),'CloseTouchInputHandle');
  if Assigned(CloseTouchInputHandle) then
  while PeekMessage(TempMsg,0,$240{WM_TOUCH},$240{WM_TOUCH},PM_REMOVE) do
  if not CloseTouchInputHandle(TempMsg.lParam) then
    DefWindowProc(TempMsg.hwnd,TempMsg.message,TempMsg.wParam,TempMsg.lParam);
end;

Note 1: I haven't used Delphi constants like WM_MOUSELAST, because they are outdated now. I used definitions from the latest WinUser.h (from Visual studio 2012).

Note 2: I haven't tested removing of WM_GESTURE and WM_TOUCH thoroughly. Others are fully tested.

Note 3: There are also pointer input messages, and some of them should also be removed. However, not removing them is not a problem, if application hasn't registered itself for receiving pointer messages. Here is a full list of pointer messages:

Note 4: Please note that first 6 "while" loops are empty loops - there is a ";" after each "do". Each loop works until it removes from the message queue all messages belonging to the range.

Code: Select all

#define WM_POINTERDEVICECHANGE          0x0238
#define WM_POINTERDEVICEINRANGE         0x0239
#define WM_POINTERDEVICEOUTOFRANGE      0x023A

#define WM_NCPOINTERUPDATE              0x0241
#define WM_NCPOINTERDOWN                0x0242
#define WM_NCPOINTERUP                  0x0243

#define WM_POINTERUPDATE                0x0245
#define WM_POINTERDOWN                  0x0246
#define WM_POINTERUP                    0x0247

#define WM_POINTERENTER                 0x0249
#define WM_POINTERLEAVE                 0x024A
#define WM_POINTERACTIVATE              0x024B
#define WM_POINTERCAPTURECHANGED        0x024C
#define WM_TOUCHHITTESTING              0x024D
#define WM_POINTERWHEEL                 0x024E
#define WM_POINTERHWHEEL                0x024F

Regards

[MarcinW]

I created a piece of code that may help. It allows using drag&drop from our application to Explorer asynchronously. It requires creating a data object, which implements interfaces IDataObject and also IAsyncOperation. Below there is an example for Delphi 5 and up. Delphi 2 doesn't support interfaces, but I suppose there is an easy way of porting this code to Delphi 2, because Total Commander uses interfaces in many places.

Some documentation:
Shell Clipboard Formats: CF_HDROP
Handling Shell Data Transfer Scenarios: Dragging and Dropping Shell Objects Asynchronously

Notes for file 1 of 2 (Unit1.pas):
- remember to assign FormMouseMove to OnMouseMove event of the form,
- note that TForm1 implements IDropSource interface, so it can be passed as the second parameter of DoDragDrop API call; you may also create IDropSource interface separately from TForm1 and pass it to DoDragDrop.

Notes for file 2 of 2 (DragDropFiles.pas):
- note the usage of VARIANT_TRUE, which must be equal to 1 (not -1 as True of type BOOL is).

Regards


Unit1.pas:

Code: Select all

unit Unit1;

interface

uses
  Windows, Classes, ActiveX, Forms, Controls, StdCtrls;

type
  TForm1 = class(TForm, IDropSource)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  protected
    function QueryContinueDrag(fEscapePressed : BOOL; grfKeyState : LongInt) : HRESULT; stdcall;
    function GiveFeedback(dwEffect : LongInt) : HRESULT; stdcall;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  DragDropFiles;

function TForm1.QueryContinueDrag(fEscapePressed : BOOL; grfKeyState : LongInt) : HRESULT; stdcall;
begin
  if fEscapePressed or (grfKeyState and MK_RBUTTON <> 0) then
    Result:=DRAGDROP_S_CANCEL
  else
  if grfKeyState and MK_LBUTTON = 0 then
    Result:=DRAGDROP_S_DROP
  else
    Result:=S_OK;
end;

function TForm1.GiveFeedback(dwEffect : LongInt) : HRESULT; stdcall;
begin
  Result:=DRAGDROP_S_USEDEFAULTCURSORS;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  Effect : LongInt;
  DataObject : IDataObject;
begin
  if ssLeft in Shift then {Important! Without this:
    - you can't activate application by clicking its window,
    - you can't close application by pressing Alt+F4 when mouse pointer is over
      the window,
    - painting of the window contents fails when you switch to the application
      by pressing Alt+Tab when mouse pointer is over the window}
  begin
    Effect:=DROPEFFECT_NONE;
    DataObject:=GetDataObjectA('c:\autoexec.bat;c:\io.sys;c:\boot.ini');
//  DataObject:=GetDataObjectW('c:\autoexec.bat;c:\io.sys;c:\boot.ini');
    DoDragDrop(DataObject,Self,DROPEFFECT_COPY,Effect);
    {We shouldn't call DataObject._Release, Delphi will release the object
     automatically at the end of this procedure. Calling DataObject._Release
     manually would lead to releasing DataObject twice in this procedure}
  end;
end;

end.

DragDropFiles.pas

Code: Select all

unit DragDropFiles;

interface

uses
  ActiveX;

function GetDataObjectA(Files : PAnsiChar) : IDataObject;
function GetDataObjectW(Files : PWideChar) : IDataObject;

implementation

uses
  Windows, ShlObj;

type
  IAsyncOperation = interface(IUnknown)
    ['{3D8B0590-F691-11D2-8EA9-006097DF5BD4}']
    function SetAsyncMode(fDoOpAsync : BOOL) : HRESULT; stdcall;
    function GetAsyncMode(var pfIsOpAsync : BOOL) : HRESULT; stdcall;
    function StartOperation(pbcReserved : IBindCtx) : HRESULT; stdcall;
    function InOperation(var pfInAsyncOp : BOOL) : HRESULT; stdcall;
    function EndOperation(HRESULT : HRESULT; pbcReserved : IBindCtx; dwEffects : DWORD) : HRESULT; stdcall;
  end;

type
  TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
  protected
    Formats : array[0..0] of TFormatEtc;
    FormatsCurrentIndex : LongInt;
  public
    constructor Create;
    {IEnumFormatEtc}
    function Next(Celt : LongInt; out Elt; pCeltFetched : PLongInt) : HRESULT; stdcall;
    function Skip(Celt : LongInt) : HRESULT; stdcall;
    function Reset : HRESULT; stdcall;
    function Clone(out Enum : IEnumFormatEtc) : HRESULT; stdcall;
  end;

type
  TDragDropDataObject = class(TInterfacedObject, IDataObject, IAsyncOperation)
  protected
    FilesBuffer : AnsiString; {Common buffer for ANSI and Unicode file names}
    FilesBufferIsWide : Boolean;
    AsyncMode : Boolean;
    Transferring : Boolean;
    {IDataObject}
    function GetData(const formatetcIn : TFormatEtc; out medium : TStgMedium) : HRESULT; stdcall;
    function GetDataHere(const formatetc : TFormatEtc; out medium : TStgMedium) : HRESULT; stdcall;
    function QueryGetData(const formatetc : TFormatEtc) : HRESULT; stdcall;
    function GetCanonicalFormatEtc(const formatetc : TFormatEtc; out formatetcOut : TFormatEtc) : HRESULT; stdcall;
    function SetData(const formatetc : TFormatEtc; var medium : TStgMedium; fRelease : BOOL) : HRESULT; stdcall;
    function EnumFormatEtc(dwDirection : LongInt; out enumFormatEtc : IEnumFormatEtc) : HRESULT; stdcall;
    function DAdvise(const formatetc : TFormatEtc; advf : LongInt; const advSink : IAdviseSink; out dwConnection : LongInt) : HRESULT; stdcall;
    function DUnadvise(dwConnection : LongInt) : HRESULT; stdcall;
    function EnumDAdvise(out enumAdvise : IEnumStatData) : HRESULT; stdcall;
    {IAsyncOperation}
    function SetAsyncMode(fDoOpAsync : BOOL) : HRESULT; stdcall;
    function GetAsyncMode(var pfIsOpAsync : BOOL) : HRESULT; stdcall;
    function StartOperation(pbcReserved : IBindCtx) : HRESULT; stdcall;
    function InOperation(var pfInAsyncOp : BOOL) : HRESULT; stdcall;
    function EndOperation(HRESULT : HRESULT; pbcReserved : IBindCtx; dwEffects : DWORD) : HRESULT; stdcall;
  public
    constructor CreateA(Files : PAnsiChar); overload;
    constructor CreateW(Files : PWideChar); overload;
  end;

const
  CAST : Cardinal = 1;
var
  VARIANT_TRUE : BOOL absolute CAST;

{TEnumFormatEtc}

constructor TEnumFormatEtc.Create;
begin
  Formats[0].cfFormat:=CF_HDROP;
  Formats[0].ptd:=nil;
  Formats[0].dwAspect:=DVASPECT_CONTENT;
  Formats[0].lindex:=-1;
  Formats[0].tymed:=TYMED_HGLOBAL;
end;

function TEnumFormatEtc.Next(Celt : LongInt; out Elt; pCeltFetched : PLongInt) : HRESULT; stdcall;
var
  SaveCelt : LongInt;
  FormatEtc : PFormatEtc;
begin
  SaveCelt:=Celt;
  FormatEtc:=@Elt;
  while (Celt > 0) and (FormatsCurrentIndex <= High(Formats)) do
  begin
    FormatEtc^:=Formats[FormatsCurrentIndex];
    Inc(FormatsCurrentIndex);
    Inc(FormatEtc);
    Dec(Celt);
  end;
  if pCeltFetched <> nil then
    pCeltFetched^:=SaveCelt-Celt;
  if Celt = 0 then
    Result:=S_OK
  else
    Result:=S_FALSE;
end;

function TEnumFormatEtc.Skip(Celt : LongInt) : HRESULT; stdcall;
begin
  if (FormatsCurrentIndex+Celt <= High(Formats)) then
  begin
    Inc(FormatsCurrentIndex,Celt);
    Result:=S_OK;
  end else
  begin
    FormatsCurrentIndex:=Length(Formats);
    Result:=S_FALSE;
  end;
end;

function TEnumFormatEtc.Reset : HRESULT; stdcall;
begin
  FormatsCurrentIndex:=0;
  Result:=S_OK;
end;

function TEnumFormatEtc.Clone(out Enum : IEnumFormatEtc) : HRESULT; stdcall;
begin
  Result:=E_NOTIMPL;
end;

{TDragDropDataObject}

constructor TDragDropDataObject.CreateA(Files : PAnsiChar);
var
  Len : Integer;
  PDest : PAnsiChar;
  I : Integer;
begin
  inherited Create;
  Len:=lstrlenA(Files);
  FilesBufferIsWide:=SizeOf(Files^) = SizeOf(WideChar);
  SetLength(FilesBuffer,(Len+2)*SizeOf(Files^));
  PDest:=@FilesBuffer[1];
  for I:=Len-1 downto 0 do
  begin
    if Files^ <> ';' then
      PDest^:=Files^
    else
      PDest^:=#0;
    Inc(Files);
    Inc(PDest);
  end;
  PDest^:=#0;
  Inc(PDest);
  PDest^:=#0;
end;

constructor TDragDropDataObject.CreateW(Files : PWideChar);
var
  Len : Integer;
  PDest : PWideChar;
  I : Integer;
begin
  inherited Create;
  Len:=lstrlenW(Files);
  FilesBufferIsWide:=SizeOf(Files^) = SizeOf(WideChar);
  SetLength(FilesBuffer,(Len+2)*SizeOf(Files^));
  PDest:=@FilesBuffer[1];
  for I:=Len-1 downto 0 do
  begin
    if Files^ <> ';' then
      PDest^:=Files^
    else
      PDest^:=#0;
    Inc(Files);
    Inc(PDest);
  end;
  PDest^:=#0;
  Inc(PDest);
  PDest^:=#0;
end;

function TDragDropDataObject.GetData(const formatetcIn : TFormatEtc; out medium : TStgMedium) : HRESULT; stdcall;
var
  Global : PDropFiles;
begin
  Result:=DV_E_FORMATETC;
  if formatetcIn.cfFormat <> CF_HDROP then
    Exit;

  Medium.tymed:=TYMED_HGLOBAL;
  Medium.unkForRelease:=nil;
  Medium.hGlobal:=GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE,SizeOf(Global^)+Length(FilesBuffer));
  Global:=GlobalLock(Medium.hGlobal);
  Global^.pFiles:=SizeOf(Global^);
  Global^.pt.x:=0;
  Global^.pt.y:=0;
  Global^.fNC:=False;
  Global^.fWide:=FilesBufferIsWide;
  Move(FilesBuffer[1],Pointer(HINST(Global)+SizeOf(Global^))^,Length(FilesBuffer));
  GlobalUnlock(Medium.hGlobal);
  Result:=S_OK;
end;

function TDragDropDataObject.GetDataHere(const formatetc : TFormatEtc; out medium : TStgMedium) : HRESULT; stdcall;
begin
  Result:=E_NOTIMPL;
end;

function TDragDropDataObject.QueryGetData(const formatetc : TFormatEtc) : HRESULT; stdcall;
begin
  Result:=DV_E_FORMATETC;
  if (formatetc.cfFormat = CF_HDROP) and
     (formatetc.tymed = TYMED_HGLOBAL) and
     (formatetc.dwAspect = DVASPECT_CONTENT) then
    Result:=S_OK;
end;

function TDragDropDataObject.GetCanonicalFormatEtc(const formatetc : TFormatEtc; out formatetcOut : TFormatEtc) : HRESULT; stdcall;
begin
  formatetcOut:=formatetc;
  if formatetcOut.ptd <> nil then
  begin
    formatetcOut.ptd:=nil;
    Result:=S_OK;
  end else
    Result:=DATA_S_SAMEFORMATETC;
end;

function TDragDropDataObject.SetData(const formatetc : TFormatEtc; var medium : TStgMedium; fRelease : BOOL) : HRESULT; stdcall;
begin
  Result:=S_OK;
  if fRelease then
    ReleaseStgMedium(Medium);
end;

function TDragDropDataObject.EnumFormatEtc(dwDirection : LongInt; out enumFormatEtc : IEnumFormatEtc) : HRESULT; stdcall;
begin
  if dwDirection = DATADIR_GET then
  begin
    enumFormatEtc:=TEnumFormatEtc.Create;
    Result:=S_OK;
  end else
  begin
    enumFormatEtc:=nil;
    Result:=E_NOTIMPL;
  end;
end;

function TDragDropDataObject.DAdvise(const formatetc : TFormatEtc; advf : LongInt; const advSink : IAdviseSink; out dwConnection : LongInt) : HRESULT; stdcall;
begin
  Result:=OLE_E_ADVISENOTSUPPORTED;
end;

function TDragDropDataObject.DUnadvise(dwConnection : LongInt) : HRESULT; stdcall;
begin
  Result:=OLE_E_ADVISENOTSUPPORTED;
end;

function TDragDropDataObject.EnumDAdvise(out enumAdvise : IEnumStatData) : HRESULT; stdcall;
begin
  Result:=OLE_E_ADVISENOTSUPPORTED;
end;

function TDragDropDataObject.SetAsyncMode(fDoOpAsync : BOOL) : HRESULT; stdcall;
begin
  AsyncMode:=fDoOpAsync;
  Result:=S_OK;
end;

function TDragDropDataObject.GetAsyncMode(var pfIsOpAsync : BOOL) : HRESULT; stdcall;
begin
  if not AsyncMode then
    pfIsOpAsync:=False
  else
    pfIsOpAsync:=VARIANT_TRUE;
  Result:=S_OK;
end;

function TDragDropDataObject.StartOperation(pbcReserved : IBindCtx) : HRESULT; stdcall;
begin
  Transferring:=True;
  Result:=S_OK;
end;

{Does not seem to be called by Explorer}
function TDragDropDataObject.InOperation(var pfInAsyncOp : BOOL) : HRESULT; stdcall;
begin
  if not Transferring then
    pfInAsyncOp:=False
  else
    pfInAsyncOp:=VARIANT_TRUE;
  Result:=S_OK;
end;

{Does not seem to be called by Explorer}
function TDragDropDataObject.EndOperation(HRESULT : HRESULT; pbcReserved : IBindCtx; dwEffects : DWORD) : HRESULT; stdcall;
begin
  Transferring:=False;
  Result:=S_OK;
end;

function GetDataObjectA(Files : PAnsiChar) : IDataObject;
begin
  Result:=TDragDropDataObject.CreateA(Files);
  (Result as IAsyncOperation).SetAsyncMode(True);
end;

function GetDataObjectW(Files : PWideChar) : IDataObject;
begin
  Result:=TDragDropDataObject.CreateW(Files);
  (Result as IAsyncOperation).SetAsyncMode(True);
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.

[ghisler(Author)]

Thanks for your code. Currently I don't plan to change this because it's too complex (too many functions to handle too many different formats).

[MarcinW]

Well, is there any special handling required? The only thing that the sample application above must do is to create a list of files to be copied (by using GetDataObjectA/W call). The operating system does the rest - we can even close the application and copying doesn't stop.

[ghisler(Author)]

Currently TC handles a variety of formats dropped to it:

CF_HDROP: File names -> copy normally
CFSTR_SHELLIDLIST: Virtual files/folders -> get via IContextMenu "paste"
CFSTR_FILEDESCRIPTORW,
CFSTR_FILEDESCRIPTOR: data objects: 3 cases:
TYMED_HGLOBAL: get data from global memory
TYMED_ISTREAM: get data from stream
TYMED_ISTORAGE: get via StgCreateDocfile
CFSTR_SHELLURL: URLs dropped from browsers -> create .url file

[MarcinW]

...TC handles a variety of formats dropped to it:

But we are talking about dragging from TC, not to TC. Try using the example above with TC, so you will be able to drag large files from TC and drop them to Explorer in a fully asynchronous manner.

[Frontier2]

I've been looking into this recently. One needs to expose IAsyncOperation (renamed IDataObjectAsyncCapability in windows 8) in their drop object implementation for the windows shell to perform background drop operations.

There's a little care required when releasing the data object as StartOperation and EndOperation are run outside your main thread.

[ghisler(Author)]

I see - since this is very complex, I prefer to postpone it to a later version. The beta test has been going on for too long already.