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