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

Пример использование методов интерфейса 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.
Автор: Rrader Взято с Vingrad.ru http://forum.vingrad.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...