// C/C++
#include 

LPITEMIDLIST GetNextItemID(const LPITEMIDLIST pidl)
{
  size_t cb = pidl->mkid.cb;
  if( cb == 0 )
  {
    return NULL;
  }
  pidl = (LPITEMIDLIST) (((LPBYTE) pidl) + cb);
  if( pidl->mkid.cb == 0 )
  {
    return NULL;
  }
  return pidl;
}

// Delphi
uses ShlObj;

type
  PByte = ^Byte;

function GetNextItemID(pidl: PItemIDList): PItemIDList;
var
  cb: Integer;
begin
  cb := pidl^.mkid.cb;
  if cb = 0 then
  begin
    Result := nil;
    Exit;
  end;
  pidl := PItemIDList ( Integer(PByte(pidl)) + cb );
  if pidl^.mkid.cb = 0 then
  begin
    Result := nil;
    Exit;
  end;
  Result := pidl;
end;

// C++
#include 

size_t GetItemIDListSize(const LPITEMIDLIST pidl)
{
  size_t size = 0;
  LPBYTE p = LPBYTE(pidl);
  while( p != NULL )
  {
    if( static_cast(p + size)->mkid.cb == 0 )
    {
      size += sizeof( USHORT ); // size of terminator;
      break;
    }
    size += static_cast(p + size)->mkid.cb;
  }
  return size;
}

