为什么在此代码中第二次调用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调用，然后再次调用时失败？第一步是查看参数的值，看看它们是否因呼叫而不同。事实上，这正是我如何发现问题的方法。