当我从我的 Delphi 程序中调用 Windows API 时，为什么会发生堆栈溢出？

Question

我的表单支持从 Windows 资源管理器中拖放文件：

uses 
  ShellApi, System.IOUtils;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Self.Handle, True);
end;

procedure TFormMain.WMDropFiles(var Msg: TMessage);
var
  hDrop: THandle;
  FileCount, NameLen, i: Integer;
  CurrFile: String;
  FileSysEntries: TArray<String>;
begin
  inherited;

  hDrop := Msg.wParam;
  try
    FileCount := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);

    for i := 0 to FileCount - 1 do
    begin
      NameLen := DragQueryFile(hDrop, i, nil, 0) + 1; //+1 for NULL
      SetLength(CurrFile, NameLen);
      DragQueryFile(hDrop, i, PWideChar(CurrFile), NameLen);

      //If I don't do this...
      SetLength(CurrFile, StrLen(PWideChar(CurrFile)));

      if DirectoryExists(CurrFile) then
      begin
        //...I get a stack overflow here!
        FileSysEntries := TDirectory.GetFiles(CurrFile, '*.*', TSearchOption.soAllDirectories);
        //Rest removed for clarity...
      end;
    end;
  finally
    DragFinish(hDrop);
  end;
end;

现在，如果我不从 CurrFile 字符串中去除 NULL (#0) 字符（请参阅第 2 个 SetLength），当我调用 TDirectory.GetFiles 我现在知道为什么了。

第二个 SetLength（去掉 #0）真的有必要吗？还是我应该为第一个 SetLength 做 NameLen - 1？或者别的什么？

Answer 1

我看到了一些问题：

您仅在表单的 OnCreate 事件中调用 DragAcceptFiles()。如果表单的 HWND 在表单的生命周期内被重新创建（这可能发生！），您将无法接收 WM_DROPFILES 消息。

您需要使用更新后的 HWND 再次调用 DragAcceptFiles()。您可以覆盖表单的虚拟 CreateWnd() 方法来处理它。

或者，您可以重写表单的虚拟 CreateParams() 方法，为每个创建的 HWND 启用 WS_EX_ACCEPTFILES 扩展 window 样式。
您的消息处理程序正在调用 inherited。您不需要这样做。默认处理程序不会对该消息执行任何操作。
您为 CurrFile 分配了过多的内存。从技术上讲，调用 SetLength() 时不需要包含空终止符，因为它会自动为一个分配额外的 space（Delphi string 隐式以空终止，因此PChar 强制转换可以与期望以空字符结尾的字符指针的 C 风格 API 一起使用。

如果您确实在 string 的长度中包含空终止符，则您必须在之后显式缩小 strings 的长度，您正在这样做（但效率不高）是，因为 DragQueryFile(i) 会告诉您在没有空终止符的情况下使用的长度，因此您不必使用 StrLen() 手动计算它）。但是，最好不要一开始就过度分配。

显然，字符串长度中有额外的 #0 会导致 TDirectory.GetFiles()（或者更可能是 TPath，TDirectory 在内部使用）的问题。你应该 file a bug report 关于那个。但是，您确实需要确保不要在字符串的长度中留下终止符 #0，因为文件系统路径 API 无论如何都不接受它。

试试这个：

uses 
  ShellApi, System.IOUtils;

procedure TFormMain.CreateWnd;
begin
  inherited;
  DragAcceptFiles(Self.Handle, True);
end;

procedure TFormMain.WMDropFiles(var Msg: TMessage);
var
  hDrop: THandle;
  FileCount, NameLen, i: Integer;
  CurrFile: String;
  FileSysEntries: TArray<String>;
begin
  hDrop := Msg.wParam;
  try
    FileCount := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);

    for i := 0 to FileCount - 1 do
    begin
      NameLen := DragQueryFile(hDrop, i, nil, 0);
      SetLength(CurrFile, NameLen);
      DragQueryFile(hDrop, i, PChar(CurrFile), NameLen + 1);

      if TDirectory.Exists(CurrFile) then
      begin
        FileSysEntries := TDirectory.GetFiles(CurrFile, '*.*', TSearchOption.soAllDirectories);
        //...
      end;
    end;
  finally
    DragFinish(hDrop);
  end;
end;

当我从我的 Delphi 程序中调用 Windows API 时，为什么会发生堆栈溢出？

Why do I get a stack overflow when I call the Windows API from my Delphi program?

delphi

winapi

drag-and-drop

delphi-10.4-sydney

getfiles