delphi - 为什么在此代码中第二次调用 ShBrowseForFolder 失败？

Question

下面用于调用 ShBrowseForFolder 的包装器代码仅工作一次:如果我第二次调用 Execute 方法，则对话框不会出现在“PtrIDL := ShBrowseForFolder(BrowseInfo);”上称呼。谁能看出出了什么问题吗？

unit ShBrowseU;
(* Wrapper for ShBrowseForFolder
 *  22/01/2004
 *
 * Changes JD 6-7-2012:
 * - Inherit from TComponent
 * - Published properties
 * Changes JD 27-9-2012:
 * - Coinitialize call only once
 * Todo:
 * - Make UNCFolder, FolderCheck, Options and SelIconIndex published properties
 * - Catch Left/Top input < 0
 * - Component needs icon
 *)

interface

uses
  Windows, Messages, SysUtils, Classes, Dialogs, ShlObj ;

type
  TFolderCheck = function(Sender : TObject; Folder : string) : boolean of object;

  TShBrowseOption = (sboBrowseForComputer, sboBrowseForPrinter,
                     sboBrowseIncludeFiles, sboBrowseIncludeURLs,
                     sboDontGoBelowDomain, sboEditBox, sboNewDialogStyle,
                     sboNoNewFolderButton, sboReturnFSAncestors,
                     sboReturnOnlyFSDirs, sboShareable, sboStatusText,
                     sboUAHint, sboUseNewUI, sboValidate);
  TShBrowseOptions = set of TShBrowseOption;

  TShBrowse = class(TComponent)
  private
    FBrowseWinHnd : THandle;
    FCaption : string;
    FFolder : string;
    FFolderCheck : TFolderCheck;
    FInitFolder : string;
    FLeft : integer;
    FOptions : TShBrowseOptions;
    FSelIconIndex : integer;
    FTop : integer;
    FUserMessage : string;
    WinFlags : DWord;
    FCoInitialized: Boolean;
    procedure Callback(Handle : THandle; MsgId : integer; lParam : DWord);
    function GetUNCFolder : string;
    function IdFromPIdL(PtrIdL : PItemIdList; FreeMem : boolean) : string;
    procedure SetOptions(AValue : TShBrowseOptions);
  protected
    property BrowseWinHnd : THandle read FBrowseWinHnd write FBrowseWinHnd;
  published
    property Caption : string read FCaption write FCaption;
    property InitFolder : string read FInitFolder write FInitFolder;
    property Left : integer read FLeft write FLeft; // both Left & Top must be > 0 to position window
    property Top : integer read FTop write FTop;
    property UserMessage : string read FUserMessage write FUserMessage;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute : boolean;
    property Folder : string read FFolder;
    property UNCFolder : string read GetUNCFolder;
    property FolderCheck : TFolderCheck write FFolderCheck;
    property Options : TShBrowseOptions read FOptions write SetOptions;
    property SelIconIndex : integer read FSelIconIndex;
  end;

implementation

uses
  ActiveX;

const
  BIF_RETURNONLYFSDIRS    = $00000001;
  BIF_DONTGOBELOWDOMAIN   = $00000002;
  BIF_STATUSTEXT          = $00000004;
  BIF_RETURNFSANCESTORS   = $00000008;
  BIF_EDITBOX             = $00000010;
  BIF_VALIDATE            = $00000020;
  BIF_NEWDIALOGSTYLE      = $00000040;
  BIF_USENEWUI            = $00000040;
  BIF_BROWSEINCLUDEURLS   = $00000080;
  BIF_NONEWFOLDERBUTTON   = 0;
  BIF_UAHINT              = 0;
  BIF_BROWSEFORCOMPUTER   = $00001000;
  BIF_BROWSEFORPRINTER    = $00002000;
  BIF_BROWSEINCLUDEFILES  = $00004000;
  BIF_SHAREABLE           = $00008000;
  BFFM_VALIDATEFAILED     = 3;

  ShBrowseOptionArray : array[TShBrowseOption] of DWord =
                    (BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER,
                     BIF_BROWSEINCLUDEFILES, BIF_BROWSEINCLUDEURLS,
                     BIF_DONTGOBELOWDOMAIN, BIF_EDITBOX, BIF_NEWDIALOGSTYLE,
                     BIF_NONEWFOLDERBUTTON, BIF_RETURNFSANCESTORS,
                     BIF_RETURNONLYFSDIRS, BIF_SHAREABLE, BIF_STATUSTEXT,
                     BIF_UAHINT, BIF_USENEWUI, BIF_VALIDATE);

