jvqbrowsefolder.pas

East make Tray Icon in delphi

  BFFM_SETEXPANDED           = WM_USER + 106; // Unicode only
  BFFM_IUNKNOWN              = 5;             // provides IUnknown to client. lParam: IUnknown*

  { TOptionsDirectory = (odBrowseForComputer, odOnlyDirectory, odOnlyPrinters,
      odNoBelowDomain, odSystemAncestorsOnly, odFileSystemDirectoryOnly,
      odStatusAvailable, odIncludeFiles, odIncludeUrls, odEditBox,
      odNewDialogStyle, odShareable, odUsageHint, odNoNewButtonFolder, odValidate);
  }

  { (rb) No idea why odOnlyDirectory is used? }

  COptionsDirectory: array [TOptionsDirectory] of Cardinal = (
    BIF_BROWSEFORCOMPUTER, 0, BIF_BROWSEFORPRINTER, BIF_DONTGOBELOWDOMAIN,
    BIF_RETURNFSANCESTORS, BIF_RETURNONLYFSDIRS, BIF_STATUSTEXT,
    BIF_BROWSEINCLUDEFILES, BIF_BROWSEINCLUDEURLS, BIF_EDITBOX,
    BIF_NEWDIALOGSTYLE, BIF_SHAREABLE, BIF_UAHINT, BIF_NONEWFOLDERBUTTON,
    BIF_VALIDATE);

  { TJvBrowseObjectClass = (ocFolders, ocNonFolders, ocIncludeHidden,
      ocInitOnFirstNext, ocNetPrinterSrch, ocSharable, ocStorage)
  }

  CBrowseObjectClasses: array [TJvBrowsableObjectClass] of Cardinal = (
    SHCONTF_FOLDERS, SHCONTF_NONFOLDERS, SHCONTF_INCLUDEHIDDEN,
    SHCONTF_INIT_ON_FIRST_NEXT, SHCONTF_NETPRINTERSRCH,
    SHCONTF_SHAREABLE, SHCONTF_STORAGE);

function BrowseForFolder(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext): Boolean;
begin
  with TJvBrowseForFolderDialog.Create(nil) do
  try
    Position := fpScreenCenter;
    Directory := ADirectory;
    Title := ATitle;
    HelpContext := AHelpContext;
    if AllowCreate then
      Options := Options + [odNewDialogStyle]
    else
      Options := Options - [odNewDialogStyle];
    Result := Execute;
    if Result then
      ADirectory := Directory;
  finally
    Free;
  end;
end;

function BrowseForComputer(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext): Boolean;
begin
  with TJvBrowseForFolderDialog.Create(nil) do
  try
    Position := fpScreenCenter;
    Directory := ADirectory;
    Title := ATitle;
    HelpContext := AHelpContext;
    if AllowCreate then
      Options := Options + [odNewDialogStyle]
    else
      Options := Options - [odNewDialogStyle];
    Options := Options + [odBrowseForComputer];
    RootDirectory := fdNetwork;
    Result := Execute;
    if Result then
      ADirectory := Directory;
  finally
    Free;
  end;
end;

