一个添加用户自定义任务的单元

前几天折腾了一下win7的优化, 用了魔方这个软件, 发现他在快速启动里会创建一系列的任务对象

查了一下资料, 发现从vista开始, windows新的任务栏支持在按钮或者开始菜单里的快速启动可以添加一些用户自定义任务

于是自己尝试写了一个单元出来, 专门添加这种自定义任务

    

代码如下:

program Project1;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1},
  UserTasks in 'UserTasks.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  if ParamCount > 0 then
    MessageBox(0, PChar(ParamStr(1)), '启动参数', MB_OK)
  else
    Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  UserTasks;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  UserTaskManager.Clear;
  for i := 0 to Memo1.Lines.Count - 1 do
    UserTaskManager.Add(Memo1.Lines[i], Memo1.Lines[i]);
  UserTaskManager.Commit;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  UserTaskManager.Clear;
  UserTaskManager.Commit;
end;

end.

unit UserTasks;

(*

给程序添加用户自定义任务
适用 Vista或者更高版本Windows系统
执行后, 在任务栏或者开始菜单快速启动里增加带参数启动项

Demo:

  with UserTaskManager do
  begin
    Clear;
    Add('启动参数1', '自定义任务1');
    Add('启动参数2', '自定义任务2');
    Add('启动参数3', '自定义任务3');
    Commit;
  end;

2013-11-7 堕落恶魔

如果有修改, 希望能够将代码同步邮件给我, 谢谢
hs_kill_god@hotmail.com

*)

interface

uses
  Classes, ShlObj, ObjectArray, ComObj, Activex;

type
  {自定义任务对象}
  TUTaskItem = class
  private
    FParam: string; {启动参数}
    FTitle: string; {任务名称}
  protected
    constructor Create;
  public
    property Param: string read FParam write FParam;
    property Title: string read FTitle write FTitle;
  end;

  {用户任务管理对象}
  TUserTaskManager = class
  private
    FList: TList;
    function GetCount: Integer;
    function GetItem(AIndex: Integer): TUTaskItem;
  protected
    constructor Create;
    destructor Destroy; override;
  public
    property Count: Integer read GetCount; {数量}
    property Items[AIndex: Integer]: TUTaskItem read GetItem; default;
    procedure Delete(AIndex: Integer);
    procedure Insert(AIndex: Integer; AParam, ATitle: string);
    procedure Add(AParam, ATitle: string);
    procedure Clear;
    function Commit: Boolean; {提交}
  end;

function UserTaskManager: TUserTaskManager;

implementation

var
  FUserTaskManager: TUserTaskManager;
  FPKID: TGUID;


function UserTaskManager: TUserTaskManager;
begin
  if FUserTaskManager = nil then
    FUserTaskManager := TUserTaskManager.Create;
  Result := FUserTaskManager;
end;

{ TUserTasks }

procedure TUserTaskManager.Add(AParam, ATitle: string);
begin
  Insert(-1, AParam, ATitle);
end;

function TUserTaskManager.Commit: Boolean;

  function _CreateShellLink(AArgument, ATitle: string): IShellLink;
  var
    nSL: IShellLink;
    nPS: IPropertyStore;
    nPV: PROPVARIANT;
    nPK: PROPERTYKEY;
    nHR: HRESULT;
    nFilePath: PChar;
  begin
    nSL := CreateComObject(CLSID_ShellLink) as IShellLink;
    nFilePath := PChar(ParamStr(0));
    Result := nil;
    if not Succeeded(nSL.SetPath(nFilePath)) then
      Exit;

    if not Succeeded(nSL.SetArguments(PChar(AArgument))) then
      Exit;
    if not Succeeded(nSL.SetIconLocation(nFilePath, 0)) then
      Exit;
    if not Succeeded(nSL.SetDescription(PChar(ATitle))) then
      Exit;

    nPS := nSL as IPropertyStore;
    nPV.vt := VT_LPWSTR;
    nPV.pwszVal := PChar(ATitle);
    nPK.fmtid := FPKID;
    nPK.pid := 2;
(*    nPS.GetValue(nPK, nPV);*)
    if Succeeded(nPS.SetValue(nPK, nPV)) then
    begin
      nPS.Commit;
      Result := nSL;
    end
  end;

var
  nOA, nOAR: IObjectArray;
  nMaxSlots: UInt32;
  nSL: IShellLink;
  nCDL: ICustomDestinationList;
  nOC: IObjectCollection;
  i: Integer;
  nItem: TUTaskItem;
begin
  Result := False;
  nCDL := CreateComObject(CLSID_DestinationList) as ICustomDestinationList;
  if not Succeeded(nCDL.BeginList(nMaxSlots, IID_IObjectArray, nOAR)) then
    Exit;

  if FList.Count > 0 then
  begin
    nOC := CreateComObject(CLSID_EnumerableObjectCollection) as IObjectCollection;
    for i := 0 to FList.Count - 1 do
    begin
      nItem := FList[i];
      if nItem = nil then
        Continue;
      nSL := _CreateShellLink(nItem.Param, nItem.Title);
      if nSL <> nil then
        nOC.AddObject(nSL);
    end;

    nOA := nOC as IObjectArray;
    if Succeeded(nCDL.AddUserTasks(nOA)) then
      nOA := nil;
  end;

  Result := Succeeded(nCDL.CommitList);
end;

procedure TUserTaskManager.Clear;
var
  i: Integer;
begin
  for i := 0 to FList.Count - 1 do
  try
    if FList[i] <> nil then
    begin
      TUTaskItem(FList[i]).Free;
      FList[i] := nil;
    end;
  except
  end;
  FList.Clear;
end;

constructor TUserTaskManager.Create;
begin
  FList := TList.Create;
end;

procedure TUserTaskManager.Delete(AIndex: Integer);
var
  nItem: TUTaskItem;
begin
  if (AIndex > -1) and (AIndex < FList.Count) then
  begin
    nItem := FList[AIndex];
    FList.Delete(AIndex);
    nItem.Free;
  end;
end;

destructor TUserTaskManager.Destroy;
begin
  Clear;
  FList.Free;
  FList := nil;
end;

function TUserTaskManager.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TUserTaskManager.GetItem(AIndex: Integer): TUTaskItem;
begin
  if (AIndex > -1) and (AIndex < FList.Count) then
    Result := FList[AIndex]
  else
  Result := nil;
end;

procedure TUserTaskManager.Insert(AIndex: Integer; AParam, ATitle: string);
var
  nItem: TUTaskItem;
begin
  nItem := TUTaskItem.Create;
  nItem.Param := AParam;
  nItem.Title := ATitle;
  if AIndex = -1 then
    FList.Add(nItem)
  else
    FList.Insert(AIndex, nItem);
end;

{ TUTaskItem }

constructor TUTaskItem.Create;
begin
  FParam := '';
  FTitle := '';
end;

initialization
  FPKID := StringToGUID('{F29F85E0-4FF9-1068-AB91-08002B27B3D9}');

finalization
  if FUserTaskManager <> nil then
  begin
    FUserTaskManager.Free;
    FUserTaskManager := nil;
  end;

end.