function ShBFFCallback(hWnd : THandle; uMsg : integer;
                       lParam, lpData : DWord) : integer; stdcall;
{connects the ShBFF callback general function to the
 Delphi method which handles it}
begin
  TShBrowse(lpData).Callback(hWnd, uMsg, lParam); // calls object's method
  Result := 0;
end;

constructor TShBrowse.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Browse for folder';  // default
  UserMessage := 'Select folder';  // default
end;

procedure TShBrowse.Callback(Handle : THandle; MsgId : integer; lParam : DWord);
{Delphi method which handles the ShBFF callback}
var
  WorkArea, WindowSize : TRect;
  BFFWidth, BFFHeight : integer;
  SelOK : boolean;
begin
  FBrowseWinHnd := Handle;
  case MsgId of
    BFFM_INITIALIZED :
        begin
          if (FLeft = 0) or (FTop = 0) then begin
            {center the browse window on screen}
            GetWindowRect(FBrowseWinHnd, WindowSize);  // get ShBFF window size
            with WindowSize do begin
              BFFWidth := Right - Left;
              BFFHeight := Bottom - Top;
            end;
            SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0); // get screen size
            with WorkArea do begin  // calculate ShBFF window position
              FLeft := (Right - Left - BFFWidth) div 2;
              FTop := (Bottom - Top - BFFHeight) div 2;
            end;
          end;
          {set browse window position}
          // SetWindowPos(FBrowseWinHnd, HWND_TOP, FLeft, FTop, 0, 0, SWP_NOSIZE);
          SetWindowPos(FBrowseWinHnd, HWND_TOPMOST, FLeft, FTop, 0, 0, SWP_NOSIZE);  // Always on top
          if (FCaption <> '') then
            {set Caption}
            SendMessage(FBrowseWinHnd, WM_SETTEXT, 0, integer(PChar(FCaption)));
          if (FInitFolder <> '') then
            {set initial folder}
            SendMessage(FBrowseWinHnd, BFFM_SETSELECTION, integer(LongBool(true)),
                        integer(PChar(FInitFolder)));
        end;
    BFFM_SELCHANGED :
        begin
          if Assigned(FFolderCheck) then
            {get folder and check for validity}
            if (lParam <> 0) then begin
              FFolder := IdFromPIdL(PItemIdList(lParam), false);
              {check folder ....}
              SelOK := FFolderCheck(Self, FFolder);
              {... en/disable OK button}
              SendMessage(Handle, BFFM_ENABLEOK, 0, integer(SelOK));
            end; {if (lParam <> nil)}
          {end; if Assigned(FFolderCheck)}
        end;
  {  BFFM_IUNKNOWN :;
    BFFM_VALIDATEFAILED :;  }
  end;
end;

procedure TShBrowse.SetOptions(AValue : TShBrowseOptions);
var
  I : TShBrowseOption;
begin
  if (AValue <> FOptions) then begin
    FOptions := AValue;
    WinFlags := 0;
    for I := Low(TShBrowseOption) to High(TShBrowseOption) do
      if I in AValue then
        WinFlags := WinFlags or ShBrowseOptionArray[I];
  end;
end;

function TShBrowse.Execute : boolean;
// Called to display the ShBFF window and return the selected folder
var
  BrowseInfo : TBrowseInfo;
  IconIndex  : integer;
  PtrIDL     : PItemIdList;     // Item identifier list
begin
  FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0);
  IconIndex := 0;
  with BrowseInfo do begin
    hwndOwner := Self.FBrowseWinHnd;
    PIDLRoot  := nil;
    pszDisplayName := nil;
    lpszTitle := PChar(FUserMessage);
    ulFlags   := WinFlags;
    lpfn      := @ShBFFCallback;
    lParam    := integer(Self); // this object's reference
    iImage    := IconIndex;
  end;

