unit1.~pas

《Delphi 7应用编程150例》源码（全）

unit Unit1;

interface

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

type
  TfrmMain = class(TForm)
    btnDesktop: TButton;
    btnProgram: TButton;
    btnStartup: TButton;
    procedure btnDesktopClick(Sender: TObject);
    procedure btnStartupClick(Sender: TObject);
    procedure btnProgramClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  tmpObject : IUnknown;
  tmpSLink : IShellLink;
  tmpPFile : IPersistFile;
  PIDL : PItemIDList;
  StartupDirectory : array[0..MAX_PATH] of Char;
  LinkFilename : WideString;

implementation

{$R *.dfm}

procedure TfrmMain.btnDesktopClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
    //获得桌面的ItemIDList
    Fillchar(StartupDirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    //获得路径
    LinkFilename := StartupDirectory + '\Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
    //保存*.lnk文件
end;

procedure TfrmMain.btnStartupClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,CSIDL_STARTUP,PIDL);
    Fillchar(startupdirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    LinkFilename := StartupDirectory + '\Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
end;

procedure TfrmMain.btnProgramClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,  CSIDL_PROGRAMS,PIDL);
    Fillchar(startupdirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    if not DirectoryExists(StartupDirectory+'\Delphi') then
    begin
        MkDir(StartupDirectory+'\Delphi');
    end;
    LinkFilename := StartupDirectory + '\Delphi\Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    tmpObject := CreateComObject(CLSID_ShellLink);
    //创建建立快捷方式的外壳扩展
    tmpSLink := tmpObject as IShellLink;
    //取得接口
    tmpPFile := tmpObject as IPersistFile;
    //用来储存*.lnk文件的接口
    tmpSLink.SetPath(pChar(Application.ExeName));
    //设定程序所在路径
    tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(Application.ExeName)));
    //设定工作目录
end;

end.