function BrowseDirectory(var AFolderName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;
begin
  Result := BrowseForFolder(DlgText, True, AFolderName, AHelpContext);
end;

function BrowseComputer(var AComputerName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;
begin
  Result := BrowseForComputer(DlgText, True, AComputerName, AHelpContext);
end;

{ From QDialogs.pas }

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet): string;
var
  P: PChar;
begin
  case StrRet.uType of
    STRRET_CSTR:
      SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
    STRRET_OFFSET:
      begin
        P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
        SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
      end;
    STRRET_WSTR:
      Result := StrRet.pOleStr;
  end;
end;

type
  TFromDirectoryData = record
    CSIDL: Cardinal;
    MinVersion: Cardinal;
    OnlyNT: Boolean;
    CanSimulate: Boolean;
    Alternative: TFromDirectory;
  end;

const
  CSIDLLocations: array [TFromDirectory] of TFromDirectoryData = (
    { fdNoSpecialFolder }
    (CSIDL: 0; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRootFolder }
    (CSIDL: 0; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRecycleBin }
    (CSIDL: CSIDL_BITBUCKET; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdControlPanel }
    (CSIDL: CSIDL_CONTROLS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdDesktop }
    (CSIDL: CSIDL_DESKTOP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdDesktopDirectory }
    (CSIDL: CSIDL_DESKTOPDIRECTORY; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdMyComputer }
    (CSIDL: CSIDL_DRIVES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdFonts }
    (CSIDL: CSIDL_FONTS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdNetHood }
    (CSIDL: CSIDL_NETHOOD; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdNetwork }
    (CSIDL: CSIDL_NETWORK; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPersonal }
    (CSIDL: CSIDL_PERSONAL; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdPrinters }
    (CSIDL: CSIDL_PRINTERS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPrograms }
    (CSIDL: CSIDL_PROGRAMS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRecent }
    (CSIDL: CSIDL_RECENT; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdSendTo }
    (CSIDL: CSIDL_SENDTO; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartMenu }
    (CSIDL: CSIDL_STARTMENU; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartup }
    (CSIDL: CSIDL_STARTUP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdTemplates }
    (CSIDL: CSIDL_TEMPLATES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartUpNonLocalized }
    (CSIDL: CSIDL_ALTSTARTUP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonStartUpNonLocalized }
    (CSIDL: CSIDL_COMMON_ALTSTARTUP; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonDocuments }
    (CSIDL: CSIDL_COMMON_DOCUMENTS; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonFavorites }
    (CSIDL: CSIDL_COMMON_FAVORITES; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonPrograms }
    (CSIDL: CSIDL_COMMON_PROGRAMS; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonStartUp }
    (CSIDL: CSIDL_COMMON_STARTUP; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonTemplates }
    (CSIDL: CSIDL_COMMON_TEMPLATES; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCookies }
    (CSIDL: CSIDL_COOKIES; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdFavorites }
    (CSIDL: CSIDL_FAVORITES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdHistory }
    (CSIDL: CSIDL_HISTORY; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdInternet }
    (CSIDL: CSIDL_INTERNET; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdMyMusic }
    (CSIDL: CSIDL_MYMUSIC; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPrinthood }
    (CSIDL: CSIDL_PRINTHOOD; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdConnections }
    (CSIDL: CSIDL_CONNECTIONS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdAppData }
    (CSIDL: CSIDL_APPDATA; MinVersion: $00040071; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdInternetCache }
    (CSIDL: CSIDL_INTERNET_CACHE; MinVersion: $00040072; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdAdminTools }
    (CSIDL: CSIDL_ADMINTOOLS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonAdminTools }
    (CSIDL: CSIDL_COMMON_ADMINTOOLS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonAppData }
    (CSIDL: CSIDL_COMMON_APPDATA; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdLocalAppData }
    (CSIDL: CSIDL_LOCAL_APPDATA; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdMyPictures }
    (CSIDL: CSIDL_MYPICTURES; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdPersonal),
    { fdProfile }
    (CSIDL: CSIDL_PROFILE; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdProgramFiles }
    (CSIDL: CSIDL_PROGRAM_FILES; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdProgramFilesCommon }
    (CSIDL: CSIDL_PROGRAM_FILES_COMMON; MinVersion: $00050000; OnlyNT: True;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdSystem }
    (CSIDL: CSIDL_SYSTEM; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdWindows }
    (CSIDL: CSIDL_WINDOWS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCDBurnArea }
    (CSIDL: CSIDL_CDBURN_AREA; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonMusic }
    (CSIDL: CSIDL_COMMON_MUSIC; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdCommonPictures }
    (CSIDL: CSIDL_COMMON_PICTURES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdCommonVideo }
    (CSIDL: CSIDL_COMMON_VIDEO; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdMyDocuments }
    (CSIDL: CSIDL_MYDOCUMENTS; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdPersonal),
    { fdMyVideo }
    (CSIDL: CSIDL_MYVIDEO; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdPersonal),
    { fdProfiles }
    (CSIDL: CSIDL_PROFILES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdResources }
    (CSIDL: CSIDL_RESOURCES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdResourcesLocalized }
    (CSIDL: CSIDL_RESOURCES_LOCALIZED; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonOEMLinks }
    (CSIDL: CSIDL_COMMON_OEM_LINKS; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdComputersNearMe }
    (CSIDL: CSIDL_COMPUTERSNEARME; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder)
    );

procedure InitSHFolder;
const
  SHFolderDll = 'SHFolder.dll';
var
  SHFolderHandle: HMODULE;
begin
  { You never know, maybe someone does not have SHFolder.dll, thus load on request }
  SHFolderHandle := GetModuleHandle(SHFolderDll);
  if SHFolderHandle <> 0 then
    @SHGetFolderPathProc := GetProcAddress(SHFolderHandle, 'SHGetFolderPathA');
end;

procedure GetCSIDLLocation(const ASpecialDirectory: TFromDirectory;
  var CSIDL: Cardinal; var APath: string);
{ This function is a bit overkill }
var
  LSpecialDirectory: TFromDirectory;
  Buffer: PChar;

  function IsOk: Boolean;
  begin
    with CSIDLLocations[LSpecialDirectory] do
      Result := (MinVersion <= GetShellVersion) and
        (not OnlyNT or (Win32Platform = VER_PLATFORM_WIN32_NT));
  end;

begin
  LSpecialDirectory := ASpecialDirectory;
  while (LSpecialDirectory <> fdNoSpecialFolder) and
    not CSIDLLocations[LSpecialDirectory].CanSimulate and not IsOk do
    LSpecialDirectory := CSIDLLocations[LSpecialDirectory].Alternative;

  if (LSpecialDirectory = fdNoSpecialFolder) or IsOk then
  begin
    CSIDL := CSIDLLocations[LSpecialDirectory].CSIDL;
    Exit;
  end;

  CSIDL := 0;
  GetMem(Buffer, MAX_PATH);
  try
    if not Assigned(SHGetFolderPathProc) then
      InitSHFolder;
    if Assigned(SHGetFolderPathProc) and
      Succeeded(SHGetFolderPathProc(0, CSIDLLocations[LSpecialDirectory].CSIDL, 0, 0, Buffer)) then

      APath := Buffer
    else
      APath := '';
  finally
    FreeMem(Buffer);
  end;
end;

function CreateIDListFromPath(const APath: string): PItemIDList;
var
  WS: WideString;
  Eaten, Flags: LongWord;
  IDesktopFolder: IShellFolder;
begin
  { Returned value must be freed }

  Result := nil;

  if APath = '' then
    Exit;

  WS := APath;
  { MSDN : Since Flags is an in/out parameter, it should always be initialized }
  Flags := 0;

  if Failed(SHGetDesktopFolder(IDesktopFolder)) or
    Failed(IDesktopFolder.ParseDisplayName(0, nil, POleStr(WS), Eaten, Result, Flags)) then
    Result := nil;
end;

function CreateIDListFromCSIDL(const ASpecialDirectory: TFromDirectory): PItemIDList;
var
  CSIDL: Cardinal;
  Path: string;
begin
  { Returned value must be freed }