Пример использование методов интерфейса IShellDispatch

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.
Author: Rrader
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04338
Category:COM