Пример использование методов интерфейса IShellDispatch
01.01.2007
Unit UMain; Interface Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComObj, ActiveX, XPMan; Const CLASS_Shell: TGUID = '{13709620-C279-11CE-A49E-444553540000}'; Type TMainForm = Class(TForm) FolderBtn: TButton; GroupBox1: TGroupBox; OpenBtn: TButton; EdFolder: TEdit; MinAllBtn: TButton; UnMinAllBtn: TButton; RunBtn: TButton; ExitWinBtn: TButton; FindBtn: TButton; CmpFndBtn: TButton; GroupBox2: TGroupBox; DTBtn: TButton; TaskBtn: TButton; Helpbtn: TButton; ApplBtn: TButton; Label1: TLabel; EdAppl: TEdit; procedure FormCreate(Sender: TObject); procedure FolderBtnClick(Sender: TObject); procedure OpenBtnClick(Sender: TObject); procedure MinAllBtnClick(Sender: TObject); procedure UnMinAllBtnClick(Sender: TObject); procedure RunBtnClick(Sender: TObject); procedure ExitWinBtnClick(Sender: TObject); procedure FindBtnClick(Sender: TObject); procedure CmpFndBtnClick(Sender: TObject); procedure HelpbtnClick(Sender: TObject); procedure DTBtnClick(Sender: TObject); procedure TaskBtnClick(Sender: TObject); procedure ApplBtnClick(Sender: TObject); Private { Private declarations } Public { Public declarations } End; FolderItemVerb = Interface(IDispatch) ['{08EC3E00-50B0-11CF-960C-0080C7F4EE85}'] Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function Get_Name: WideString; Safecall; Procedure DoIt; Safecall; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; Property Name: WideString Read Get_Name; End; FolderItemVerbs = Interface(IDispatch) ['{1F8352C0-50B0-11CF-960C-0080C7F4EE85}'] Function Get_Count: Integer; Safecall; Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function Item(index: OleVariant): FolderItemVerb; Safecall; Function _NewEnum: IUnknown; Safecall; Property Count: Integer Read Get_Count; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; End; FolderItem = Interface(IDispatch) ['{FAC32C80-CBE4-11CE-8350-444553540000}'] Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function Get_Name: WideString; Safecall; Procedure Set_Name(Const pbs: WideString); Safecall; Function Get_Path: WideString; Safecall; Function Get_GetLink: IDispatch; Safecall; Function Get_GetFolder: IDispatch; Safecall; Function Get_IsLink: WordBool; Safecall; Function Get_IsFolder: WordBool; Safecall; Function Get_IsFileSystem: WordBool; Safecall; Function Get_IsBrowsable: WordBool; Safecall; Function Get_ModifyDate: TDateTime; Safecall; Procedure Set_ModifyDate(pdt: TDateTime); Safecall; Function Get_Size: Integer; Safecall; Function Get_type_: WideString; Safecall; Function Verbs: FolderItemVerbs; Safecall; Procedure InvokeVerb(vVerb: OleVariant); Safecall; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; Property Name: WideString Read Get_Name Write Set_Name; Property Path: WideString Read Get_Path; Property GetLink: IDispatch Read Get_GetLink; Property GetFolder: IDispatch Read Get_GetFolder; Property IsLink: WordBool Read Get_IsLink; Property IsFolder: WordBool Read Get_IsFolder; Property IsFileSystem: WordBool Read Get_IsFileSystem; Property IsBrowsable: WordBool Read Get_IsBrowsable; Property ModifyDate: TDateTime Read Get_ModifyDate Write Set_ModifyDate; Property Size: Integer Read Get_Size; Property Type_: WideString Read Get_type_; End; FolderItems = Interface(IDispatch) ['{744129E0-CBE5-11CE-8350-444553540000}'] Function Get_Count: Integer; Safecall; Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function Item(Index: OleVariant): FolderItem; Safecall; Function _NewEnum: IUnknown; Safecall; Property Count: Integer Read Get_Count; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; End; Folder = Interface(IDispatch) ['{BBCBDE60-C3FF-11CE-8350-444553540000}'] Function Get_Title: WideString; Safecall; Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function Get_ParentFolder: Folder; Safecall; Function Items: FolderItems; Safecall; Function ParseName(Const bName: WideString): FolderItem; Safecall; Procedure NewFolder(Const bName: WideString; vOptions: OleVariant); Safecall; Procedure MoveHere(vItem: OleVariant; vOptions: OleVariant); Safecall; Procedure CopyHere(vItem: OleVariant; vOptions: OleVariant); Safecall; Function GetDetailsOf(vItem: OleVariant; iColumn: SYSINT): WideString; Safecall; Property Title: WideString Read Get_Title; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; Property ParentFolder: Folder Read Get_ParentFolder; End; IShellDispatch = Interface(IDispatch) ['{D8F015C0-C278-11CE-A49E-444553540000}'] Function Get_Application: IDispatch; Safecall; Function Get_Parent: IDispatch; Safecall; Function NameSpace(vDir: OleVariant): Folder; Safecall; Function BrowseForFolder(Hwnd: Integer; Const Title: WideString; Options: Integer; RootFolder: OleVariant): Folder; Safecall; Function Windows: IDispatch; Safecall; Procedure Open(vDir: OleVariant); Safecall; Procedure Explore(vDir: OleVariant); Safecall; Procedure MinimizeAll; Safecall; Procedure UndoMinimizeALL; Safecall; Procedure FileRun; Safecall; Procedure CascadeWindows; Safecall; Procedure TileVertically; Safecall; Procedure TileHorizontally; Safecall; Procedure ShutdownWindows; Safecall; Procedure Suspend; Safecall; Procedure EjectPC; Safecall; Procedure SetTime; Safecall; Procedure TrayProperties; Safecall; Procedure Help; Safecall; Procedure FindFiles; Safecall; Procedure FindComputer; Safecall; Procedure RefreshMenu; Safecall; Procedure ControlPanelItem(Const szDir: WideString); Safecall; Property Application: IDispatch Read Get_Application; Property Parent: IDispatch Read Get_Parent; End; CoShell = Class Class Function Create: IShellDispatch; Class Function CreateRemote(Const MachineName: String): IShellDispatch; End; Var MainForm: TMainForm; I: IShellDispatch; Implementation {$R *.dfm} { CoShell } Class Function CoShell.Create: IShellDispatch; Begin Result := CreateComObject(CLASS_Shell) As IShellDispatch; End; Class Function CoShell.CreateRemote(Const MachineName: String): IShellDispatch; Begin Result := CreateRemoteComObject(MachineName, CLASS_Shell) As IShellDispatch; End; Procedure TMainForm.FormCreate(Sender: TObject); Begin I := CoShell.Create; End; Procedure TMainForm.FolderBtnClick(Sender: TObject); Var F: Folder; Begin { Работа с папкой } F := I.BrowseForFolder(Handle, 'IShellDispatch example', 0, 0); If F = NIL Then Exit; If F.ParentFolder <> NIL Then Begin { Показ имени родительской папки } ShowMessage(F.ParentFolder.Title); { Показ количества дочерних папок } ShowMessage(IntToStr(F.Items.Count)); End; End; Procedure TMainForm.OpenBtnClick(Sender: TObject); Begin { Открытие папки } Try I.Explore(EdFolder.Text); Except Exit; End; End; Procedure TMainForm.MinAllBtnClick(Sender: TObject); Begin { Свернуть все окна } I.MinimizeAll; End; procedure TMainForm.UnMinAllBtnClick(Sender: TObject); Begin I.UndoMinimizeALL; End; Procedure TMainForm.RunBtnClick(Sender: TObject); Begin { Окно "Выполнить..." } I.FileRun; End; Procedure TMainForm.ExitWinBtnClick(Sender: TObject); Begin { Выключить Windows } I.ShutdownWindows; End; Procedure TMainForm.FindBtnClick(Sender: TObject); Begin { Поиск } I.FindFiles; End; Procedure TMainForm.CmpFndBtnClick(Sender: TObject); Begin { Поиск компьютеров } I.FindComputer; End; Procedure TMainForm.HelpbtnClick(Sender: TObject); Begin { Вызов справки } I.Help; End; Procedure TMainForm.DTBtnClick(Sender: TObject); Begin { Апплет: дата/время } I.SetTime; End; Procedure TMainForm.TaskBtnClick(Sender: TObject); Begin { Апплет: панель задач } I.TrayProperties; End; Procedure TMainForm.ApplBtnClick(Sender: TObject); Begin { Запуск своего апплета } I.ControlPanelItem(EdAppl.Text); End; End.
Взято с Vingrad.ru https://forum.vingrad.ru