拖放在我的delphi项目中不再起作用

Question

这个话题显然在这里被反复讨论过，但现在从我的角度来看，我已经没有选择了。

操作系统： Windows XP SP3

所以，这是我在我的应用中使用的 RichEdit 的拖放示例：

procedure TForm1.AcceptFiles( var msg : TMessage ); // or TWMDROPFILES
const
  cnMaxFileNameLen = 255;
var
  i,
  nCount     : integer;
  acFileName : array [0..cnMaxFileNameLen] of char;
begin
  // find out how many files we're accepting
  nCount := DragQueryFile( msg.WParam, // or msg.Drop
                           $FFFFFFFF,
                           acFileName,
                           cnMaxFileNameLen );

  // query Windows one at a time for the file name
  for i := 0 to nCount-1 do
  begin
    DragQueryFile( msg.WParam, { or msg.Drop} i,
                   acFileName, cnMaxFileNameLen );

    // do your thing with the acFileName
    MessageBox( Handle, acFileName, '', MB_OK );
  end;

  // let Windows know that you're done
  DragFinish( msg.WParam ); // or msg.Drop
end;

问题是在最近的一些更改之后（不幸的是，我没有使用任何 SVN，所以我无法跟踪哪个提交引入了这个问题）拖放不再起作用。

我在每个可能以某种方式相关（称为）的事件中都运行断点但没有成功：

RichEditMouseOver;

RichEditChange;

FormClick;

我的应用正在处理这些 WM：

procedure WMDropFiles(var Msg: TWMDROPFILES); message WM_DROPFILES;

procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;

procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;

procedure WMGetMinMaxInfo(var AMsg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;

procedure CMDialogKey(var Msg: TCMDialogKey ); message CM_DIALOGKEY;

在表单上使用 TRichEdit 的空白项目 - 一切正常。

还尝试将 DragAcceptFiles() Form1.Handle 更改为 RichEdit.Handle - 仍然没有运气。

在回显nCount和acFileName参数时，acFileName没有拖拽文件的文件路径...为什么？？？？

目前我只是不知道是什么让 acFileName 参数丢失了拖动文件路径。你能建议问题隐藏在哪里吗？

Answer 1

我将在这里尝试精神调试；你说它“不再起作用”意味着它在某些时候起作用。虽然您没有提到您使用的是哪个操作系统，但我也将推测您使用的是 Windows Vista 或 Windows 7（或相关的服务器版本）。

我怀疑正在发生的事情是您的应用程序以不同于 shell 的用户或权限级别运行。 Windows 不允许拖动（尤其是文件拖动）数据从一个权限级别的应用程序移动到另一个权限级别。如果您从 IDE 运行此程序，并且 IDE 以管理员身份运行，则生成的进程也在该级别运行。

检查以确保您的应用程序实际上是以登录用户身份运行的。我已经被这个咬过太多次了，而且非常微妙，以至于无法立即看出发生了什么。

Answer 2

恐怕我不是拖放文件实际工作原理的专家。所以我无法通过你的代码找出问题所在。

我能做的就是给你我使用的代码。它现在在 XP、Vista 和 Windows 7 上的 Delphi 2009 下适用于我。当我之前在 Windows 98 和 Windows XP 上使用 Delphi 4 时它也适用。

也许您可以使用此代码找出代码中的问题，或者您可能想尝试使用或调整此代码。它最初来自书：“Delphi 3 - 用户界面设计”，第 169 - 171 页。

如果我遗漏了一个重要的例程，请在评论中告诉我，我会编辑我的答案以包含它。

type
  TMainForm = class(TForm)
    procedure WMDropFiles(var WinMsg: TMessage);
              message wm_DropFiles;
    procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);

procedure TMainForm.FormShow(Sender: TObject);
begin
  DragAcceptFiles(Handle, true);
  Application.OnMessage := AppMessageHandler;
end;

procedure TLogoAppForm.WMDropFiles(var WinMsg: TMessage);
const
  BufSize = 255;
var
  TempStr : array[0..BufSize] of Char;
  NumDroppedFiles, I: integer;
  Filenames: TStringList;
begin
  NumDroppedFiles := DragQueryFile(TWMDropFiles(WinMsg).Drop, $ffffffff, nil, 0);
  if NumDroppedFiles >= 1 then begin
    Filenames := TStringList.Create;
    for I := 0 to NumDroppedFiles - 1 do begin
      DragQueryFile(TWMDropFiles(WinMsg).Drop, I, TempStr, BufSize);
      Filenames.Add(TempStr);
    end;
    OpenFiles(Filenames, '');
    Filenames.Free;
  end;
  DragFinish(TWMDropFiles(WinMsg).Drop);
  WinMsg.Result := 0;
end;

procedure TLogoAppForm.AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
begin
  if (Msg.Message = WM_DropFiles) and IsIconic(Application.Handle) then begin
    Perform(Msg.Message, Msg.Wparam, Msg.lParam);
    Handled := true;
  end
end;

Answer 3

摘自official Microsoft support forum:

不存在的可能原因 能够将文件拖放到 应用程序可以是 UAC 完整性 水平（IL）。在 Vista 中启用 UAC 或Win7，不允许拖放 发生从低 IL 过程到高 默认情况下，IL 进程。请检查 您的应用程序是否被提升 （以管理员身份运行）出现问题时 发生。

如果您不想禁用 UAC，可以尝试禁用 UIPI（用户界面特权隔离）。

打开 regedit 并转到：HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System

添加一个名为 EnableUIPI 的新 DWORD（32 位）值并将其设置为 0。

重新启动机器，看看它的行为是否符合您的要求。