请问如何将指定的文件夹创建一个桌面快捷方式?
请问如何将指定的文件夹创建一个桌面快捷方式?
[解决办法]
找到个源码
http://blog.csdn.net/aroc_lo/article/details/4875832
[解决办法]
*.pas 文件
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ActiveX, ShlObj, ComObj, ComCtrls, Registry,TypInfo;type TShellFolder=(sfDesktop,sfFavorites,sfFonts,sfPersonal,sfPrograms,sfRecent, sfSendTo,sfStartMenu,sfStartup,sfTemplates); TForm1 = class(TForm) Button1: TButton; txtFile: TEdit; txtDescription: TEdit; txtWorkingDirectory: TEdit; txtArguments: TEdit; txtIconLocation: TEdit; HotKey1: THotKey; cbxWinState: TComboBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; cbxFolders: TComboBox; Label8: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;const ShellFolderKeys:array[TShellFolder] of string=('Desktop','Favorites','Fonts', 'Personal','Programs','Recent','SendTo','Start Menu','Startup','Templates'); Folder_Key='Software\Microsoft\Windows\CurrentVersion\Explorer'; IID_IPersistFile: TGUID =(D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46)); WinStates:array[TWindowState] of integer=(SW_SHOWNORMAL,SW_SHOWMINNOACTIVE,SW_SHOWMAXIMIZED);var Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);var Psl : IShellLink; Ppf : IPersistFile; sFileName:string; wFileName: array[0..MAX_PATH] OF WideChar;begin if Failed(CoCreateInstance(CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,IID_IShellLinkA,Psl)) then raise Exception.Create('Create ShellLink object failed'); Psl.SetPath(pchar(txtFile.Text)); Psl.SetDescription(pchar(txtDescription.Text)); Psl.SetWorkingDirectory(pchar(txtWorkingDirectory.Text)); Psl.SetArguments(pchar(txtArguments.Text)); Psl.SetIconLocation(pchar(txtIconLocation.Text),0); Psl.SetHotkey(HotKey1.HotKey); Psl.SetShowCmd(WinStates[TWindowState(cbxWinState.ItemIndex)]); if Failed(Psl.QueryInterface(IID_IPersistFile,Ppf)) then raise Exception.Create('Error in Query interface'); sFileName:=ChangeFileExt(ExtractFileName(txtFile.Text),'.LNK'); with TRegIniFile.Create(Folder_Key) do begin try sFileName := ReadString('Shell Folders',ShellFolderKeys[TShellFolder(cbxFolders.ItemIndex)],'') +'\'+sFileName; finally Free; end; end; // MultiByteToWideChar(CP_ACP,0,pchar(sFileName,-1,wFileName,MAX_PATH); if succeeded(Ppf.Save(stringtoolestr(sFileName),true) ) then showmessage('shortcut link created'); // GetEnumName(end;procedure TForm1.FormCreate(Sender: TObject);var i:integer;begin cbxWinState.Clear; cbxWinState.Items.Add('Normal'); cbxWinState.Items.Add('Minimized'); cbxWinState.Items.Add('Maximized'); cbxWinState.ItemIndex:=0; cbxFolders.Clear; for i:=0 to Length(ShellFolderKeys)-1 do begin cbxFolders.Items.Add(ShellFolderKeys[TShellFolder(i)]); end; cbxFolders.ItemIndex:=0;end;end.
[解决办法]
*.dfm 文件
object Form1: TForm1 Left = 192 Top = 124 Width = 625 Height = 386 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 40 Top = 40 Width = 19 Height = 13 Caption = 'File:' end object Label2: TLabel Left = 40 Top = 64 Width = 56 Height = 13 Caption = 'Description:' end object Label3: TLabel Left = 40 Top = 104 Width = 45 Height = 13 Caption = 'Directory:' end object Label4: TLabel Left = 40 Top = 136 Width = 50 Height = 13 Caption = 'Arguments' end object Label5: TLabel Left = 40 Top = 168 Width = 68 Height = 13 Caption = 'Icon Location:' end object Label6: TLabel Left = 40 Top = 208 Width = 38 Height = 13 Caption = 'Hot Key' end object Label7: TLabel Left = 40 Top = 240 Width = 67 Height = 13 Caption = 'Window State' end object Label8: TLabel Left = 328 Top = 232 Width = 55 Height = 13 Caption = 'Shell Folder' end object Button1: TButton Left = 248 Top = 288 Width = 105 Height = 25 Caption = 'Create ShortCut' TabOrder = 0 OnClick = Button1Click end object txtFile: TEdit Left = 113 Top = 32 Width = 401 Height = 21 TabOrder = 1 Text = 'txtFile' end object txtDescription: TEdit Left = 113 Top = 65 Width = 241 Height = 21 TabOrder = 2 Text = 'txtDescription' end object txtWorkingDirectory: TEdit Left = 113 Top = 98 Width = 241 Height = 21 TabOrder = 3 Text = 'Edit1' end object txtArguments: TEdit Left = 113 Top = 132 Width = 241 Height = 21 TabOrder = 4 Text = 'Edit1' end object txtIconLocation: TEdit Left = 113 Top = 165 Width = 241 Height = 21 TabOrder = 5 Text = 'Edit1' end object HotKey1: THotKey Left = 112 Top = 200 Width = 121 Height = 19 HotKey = 32833 TabOrder = 6 end object cbxWinState: TComboBox Left = 112 Top = 232 Width = 145 Height = 21 ItemHeight = 13 TabOrder = 7 Text = 'cbxWinState' end object cbxFolders: TComboBox Left = 392 Top = 232 Width = 145 Height = 21 ItemHeight = 13 TabOrder = 8 Text = 'cbxFolders' endend