打印本文 打印本文 关闭窗口 关闭窗口
利用Delphi编写Windows外壳扩展
作者:武汉SEO闵涛  文章来源:敏韬网  点击数2213  更新时间:2009/4/23 18:26:01  文章录入:mintao  责任编辑:mintao
nbsp;  else begin
      DeleteRegKey(''''*\shellex\ContextMenuHandlers\FileOpreation'''');
      inherited UpdateRegistry(Register);
   end;
end;

 

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] 

打印本文 打印本文 关闭窗口 关闭窗口