开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
ShCutF.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：2k
源码类别：

Delphi控件源码

开发平台：

Delphi

ShCutF.pas：源码内容
  1. unit ShCutF;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     EditName: TEdit;
  13.     Label1: TLabel;
  14.     Button2: TButton;
  15.     GroupBox1: TGroupBox;
  16.     cbDir: TCheckBox;
  17.     cbDesktop: TCheckBox;
  18.     cbStartMenu: TCheckBox;
  19.     procedure Button1Click(Sender: TObject);
  20.     procedure Button2Click(Sender: TObject);
  21.   private
  22.     { Private declarations }
  23.   public
  24.     { Public declarations }
  25.   end;
  27. var
  28.   Form1: TForm1;
  30. implementation
  32. {$R *.DFM}
  34. uses
  35.   ComObj, ActiveX, ShlObj, Registry;
  37. procedure TForm1.Button1Click(Sender: TObject);
  38. var
  39.   AnObj: IUnknown;
  40.   ShLink: IShellLink;
  41.   PFile: IPersistFile;
  42.   FileName: string;
  43.   WFileName: WideString;
  44.   Reg: TRegIniFile;
  45. begin
  46.   // access to the two interfaces of the object
  47.   AnObj := CreateComObject (CLSID_ShellLink);
  48.   ShLink := AnObj as IShellLink;
  49.   PFile := AnObj as IPersistFile;
  50.   // get the name of the application file
  51.   FileName := ParamStr (0);
  52.   // set the link properties
  53.   ShLink.SetPath (PChar (FileName));
  54.   ShLink.SetWorkingDirectory (PChar (
  55.     ExtractFilePath (FileName)));
  57.   // save the file in the current dir
  58.   if cbDir.Checked then
  59.   begin
  60.     // using a WideString
  61.     WFileName := ExtractFilePath (FileName) +
  62.       EditName.Text + '.lnk';
  63.     PFile.Save (PWChar (WFileName), False);
  64.   end;
  66.   // save on the desktop
  67.   if cbDesktop.Checked then
  68.   begin
  69.     Reg := TRegIniFile.Create(
  70.       'SoftwareMicroSoftWindowsCurrentVersionExplorer');
  71.     WFileName := Reg.ReadString ('Shell Folders', 'Desktop', '') +
  72.       '' + EditName.Text + '.lnk';
  73.     Reg.Free;
  74.     PFile.Save (PWChar (WFileName), False);
  75.   end;
  77.   // save in the Start Menu
  78.   if cbStartMenu.Checked then
  79.   begin
  80.     Reg := TRegIniFile.Create(
  81.       'SoftwareMicroSoftWindowsCurrentVersionExplorer');
  82.     WFileName := Reg.ReadString ('Shell Folders', 'Start Menu', '') +
  83.       '' + EditName.Text + '.lnk';
  84.     Reg.Free;
  85.     PFile.Save (PWChar (WFileName), False);
  86.   end;
  87. end;
  89. // add a document to the Start menu documents list
  90. procedure TForm1.Button2Click(Sender: TObject);
  91. var
  92.   ProjectFile: string;
  93. begin
  94.   ProjectFile := ChangeFileExt (ParamStr (0), '.dpr');
  95.   SHAddToRecentDocs (SHARD_PATH, PChar(ProjectFile));
  96. end;
  98. end.