LPITEMIDLIST CopyItemIDList(const LPITEMIDLIST pidl)
{
  LPMALLOC pMalloc;
  LPITEMIDLIST pidlResult;
  if( pidl == NULL )
  {
    return NULL;
  }
  if( ! SUCCEEDED(SHGetMalloc(& pMalloc))
  {
    return NULL;
  }
  size_t size = GetItemIDListSize(pidl);
  pidlResult = pMalloc->Alloc( size );
  if( pidlResult != NULL )
  {
    CopyMemory( pidlResult, pidl, size );
  }
  pMalloc->Release();
  return pidlResult;
}

// Delphi
uses Windows, ActiveX, ShlObj;

type
  PByte = ^Byte;

function GetItemIDListSize(pidl: PItemIDList): Integer;
var
  p: PChar;
begin
  Result := 0;
  p := PChar(pidl);
  while p <> nil do
  begin
    if PItemIDList(p + Result)^.mkid.cb = 0 then
    begin
      Inc( Result, sizeof(Word) ); // size of terminator;
      break;
    end;
    Inc( Result, PItemIDList(p + Result)^.mkid.cb );
  end;
end;

function CopyItemIDList(pidl: PItemIDList): PItemIDList;
var
  pMalloc: IMalloc;
  size: Integer;
begin
  Result := nil;
  if not Assigned( pidl ) then
  begin
    Exit;
  end;
  if not SUCCEEDED(SHGetMalloc(pMalloc)) then
  begin
    Exit;
  end;
  size := GetItemIDListSize(pidl);
  Result := pMalloc.Alloc( size );
  if Assigned(Result) then
  begin
    CopyMemory( Result, pidl, size );
  end;
  pMalloc := nil; // Interface reference releasing
                  // will be proceed automatically
                  // by assigning a nil value
end;

// C/C++
  hr = ppsf->CompareIDs(0, pidlA, pidlB);
  if( SUCCEEDED(hr) )
  {
    iComparisonResult = short(HRESULT_CODE(hr))
  }

// Delphi
function HRESULT_CODE(hr: HRESULT): Word;
begin
  Result := Word(LongWord(hr) and $FFFF)
end;

  hr := ppsf.CompareIDs(0, pidlA, pidlB);
  if Succeeded(hr) then
  begin
    iComparisonResult := Shortint(HRESULT_CODE(hr));
  end;

// Delphi

(*
 * Эта программа показывает на экране диалог выбора папки,
 * где корнем дерева им¸н служит папка "Мой компьютер", а текущим
 * каталогом - папка "Файлы программ".
 *)

program ShellD;

uses
  SysUtils, Windows, ActiveX, ShlObj;

var
  Malloc: IMalloc;
  Desktop: IShellFolder;
  pidlMyComputer: PItemIDList;
  pidlResult: PItemIDList;
  pidlInitialFolder: PItemIDList;

function BrowseCallbackProc( hWnd: HWND; uMsg: UINT; lParam: LPARAM;
  lpData: LPARAM ): Integer; stdcall; // обратите внимание на соглашение о вызовах -
                                      // stdcall
begin
  Result := 0;
  case uMsg of
    BFFM_INITIALIZED:
    begin
      PostMessage( hWnd, BFFM_SETSELECTION, 0, Integer(pidlInitialFolder) );
      PostMessage( hWnd, BFFM_SETSTATUSTEXT, 0,
        Integer(PChar('Функция обратного вызова установлена.')) );
    end;
  end;
end;

function GetProgramFilesDirByKeyStr(KeyStr: string): string;
var
  dwKeySize: DWORD;
  Key: HKEY;
  dwType: DWORD;
begin
  if
    RegOpenKeyEx( HKEY_LOCAL_MACHINE, PChar(KeyStr), 0, KEY_READ, Key ) = ERROR_SUCCESS
  then
  try
    RegQueryValueEx( Key, 'ProgramFilesDir', nil, @dwType, nil, @dwKeySize );
    if (dwType in [REG_SZ, REG_EXPAND_SZ]) and (dwKeySize > 0) then
    begin
      SetLength( Result, dwKeySize );
      RegQueryValueEx( Key, 'ProgramFilesDir', nil, @dwType, PByte(PChar(Result)),
        @dwKeySize );
    end
    else
    begin
      RegQueryValueEx( Key, 'ProgramFilesPath', nil, @dwType, nil, @dwKeySize );
      if (dwType in [REG_SZ, REG_EXPAND_SZ]) and (dwKeySize > 0) then
      begin
        SetLength( Result, dwKeySize );
        RegQueryValueEx( Key, 'ProgramFilesPath', nil, @dwType, PByte(PChar(Result)),
          @dwKeySize );
      end;
    end;
  finally
    RegCloseKey( Key );
  end;
end;

// Here is old way to retrieve Program Files folder location,
// Modern way is using of SHGetSpecialFolder (shfolder.dll) with
// CSIDL_PROGRAM_FILES constant.

function GetProgramFilesDir: string;
const
  DefaultProgramFilesDir = '%SystemDrive%\Program Files';
var
  FolderName: string;
  dwStrSize: DWORD;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    FolderName :=
      GetProgramFilesDirByKeyStr('Software\Microsoft\Windows NT\CurrentVersion');
  end;
  if Length(FolderName) = 0 then
  begin
    FolderName :=
      GetProgramFilesDirByKeyStr('Software\Microsoft\Windows\CurrentVersion');
  end;
  if Length(FolderName) = 0 then FolderName := DefaultProgramFilesDir;
  dwStrSize := ExpandEnvironmentStrings( PChar(FolderName), nil, 0 );
  SetLength( Result, dwStrSize );
  ExpandEnvironmentStrings( PChar(FolderName), PChar(Result), dwStrSize );
end;

var
  bi: TBrowseInfo;
  DisplayName: string;
  ProgramFilesDir: WideString;
  CharsDone: ULONG;
  dwAttributes: DWORD;
  Temp: string;

begin
  ProgramFilesDir := GetProgramFilesDir;
  // acquire shell's allocator
  if SUCCEEDED( SHGetMalloc( Malloc ) ) then
  try
    // acquire shell namespace root folder
    if SUCCEEDED( SHGetDesktopFolder( Desktop ) ) then
    try
      // acquire folder that will serve as root in dialog
      if SUCCEEDED( SHGetSpecialFolderLocation( 0, CSIDL_DRIVES, pidlMyComputer ) ) then
      try
        // acquire PIDL for folder that will be selected by default
        if
          SUCCEEDED(
            Desktop.ParseDisplayName( 0, nil, PWideChar(ProgramFilesDir), CharsDone,
            pidlInitialFolder, dwAttributes )
          )
        then
        try
          SetLength( DisplayName, MAX_PATH );
          FillChar( bi, sizeof(bi), 0 );
          bi.pidlRoot := pidlMyComputer; // roots from 'My Computer'
          bi.pszDisplayName := PChar( DisplayName );
          bi.lpszTitle := PChar('Выберите папку');
          bi.ulFlags := BIF_STATUSTEXT;
          bi.lpfn := BrowseCallbackProc;
          pidlResult := SHBrowseForFolder( bi );
          if Assigned(pidlResult) then
          try
            SetLength( Temp, MAX_PATH );
            if SHGetPathFromIDList( pidlResult, PChar(Temp) ) then
            begin
              DisplayName := Temp;
            end;
            DisplayName := Trim(DisplayName) + '.';
            MessageBox( 0, PChar(DisplayName), 'Вы успешно выбрали папку',
              MB_OK or MB_ICONINFORMATION );
          finally
            Malloc.Free( pidlResult ); // release returned value
          end;
        finally
          Malloc.Free( pidlInitialFolder ); // release PIDL for folder that
                                            // was selected by default
        end;
      finally
        Malloc.Free( pidlMyComputer ); // release folder that was served as root in dialog
      end;
    finally
      Desktop := nil; // release shell namespace root folder
    end;
  finally
    Malloc := nil; // release shell's allocator
  end;
end.

// C++ with Microsoft extensions

// Это консольное приложение печатает на стандартный вывод дерево папок
// основного пространства имён оболочки Windows.

#define _WIN32_DCOM

#include 
#include 
#include 
#include 

using namespace std;

// Эта процедура производит вывод строки, попутно
// конвертируя её из кодировки ANSI в кодировку OEM.
void WriteStr(const char * s)
{
  char * s1 = strdup( s );
  CharToOemBuff( s1, s1, strlen(s1) );
  cout << s1;
  free( reinterpret_cast( s1 ) );
}

// Эта процедура производит вывод указанного
// количества символов, попутно конвертируя их из кодировки ANSI
// в кодировку OEM.
void WriteChar(char ch, size_t count)
{
  CharToOemBuff( &ch, &ch, 1 );
  for(int i=0; i < count; i++) cout << ch;
}

// Эта процедура производит вывод строки, попутно
// конвертируя её из кодировки ANSI в кодировку OEM.
// Эта процедура также добавляет перевод каретки по окончании вывода.
void WritelnStr(const char * s)
{
  WriteStr( s );
  cout << "\n";
}

LPMALLOC pMalloc = NULL;
HRESULT hr;

// Эта процедура интерпретирует содержание структуры STRRET.
// Также она освобождает временные буфера при необходимости, так что
// для её корректной работы требуется наличие объекта pMalloc.
// После завершения работы с возвращаемым именем необходимо освободить буфер
// с помощью процедуры ::free.
char * GetDisplayName( LPCITEMIDLIST pidl,  const STRRET& value )
{
  char * result = NULL;
  switch( value.uType )
  {
  case STRRET_CSTR:
    result = strdup( value.cStr );
    break;
  case STRRET_WSTR:
    {
      int iSize = WideCharToMultiByte( CP_THREAD_ACP, 0, value.pOleStr, -1, NULL, 0, NULL, NULL );
      result = (char *)malloc(iSize);
      WideCharToMultiByte( CP_THREAD_ACP, 0, value.pOleStr, -1, result, iSize, NULL, NULL );
      pMalloc->Free( value.pOleStr );
    }
    break;
  case STRRET_OFFSET:
    result = strdup( PSTR( PBYTE(pidl) + value.uOffset ) );
    break;
  }
  return result;
}

int Level = 0;

// Основная процедура выполняет рекурсивный просмотр структуры папок, начиная с данной.
// Она выводит имена элементов, попутно отслеживая отступы.
void ShowFolder( LPSHELLFOLDER folder )
{
  LPITEMIDLIST pidlChild;
  STRRET Value;
  LPENUMIDLIST Iterator;
  ULONG celtFetched;
  LPSHELLFOLDER child;

  hr = folder->EnumObjects( NULL /* no owner window */, SHCONTF_FOLDERS | SHCONTF_INCLUDEHIDDEN, &Iterator );
  if( SUCCEEDED( hr ) )
  __try
  {
    Level++;
    for(;;)
    {
      hr = Iterator->Next( 1, &pidlChild, &celtFetched );
      if( hr != NOERROR ) break;
      __try
      {
        hr = folder->GetDisplayNameOf( pidlChild, SHGDN_INFOLDER | SHGDN_INCLUDE_NONFILESYS, &Value );
        if( SUCCEEDED( hr ) )
        {
          char * s = GetDisplayName( pidlChild, Value );
          WriteChar( ' ', Level );
          WritelnStr( s );
          free( reinterpret_cast( s ) );
        }
        hr = folder->BindToObject( pidlChild, NULL, IID_IShellFolder, (void**)&child );
        if( SUCCEEDED( hr ) )
        __try
        {
          ShowFolder( child );
        }
        __finally
        {
          child->Release();
        }
      }
      __finally
      {
        pMalloc->Free( pidlChild );
      }
    }
    Level--;
  }
  __finally
  {
    Iterator->Release();
  }
}

LPSHELLFOLDER desktop = NULL;
ITEMIDLIST itemidlist = { { 0 } };
LPITEMIDLIST pidlItself = & itemidlist; // This pidl now points to an empty Identifier List.
                                        // It is point to owner folder itself.
                                        // NB: It works only for a root folder!
STRRET Value;

// Основное тело программы выполняет необходимую инициализацию, затем
// восстанавливает имя корневой папки, выводит его, и обращается к ShowFolder для выполнения рекурсии.
void main( int argc, char *argv[])
{
  hr = CoInitializeEx( NULL, COINIT_MULTITHREADED );
  if( SUCCEEDED( hr ) )
  __try
  {
    hr = SHGetMalloc( &pMalloc );
    if( SUCCEEDED( hr ) )
    __try
    {
      hr = SHGetDesktopFolder( &desktop );
      if( SUCCEEDED( hr ) )
      __try
      {
        hr = desktop->GetDisplayNameOf( pidlItself, SHGDN_NORMAL | SHGDN_INCLUDE_NONFILESYS, &Value );
        if( SUCCEEDED( hr ) )
        {
          char * sTempName = GetDisplayName( pidlItself, Value );
          WritelnStr( sTempName );
          free( reinterpret_cast(sTempName) );
        }
        ShowFolder( desktop );
      }
      __finally
      {
        desktop->Release();
      }
    }
    __finally
    {
      pMalloc->Release();
    }
  }
  __finally
  {
    CoUninitialize();
  }
}

// Delphi

program ShellA;

// Это консольное приложение печатает на стандартный вывод дерево папок
// основного пространства им¸н оболочки Windows.

uses
  Windows, ActiveX, ShlObj;

{$APPTYPE CONSOLE}

// Эта процедура производит вывод строки, попутно
// конвертируя е¸ из кодировки ANSI в кодировку OEM.
procedure WriteStr(s: string);
begin
  UniqueString( s );
  CharToOemBuff( PChar(s), PChar(s), Length(s) );
  Write(s);
end;

// Эта процедура производит вывод указанного
// количества символов, попутно конвертируя их из кодировки ANSI
// в кодировку OEM.
procedure WriteChars(Ch: char; Count: Integer);
var
  s: string;
begin
  CharToOemBuff( @Ch, @Ch, 1 );
  s := StringOfChar(Ch, Count);
  Write( s );
end;

// Эта процедура производит вывод строки, попутно
// конвертируя е¸ из кодировки ANSI в кодировку OEM.
// Эта процедура также добавляет перевод каретки по окончании вывода.
procedure WritelnStr(const s: string);
begin
  WriteStr( s + #13#10 );
end;

var
  pMalloc: IMalloc;
  hr: HRESULT;

// Эта процедура интерпретирует содержание структуры STRRET.
// Также она освобождает временные буфера при необходимости, так что
// для е¸ корректной работы требуется наличие объекта pMalloc.
function GetDisplayName( pidl: PItemIDList; const Value: STRRET ): string;
begin
  with Value do
  case uType of
    STRRET_CSTR: Result := PChar(@cStr[0]);
    STRRET_WSTR:
    begin
      Result := pOleStr;
      pMalloc.Free( pOleStr );
    end;
    STRRET_OFFSET: Result := PChar( LongWord(pidl) + uOffset );
  end;
end;

var
  Level: Integer;

// Основная процедура выполняет рекурсивный просмотр структуры папок, начиная с данной.
// Она выводит имена элементов, попутно отслеживая отступы.
procedure ShowFolder(folder: IShellFolder);
var
  pidlChild: PItemIDList;
  Value: STRRET;
  Iterator: IEnumIDList;
  celtFetched: ULONG;
  child: IShellFolder;
begin
  hr := folder.EnumObjects( 0 (* no owner window *), SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, Iterator );
  if Succeeded( hr ) then
  try
    Inc(Level);
    while true do
    begin
      hr := Iterator.Next( 1, pidlChild, celtFetched );
      if hr <> NOERROR then Break;
      try
        hr := folder.GetDisplayNameOf( pidlChild, SHGDN_INFOLDER or SHGDN_INCLUDE_NONFILESYS, Value );
        if Succeeded( hr ) then
        begin
          WriteChars( ' ', Level );
          WritelnStr( GetDisplayName( pidlChild, Value ) );
        end;
        hr := folder.BindToObject( pidlChild, nil, IID_IShellFolder, Pointer(child) );
        if Succeeded( hr ) then
        try
          ShowFolder( child );
        finally
          child := nil;
        end;
      finally
        pMalloc.Free( pidlChild );
      end;
    end;
    Dec(Level);
  finally
    Iterator := nil;
  end;
end;

var
  desktop: IShellFolder;
  mkid: SHITEMID;
  pidlItself: PItemIDList;
  Value: STRRET;

// Основное тело программы выполняет необходимую инициализацию, затем
// восстанавливает имя корневой папки, выводит его, и обращается к ShowFolder для выполнения рекурсии.
begin
  Level := 0;
  mkid.cb := 0;
  pidlItself := @mkid; // This pidl now points to an empty Identifier List. It is points to owner folder itself.
                       // NB: It works only for a root folder!
  hr := CoInitializeEx( nil, COINIT_MULTITHREADED );
  if Succeeded( hr ) then
  try
    hr := SHGetMalloc( pMalloc );
    if Succeeded( hr ) then
    try
      hr := SHGetDesktopFolder( desktop );
      if Succeeded( hr ) then
      try
        hr := desktop.GetDisplayNameOf( pidlItself, SHGDN_NORMAL or SHGDN_INCLUDE_NONFILESYS, Value );
        if Succeeded( hr ) then
        begin
          WritelnStr( GetDisplayName( pidlItself, Value ) );
        end;
        ShowFolder( desktop );
      finally
        desktop := nil;
      end;
    finally
      pMalloc := nil;
    end;
  finally
    CoUninitialize;
  end;
end.

// C/C++
// Проверка и очистка корзины на локальном диске C:
  SHQueryRBInfo.cbSize = sizeof(SHQUERYRBINFO);
  hr = SHQueryRecycleBin("C:\\", &SHQueryRBInfo);
  if( SUCCEEDED(hr) && (SHQueryRBInfo.i64NumItems > 0) )
  {
    SHEmptyRecycleBin( 0, "C:\\", 0 );
  }

// Delphi
// Данные типы и методы не описаны в ShlObj.Pas,
//  поэтому опишем их сами.
type
  SHQUERYRBINFO = record
    cbSize: DWORD;
    i64Size: Int64;
    i64NumItems: Int64;
  end;
  LPSHQUERYRBINFO = ^SHQUERYRBINFO;
  TSHQueryRBInfo = SHQUERYRBINFO;

const
  shell32 = 'shell32.dll';

function SHQueryRecycleBinA(pszRootPath: PAnsiChar;
  var pSHQueryRBInfo: TSHQueryRBInfo): HResult; stdcall;
  external shell32 name 'SHQueryRecycleBinA';
function SHQueryRecycleBinW(pszRootPath: PWideChar;
  var pSHQueryRBInfo: TSHQueryRBInfo): HResult; stdcall;
  external shell32 name 'SHQueryRecycleBinW';
function SHQueryRecycleBin(pszRootPath: PChar;
  var pSHQueryRBInfo: TSHQueryRBInfo): HResult; stdcall;
  external shell32 name 'SHQueryRecycleBinA';

function SHEmptyRecycleBinA(hWnd: HWND;
  pszRootPath: PAnsiChar; dwFlags: DWORD): HResult; stdcall;
  external shell32 name 'SHEmptyRecycleBinA';
function SHEmptyRecycleBinW(hWnd: HWND;
  pszRootPath: PWideChar; dwFlags: DWORD): HResult; stdcall;
  external shell32 name 'SHEmptyRecycleBinW';
function SHEmptyRecycleBin(hWnd: HWND;
  pszRootPath: PChar; dwFlags: DWORD): HResult; stdcall;
  external shell32 name 'SHEmptyRecycleBinA';

// Проверка и очистка корзины на локальном диске C:
  SHQueryRBInfo.cbSize := sizeof(TSHQueryRBInfo);
  hr := SHQueryRecycleBin(PChar('C:\'), SHQueryRBInfo);
  if Succeeded(hr) and (SHQueryRBInfo.i64NumItems > 0) then
  begin
    SHEmptyRecycleBin( Self.Handle, PChar('C:\'), 0 );
  end;

/
/ C++

#define _WIN32_DCOM

#include 
#include 

// Это приложение выводит на экран
// окно свойств "Мой компьютер".

HRESULT hr;
LPMALLOC pMalloc = NULL;
LPSHELLFOLDER desktop = NULL;
LPCONTEXTMENU mnu = NULL;
LPITEMIDLIST pidlDrives = NULL;
CMINVOKECOMMANDINFO cmd;

void main( int argc, char *argv[])
{
  hr = CoInitializeEx( NULL, COINIT_MULTITHREADED );
  if( SUCCEEDED( hr ) )
  __try
  {
    hr = SHGetMalloc( &pMalloc );
    if( SUCCEEDED( hr ) )
    __try
    {
      hr = SHGetDesktopFolder( &desktop );
      if( SUCCEEDED( hr ) )
      __try
      {
        hr = SHGetSpecialFolderLocation( NULL, CSIDL_DRIVES, &pidlDrives );
        if( SUCCEEDED( hr ) )
        __try
        {
          hr = desktop->GetUIObjectOf( NULL, 1, const_cast(&pidlDrives), IID_IContextMenu, NULL, (void**) &mnu );
          if( SUCCEEDED( hr ) )
          __try
          {
            memset( & cmd, 0, sizeof( cmd ) );
            cmd.cbSize = sizeof( cmd );
            cmd.fMask = 0;
            cmd.hwnd = 0;
            cmd.lpVerb = "Properties";
            cmd.nShow = SW_SHOWNORMAL;
            hr = mnu->InvokeCommand( & cmd );
          }
          __finally
          {
            mnu->Release();
          }
        }
        __finally
        {
          pMalloc->Free( pidlDrives );
        }
      }
      __finally
      {
        desktop->Release();
      }
    }
    __finally
    {
      pMalloc->Release();
    }
  }
  __finally
  {
    CoUninitialize();
  }
}

// Delphi

program ShellB;

// Это приложение выводит на экран
// окно свойств "Мой компьютер".

uses
  Windows,
  ActiveX,
  ShlObj;

var
  pMalloc: IMalloc;
  desktop: IShellFolder;
  mnu: IContextMenu;
  hr: HRESULT;
  pidlDrives: PItemIDList;
  cmd: TCMInvokeCommandInfo;
begin
  hr := CoInitializeEx( nil, COINIT_MULTITHREADED );
  if SUCCEEDED( hr ) then
  try
    hr := SHGetMalloc( pMalloc );
    if SUCCEEDED( hr ) then
    try
      hr := SHGetDesktopFolder( desktop );
      if SUCCEEDED( hr ) then
      try
        hr := SHGetSpecialFolderLocation( 0, CSIDL_DRIVES, pidlDrives );
        if SUCCEEDED( hr ) then
        try
          hr := desktop.GetUIObjectOf( 0, 1, pidlDrives, IContextMenu, nil, Pointer(mnu) );
          if SUCCEEDED( hr ) then
          try
            FillMemory( @cmd, sizeof(cmd), 0 );
            with cmd do
            begin
              cbSize := sizeof( cmd );
              fMask := 0;
              hwnd := 0;
              lpVerb := PChar( 'Properties' );
              nShow := SW_SHOWNORMAL;
            end;
            hr := mnu.InvokeCommand( cmd );
          finally
            mnu := nil;
          end;
        finally
          pMalloc.Free( pidlDrives );
        end;
      finally
        desktop := nil;
      end;
    finally
      pMalloc := nil;
    end;
  finally
    CoUninitialize;
  end;
end.