利用Delphi编写Windows外壳扩展

initialization
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
   '''''''', ''''Context Menu Shell Extension'''', ciMultiInstance,tmApartment);

end.

    在OpWindow窗口中加入一个TListBox控件和两个TButton控件，OpWindows.pas的程序清单如下：
unit opwindow;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    FileList:TStringList;
    { Public declarations }
  end;

var
   Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FileList:=TStringList.Create;
  Button1.Caption :=''''复制文件'''';
  Button2.Caption :=''''移动文件'''';
  Self.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FileList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sPath:string;
  fsTemp:SHFILEOPSTRUCT;
  i:integer;
begin
  sPath:=InputBox(''''文件操作'''',''''输入复制路径'''',''''c:\windows'''');
  if sPath<>''''''''then begin
    fsTemp.Wnd := Self.Handle;
    file://设置文件操作类型
    fsTemp.wFunc :=FO_COPY;
    file://允许执行撤消操作
    fsTemp.fFlags :=FOF_ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count-1 do begin
      file://源文件全路径名
      fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
      file://要复制到的路径
      fsTemp.pTo := PChar(sPath);
      fsTemp.lpszProgressTitle:=''''拷贝文件'''';
      if SHFileOperation(fsTemp)<>0 then
        ShowMessage(''''文件复制失败'''');
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  sPath:string;
  fsTemp:SHFILEOPSTRUCT;
  i:integer;
begin
  sPath:=InputBox(''''文件操作'''',''''输入移动路径'''',''''c:\windows'''');
  if sPath<>''''''''then begin
    fsTemp.Wnd := Self.Handle;
    fsTemp.wFunc :=FO_MOVE;
    fsTemp.fFlags :=FOF_ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count-1 do begin
      fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
      fsTemp.pTo := PChar(sPath);
      fsTemp.lpszProgressTitle:=''''移动文件'''';
      if SHFileOperation(fsTemp)<>0 then
        ShowMessage(''''文件复制失败'''');
    end;
  end;
end;

end.

    点击菜单的 Project | Build ContextMenu 项，Delphi就会建立Contextmenu.dll文件，这个就是上下文相关菜单程序了。
使用，Regsvr32.exe 注册程序，然后在Windows的Explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会
多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者
移动文件按钮执行文件操作。

上一页  [1] [2] 

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18