Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Пример использование методов интерфейса 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.

Автор: Rrader

Взято с Vingrad.ru https://forum.vingrad.ru