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

Материал из DRKB


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