[Delphi] Почему происходит ошибка в коде выбора каталога с помощью диалогового окна?

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Chrome~, 30 Dec 2009.

  1. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    937
    Likes Received:
    162
    Reputations:
    27
    Приветствую!
    В инете можно найти следующий код:
    Code:
    {....}
     uses
       ShlObj, ActiveX;
     {....}
    
     { 
      This code shows the SelectDirectory dialog with additional expansions: 
      - an edit box, where the user can type the path name, 
      - also files can appear in the list, 
      - a button to create new directories. 
    
      Dieser Code zeigt den SelectDirectory-Dialog mit zusatzlichen Erweiterungen: 
      - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann, 
      - auch Dateien konnen in der Liste angezeigt werden, 
      - eine Schaltflache zum Erstellen neuer Verzeichnisse. 
    }
     function AdvSelectDirectory(const Caption: string; const Root: WideString;
       var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
       AllowCreateDirs: Boolean = True): Boolean;
       // callback function that is called when the dialog has been initialized 
      //or a new directory has been selected 
      // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder 
      //ein neues Verzeichnis selektiert wurde 
      function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
         stdcall;
       var
         PathName: array[0..MAX_PATH] of Char;
       begin
         case uMsg of
           BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
           // include the following comment into your code if you want to react on the 
          //event that is called when a new directory has been selected 
          // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis 
          //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde 
          {BFFM_SELCHANGED: 
          begin 
            SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
            // the directory "PathName" has been selected 
            // das Verzeichnis "PathName" wurde selektiert 
          end;}
         end;
         Result := 0;
       end;
     var
       WindowList: Pointer;
       BrowseInfo: TBrowseInfo;
       Buffer: PChar;
       RootItemIDList, ItemIDList: PItemIDList;
       ShellMalloc: IMalloc;
       IDesktopFolder: IShellFolder;
       Eaten, Flags: LongWord;
     const
       // necessary for some of the additional expansions 
      // notwendig fur einige der zusatzlichen Erweiterungen 
      BIF_USENEWUI = $0040;
       BIF_NOCREATEDIRS = $0200;
     begin
       Result := False;
       if not DirectoryExists(Directory) then
         Directory := '';
       FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
       if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
       begin
         Buffer := ShellMalloc.Alloc(MAX_PATH);
         try
           RootItemIDList := nil;
           if Root <> '' then
           begin
             SHGetDesktopFolder(IDesktopFolder);
             IDesktopFolder.ParseDisplayName(Application.Handle, nil,
               POleStr(Root), Eaten, RootItemIDList, Flags);
           end;
           OleInitialize(nil);
           with BrowseInfo do
           begin
             hwndOwner := Application.Handle;
             pidlRoot := RootItemIDList;
             pszDisplayName := Buffer;
             lpszTitle := PChar(Caption);
             // defines how the dialog will appear: 
            // legt fest, wie der Dialog erscheint: 
            ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
               BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
               BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
             lpfn    := @SelectDirCB;
             if Directory <> '' then
               lParam := Integer(PChar(Directory));
           end;
           WindowList := DisableTaskWindows(0);
           try
             ItemIDList := ShBrowseForFolder(BrowseInfo);
           finally
             EnableTaskWindows(WindowList);
           end;
           Result := ItemIDList <> nil;
           if Result then
           begin
             ShGetPathFromIDList(ItemIDList, Buffer);
             ShellMalloc.Free(ItemIDList);
             Directory := Buffer;
           end;
         finally
           ShellMalloc.Free(Buffer);
         end;
       end;
     end;
    
     // Example: 
    procedure TForm1.Button1Click(Sender: TObject);
     var
       dir: string;
     begin
       AdvSelectDirectory('Caption', 'c:\', dir, False, False, True);
       Label1.Caption := dir;
     end;
    Основная функция здесь - AdvSelectDirectory. Она используется для вывода диалогового окна "Выбор каталога".

    В общем, никак не могу понять, почему, если несколько раз вызывать данную функцию, и просто закрывать окно выбора каталога с помощью кнопки закрыть, то, приблизительно, в первый раз будет все норм, а во второй раз произойдет Access violation.

    Также, если использовать в ulFlags параметр BIF_USENEWUI, то в окне выбора каталога при нажатии на "Мой компьютер", программа зависает.

    Заранее благодарю за помощь!!!