像操作系统一样新建文件夹

 

uses comobj, shlobj;

function GetShellFolderFromPath(owner: IShellFolder;
  path: string): IShellFolder;
var
  P: PWideChar;
  folder: IShellFolder;
  NewPIDL: PItemIDList;
  NumChars, Flags, HR: LongWord;

begin
  P := StringToOleStr(path);
  NumChars := Length(path);
  OleCheck(owner.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));
  OleCheck(owner.BindToObject(NewPIDL, nil, IShellFolder, folder));

  Result := folder;
end;

procedure ExecuteContextMenuCommand(cm: IContextMenu; cmd: string);
var
  menu: HMENU;
  ci: TCMInvokeCommandInfo;
  // rt:TRect;
begin
  menu := CreatePopupMenu;
  OleCheck(cm.QueryContextMenu(menu, 0, 0, 99999, CMF_NORMAL));
  // TrackPopupMenu   (menu,TPM_RETURNCMD   or   TPM_LEFTALIGN,200,200,   0,Handle,@rt);
  DestroyMenu(menu);

  FillChar(ci, sizeof(ci), #0);
  ci.cbSize := sizeof(ci);
  ci.lpVerb := pchar(cmd);
  OleCheck(cm.InvokeCommand(ci));

end;

//调用例子
procedure TForm1.Button1Click(Sender: TObject);
var
  folder: IShellFolder;
  view: IShellView;
  cm: IContextMenu;
  desk: IShellFolder;

begin
  //
  OleCheck(SHGetDesktopFolder(desk));
  folder := GetShellFolderFromPath(desk, 'D:\tmp2 ');
  OleCheck(folder.CreateViewObject(Handle, IShellView, view));
  OleCheck(view.GetItemObject(SVGIO_BACKGROUND, IContextMenu, pointer(cm)));
  ExecuteContextMenuCommand(cm, 'NewFolder ');

end;