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