//  if not FCoInitialized then FCoInitialized := Succeeded(CoInitializeEx(nil,COINIT_APARTMENTTHREADED));

  PtrIDL := ShBrowseForFolder(BrowseInfo);
  if PtrIDL = nil then
    Result := false
  else begin
    FSelIconIndex := BrowseInfo.iImage;
    FFolder := IdFromPIdL(PtrIDL, true);   // This clears memory again
    Result := true;
  end; {if PtrIDL = nil else}
end;

function TShBrowse.IdFromPIdL(PtrIdL : PItemIdList; FreeMem : boolean) : string;
var
  AMalloc : IMalloc;
begin
  Result := '';
  SetLength(Result, MAX_PATH);
  SHGetPathFromIDList(PtrIDL, PChar(Result));
  Result := trim(Result);
  Result := string(PChar(Result));
  // When a PIDL is passed via BFFM_SELCHANGED and that selection is OK'ed
  // then the PIDL memory is the same as that returned by ShBrowseForFolder.
  // This leads to the assumption that ShBFF frees the memory for the PIDL
  // passed by BFFM_SELCHANGED if that selection is NOT OK'ed. Hence one
  // should free memory ONLY when ShBFF returns, NOT for BFF_SELCHANGED
  if FreeMem then begin
    {free PIDL memory ...}
    ShGetMalloc(AMalloc);
    AMalloc.Free(PtrIDL);
  end;
end;

function TShBrowse.GetUNCFolder : string;
  function GetErrorStr(Error : integer) : string;
  begin
    Result := 'Unknown Error : ' + IntToStr(Error); // default
    case Error of
      ERROR_BAD_DEVICE :         Result := 'Invalid path';
      ERROR_CONNECTION_UNAVAIL : Result := 'No connection';
      ERROR_EXTENDED_ERROR :     Result := 'Network error';
      ERROR_MORE_DATA :          Result := 'Buffer too small';
      ERROR_NOT_SUPPORTED :      Result := 'UNC name not supported';
      ERROR_NO_NET_OR_BAD_PATH : Result := 'Unrecognised path';
      ERROR_NO_NETWORK :         Result := 'Network unavailable';
      ERROR_NOT_CONNECTED :      Result := 'Not connected';
    end;
  end;

var
  LenResult  : Cardinal;
  Error      : integer;
  PtrUNCInfo : PUniversalNameInfo;

begin
  {note that both the PChar _and_ the characters it
   points to are placed in UNCInfo by WNetGetUniversalName
   on return, hence the extra allocation for PtrUNCInfo}
  LenResult := 4 + MAX_PATH; // "4 +" for storage for lpUniversalName == @path
  SetLength(Result, LenResult);
  PtrUNCInfo := AllocMem(LenResult);
  // bh, 13-8-2012, PAnsiChar replaced by PWideChar
  Error := WNetGetUniversalName(PWideChar(FFolder), UNIVERSAL_NAME_INFO_LEVEL,
                                PtrUNCInfo, LenResult);
  if Error = NO_ERROR then begin
    Result := string(PtrUNCInfo^.lpUniversalName);
    SetLength(Result, Length(Result));
    end
  else
    Result := GetErrorStr(Error);
end;

end.

请注意，我注释掉了 CoInitializeEx 调用，但这没有什么区别。

这是XE2代码，Win7 64位下的Win32测试应用程序。

提前致谢一月

Answer 1

这里有很多看起来很奇怪的代码，但我不会尝试太深入。我想说的是，FBrowseWinHnd 的输入不正确。它是HWND。您在此单元中没有任何 THandle。它们都应该是 HWND。

错误在这里:

with BrowseInfo do begin
  hwndOwner := Self.FBrowseWinHnd;//oops, this is wrong

该设置将对话框的所有者窗口设置为表示上次显示对话框的窗口句柄。这就是为什么它只在第二次询问时才会失败。

显然这是错误的。只需删除这行代码并将 hwndOwner 保留为 0。如果您想为对话框指定所有者，请更改 Execute 的签名以接收所有者窗口句柄，然后将其传递到对话框。

<小时/>

如何调试一次成功但再次调用时失败的 API 调用？第一步是查看参数的值，看看它们在一次调用与下一次调用之间是否有所不同。事实上，正是这样做我才发现了问题。