像操作系统一样新建文件夹
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;