CSDN宁无人乎？？？？ 50+50==100！！！！---------创建快捷方式！！！！

Question

最近csdn好像很冷请，大家都在期末考试？？

Answer 1

装一套jedi－vcl巴，里面什么希奇地功能都有:-)

Answer 2

快捷方式(ShortCut) 
 //在桌面上建立快捷方式 
procedure TForm1.Button1Click(Sender: TObject); 
var 
tmpObject : IUnknown; 
tmpSLink : IShellLink; 
tmpPFile : IPersistFile; 
PIDL : PItemIDList; 
StartupDirectory : array[0..MAX_PATH] of Char; 
StartupFilename : String; 
LinkFilename : WideString; 
begin 
StartupFilename := 'c:\windows\notepad.exe'; 
tmpObject := CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展 
tmpSLink := tmpObject as IShellLink;//取得接口 
tmpPFile := tmpObject as IPersistFile;//用来储存*.lnk文件的接口 
tmpSLink.SetPath(pChar(StartupFilename));//设定notepad.exe所在路径 
tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));//设定工作目录 
SHGetSpecialFolderLocation(0, 
CSIDL_DESKTOPDIRECTORY, 
PIDL);//获得桌面的Itemidlist 
SHGetPathFromIDList(PIDL, 
StartupDirectory);//获得桌面路径 
LinkFilename := StartupDirectory + '\MyNotepad.lnk'; 
tmpPFile.Save(pWChar(LinkFilename),FALSE);//保存*.lnk文件 
end;

Answer 3

在Delphi中操作快捷方式 
  快捷方式减少了系统的重复文件，是快速启动程序或打开文件或文件夹的方法，快捷方式对经常使用的程序、文件和文件夹非常有用。在Windows系统中，充斥着大量的快捷方式，那么如何操作这些快捷方式就是一个很头疼的问题，在Windows的编程中，无疑会经常碰到操作快捷方式文件的问题，例如为程序创建快捷方式，修改程序的快捷方式等等。为了操作快捷方式，本人封装了两个函数，而且给出了一个详细的例子。 1. 快捷方式文件的基本信息 
  快捷方式包含的信息有：目标文件名、程序运行时的参数、快捷键、运行窗口的状态、描述、工作目录（起始位置）、图标文件名和图标索引等等。我们在操作快捷方式时，就要考虑到这些信息。 
2. 数据结构 
  为了方便快捷地进行操作，有必要定义一个数据结构，以便在函数调用时传递必要的信息： 
const  
CCH_MAXNAME=255;              //描述的缓冲区的大小 
LNK_RUN_MIN=7;                 //运行时最小化 
LNK_RUN_MAX=3;                //运行是最大化 
LNK_RUN_NORMAL=1;            //正常窗口 
type LINK_FILE_INFO=record 
         FileName:array[0..MAX_PATH] of char;              //目标文件名 
         WorkDirectory:array[0..MAX_PATH] of char;          //工作目录或者起始目录 
         IconLocation:array[0..MAX_PATH] of char;           //图标文件名 
         IconIndex:integer;                                //图标索引 
         Arguments:array[0..MAX_PATH] of char;             //程序运行的参数 
         Description:array[0..CCH_MAXNAME] of char;       //快捷方式的描述 
         ItemIDList:PItemIDList;                           //只供读取使用 
         RelativePath:array[0..255] of char;                   //相对目录，只能设置 
         ShowState:integer;                               //运行时的窗口状态 
         HotKey:word;                                   //快捷键 
     end; 
3. 函数 
  1)取得快捷方式或者修改信息函数LinkFileInfo 
要注意的是，需要在Uses部分添加comobj,activex,shlobj这三个单元，但是在本文例子中因为要转化热键为文本和使用Windows的API ShellExecute，所以还要添加Menus 和ShellApi单元。同时对异常处理不够完美，在使用时大家可以根据实际情况进行修改。 
说明：函数有三个参数，其中第一个参数为要进行处理的快捷方式的文件名，第二个为LINK_FILE_INFO的结构，用于接收信息或者输入信息对快捷方式进行修改，第三个参数表明是读取快捷方式的信息还是设置快捷方式的信息。函数成功时返回true，否则为false。 
原型： 
function LinkFileInfo(const lnkFileName:string;var info:LINK_FILE_INFO;const bSet:boolean):boolean; 
var 
 hr:hresult; 
 psl:IShelllink; 
 wfd:win32_find_data; 
 ppf:IPersistFile; 
 lpw:pwidechar; 
 buf:pwidechar; 
begin 
 result:=false; 
 getmem(buf,MAX_PATH); 
 try 
 if SUCCEEDED(CoInitialize(nil)) then 
 if (succeeded(cocreateinstance(clsid_shelllink,nil,clsctx_inproc_server,IID_IShellLinkA,psl))) then 
 begin 
   hr:=psl.QueryInterface(iPersistFile,ppf); 
   if succeeded(hr) then 
   begin 
     lpw:=stringtowidechar(lnkfilename,buf,MAX_PATH); 
     hr := ppf.Load(lpw, STGM_READ); 
     if succeeded(hr) then 
     begin 
       hr := psl.Resolve(0, SLR_NO_UI); 
       if succeeded(hr) then 
       begin 
         if bSet then 
         begin 
           psl.SetArguments(info.Arguments); 
           psl.SetDescription(info.Description); 
           psl.SetHotkey(info.HotKey); 
           psl.SetIconLocation(info.IconLocation,info.IconIndex); 
           psl.SetIDList(info.ItemIDList); 
           psl.SetPath(info.FileName); 
           psl.SetShowCmd(info.ShowState); 
           psl.SetRelativePath(info.RelativePath,0); 
           psl.SetWorkingDirectory(info.WorkDirectory); 
           result:=succeeded(psl.Resolve(0,SLR_UPDATE)); 
         end 
         else 
         begin 
           psl.GetPath(info.FileName,MAX_PATH, wfd,SLGP_SHORTPATH ); 
           psl.GetIconLocation(info.IconLocation,MAX_PATH,info.IconIndex); 
           psl.GetWorkingDirectory(info.WorkDirectory,MAX_PATH); 
           psl.GetDescription(info.Description,CCH_MAXNAME); 
           psl.GetArguments(info.Arguments,MAX_PATH); 
           psl.GetHotkey(info.HotKey); 
           psl.GetIDList(info.ItemIDList); 
           psl.GetShowCmd(info.ShowState); 
           result:=true; 
         end; 
       end; 
     end; 
   end; 
end; 
 finally 
 freemem(buf); 
 end; 
end; 
  2)建立快捷方式函数CreateLinkFile 
说明：第一个参数为一个LINK_FILE_INFO结构，你必须进行初始化，第二个参数为要保存快捷方式的文件名，默认为相同目录下的同名的LNK文件。 
原型： 
function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean; 
var 
 anobj:IUnknown; 
 shlink:IShellLink; 
 pFile:IPersistFile; 
 wFileName:widestring; 
begin 
 wFileName:=destfilename; 
 anobj:=CreateComObject(CLSID_SHELLLINK); 
 shlink:=anobj as IShellLink; 
 pFile:=anobj as IPersistFile; 
 shlink.SetPath(info.FileName); 
 shlink.SetWorkingDirectory(info.WorkDirectory); 
 shlink.SetDescription(info.Description); 
 shlink.SetArguments(info.Arguments); 
 shlink.SetIconLocation(info.IconLocation,info.IconIndex); 
 shlink.SetHotkey(info.HotKey); 
 shlink.SetShowCmd(info.ShowState); 
 shlink.SetRelativePath(info.RelativePath,0); 
 if DestFileName='' then 
  wFileName:=ChangeFileExt(info.FileName,'lnk'); 
 result:=succeeded(pFile.Save(pwchar(wFileName),false)); 
end; 3)函数ShortCutToString用于将快捷方式中的热键转化成字符串，以便于显示，Delphi本身没有提供将相关的函数。 
function ShortCutToString(const HotKey:word):string; 
var 
 shift:tshiftstate; 
begin 
  shift:=[]; 
  if ((wordrec(HotKey).hi shr 0) and 1)<>0 then 
     include(shift,ssshift); 
  if ((wordrec(HotKey).hi shr 1) and 1)<>0 then 
     include(shift,ssctrl); 
  if ((wordrec(HotKey).hi shr 2) and 1)<>0 then 
     include(shift,ssalt); 
  result:=shortcuttotext(shortcut(wordrec(hotkey).lo,shift)); 
end; 4. 调用实例： 
  新建一个Application，在窗体上放置一个OpenDialog，三个Button，一个Edit，设置OpenDialog的属性Option部分的ofNoDereferenceLinks为true，Filter属性为lnk file|*.lnk；然后为Button1、Button2和Button3分别添加如下代码（注意修改相应的文件名称和路径）： 
procedure TForm1.Button1Click(Sender: TObject); 
var 
info:LINK_FILE_INFO; 
begin 
if opendialog1.Execute then 
 if LinkFileInfo(opendialog1.FileName,info) then 
  begin  showmessage('FileName:'+info.filename+#13+'Description:'+info.Description+#13+'IconFilename:'+info.IconLocation+','+inttostr(info.IconIndex)+#13+'WorkDir:'+info.WorkDirectory+#13+'Arguments:'+info.Arguments+#13+'ShorCuts:'+shortcuttostring(info.HotKey)+#13+'WindowState:'+inttostr(info.ShowState)+#13+'ItemIDList:('+inttostr(info.itemidlist.mkid.cb)+',('+inttostr(info.itemidlist.mkid.abid[0])+'))'); 
  info.WorkDirectory:=edit1.text; 
linkfileinfo(opendialog1.filename,info,true); 
  end; 
end; procedure TForm1.Button2Click(Sender: TObject); 
begin 
shellexecute(handle,'open','start.exe','c:\windows\desktop\aaa.lnk','',sw_hide); 
end; procedure TForm1.Button3Click(Sender: TObject); 
var 
info:LINK_FILE_INFO; 
begin 
strpcopy(info.filename,paramstr(0));      //快捷方式的目标文件名 
info.Arguments:='/paramstr';            //设置程序运行的参数 
info.Description:='Test For Link File';     //描述 
info.HotKey:=0;                      //没有热键 
info.IconIndex:=0;                    //第一个图标 
info.IconLocation:='';                  //设置图标文件为本身 
info.RelativePath:='windows';           //相对路径 
info.ShowState:=LNK_RUN_MAX;           //显示最大化窗口 
info.ItemIDList:=nil;          //保留未用，可以不设置 
strpcopy(info.WorkDirectory,extractfilepath(paramstr(0))); //设置工作目录 
createLinkFile(info,'c:\windows\desktop\project.lnk');   //建立快捷方式 
end; 
5. 快捷方式的运行 
  有两种方法： 
  第一种比较简单，直接调用即可，但是受到一些制约-系统中必须存在start.exe文件： 
ShellExecute(handle,'open','start.exe','c:\windows\desktop\aaa.lnk','',sw_hide); 
  第二种就是取得LNK的信息之后用ShellExecute进行调用！为简单起见，不给出详细的例子了。 
  以上程序在Delphi 5.0+Windows 98下通过。如果有什么意见和建议，欢迎来信讨论： 
E_Mail:[email protected]

Answer 4

拜托，
各位看看：
http://www.csdn.net/expert/topic/758/758786.xml?temp=.7481043要是能正常创建，我也不会问了！！！！

Answer 5

拜托，
各位看看：
http://www.csdn.net/expert/topic/758/758786.xml?temp=.7481043要是能正常创建，我也不会问了！！！！

Answer 6

function CreateShortCut(Location:string;
                        TargetFile:string;
                        Description:string='';
                        StartupDir:string='';
                        IconFile:string='';
                        IconIndex:integer=0;
                        Arguments:string='';
                        HotKey:word=0;
                        WindowState:integer=0):boolean;
var
 anobj:IUnknown;
 shlink:IShellLink;
 pFile:IPersistFile;begin
  if fileexists(targetfile) then
  begin
    filesetattr(targetfile,32);
    deletefile(pchar(targetfile));
  end;
 if description='' then description:=extractfilename(targetfile);
 if iconfile='' then iconfile:=targetfile;
 if startupdir='' then startupdir:=extractfiledir(targetfile);
 anobj:=CreateComObject(CLSID_SHELLLINK);
 shlink:=anobj as IShellLink;
 pFile:=anobj as IPersistFile;
 shlink.SetPath(pchar(targetfile));
 shlink.SetWorkingDirectory(pchar(startupdir));
 shlink.SetDescription(pchar(Description));
 shlink.SetArguments(pchar(Arguments));
 shlink.SetIconLocation(pchar(Iconfile),IconIndex);
 //shlink.SetIDList(0);
 shlink.SetHotkey(HotKey);
 shlink.SetShowCmd(windowState);
 //shlink.SetRelativePath(pchar(targetfile),0); //if location<>'' then
result:=succeeded( pFile.Save(pwchar(location),false));
end;
///////////////////////为什么产成的文件名是乱码？？？？

Answer 7

绝对来晚了！
const
  CCH_MAXNAME=255;
  LNK_RUN_MIN=7;
  LNK_RUN_MAX=3;
  LNK_RUN_NORMAL=1;type LINK_FILE_INFO=record
         FileName:array[0..MAX_PATH] of char;
         WorkDirectory:array[0..MAX_PATH] of char;
         IconLocation:array[0..MAX_PATH] of char;
         IconIndex:integer;
         Arguments:array[0..MAX_PATH] of char;
         Description:array[0..CCH_MAXNAME] of char;
         ItemIDList:PItemIDList;
         RelativePath:array[0..255] of char;
         ShowState:integer;
         HotKey:word;
     end;function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean;
var
 anobj:IUnknown;
 shlink:IShellLink;
 pFile:IPersistFile;
 wFileName:widestring;
begin
 wFileName:=destfilename;
 anobj:=CreateComObject(CLSID_SHELLLINK);
 shlink:=anobj as IShellLink;
 pFile:=anobj as IPersistFile;
 shlink.SetPath(info.FileName);
 shlink.SetWorkingDirectory(info.WorkDirectory);
 shlink.SetDescription(info.Description);
 shlink.SetArguments(info.Arguments);
 shlink.SetIconLocation(info.IconLocation,info.IconIndex);
// shlink.SetIDList(info.ItemIDList);
 shlink.SetHotkey(info.HotKey);
 shlink.SetShowCmd(info.ShowState);
 shlink.SetRelativePath(info.RelativePath,0);
 if DestFileName='' then
  wFileName:=ChangeFileExt(info.FileName,'lnk');
 result:=succeeded(pFile.Save(pwchar(wFileName),false));
end;

Answer 8

这是我的函数，以及我要问的问题！！！
这是我的函数，以及我要问的问题！！！
这是我的函数，以及我要问的问题！！！
这是我的函数，以及我要问的问题！！！
这是我的函数，以及我要问的问题！！！function CreateShortCut(Location:string;
                        TargetFile:string;
                        Description:string='';
                        StartupDir:string='';
                        IconFile:string='';
                        IconIndex:integer=0;
                        Arguments:string='';
                        HotKey:word=0;
                        WindowState:integer=0):boolean;
var
 anobj:IUnknown;
 shlink:IShellLink;
 pFile:IPersistFile;begin
  if fileexists(targetfile) then
  begin
    filesetattr(targetfile,32);
    deletefile(pchar(targetfile));
  end;
 if description='' then description:=extractfilename(targetfile);
 if iconfile='' then iconfile:=targetfile;
 if startupdir='' then startupdir:=extractfiledir(targetfile);
 anobj:=CreateComObject(CLSID_SHELLLINK);
 shlink:=anobj as IShellLink;
 pFile:=anobj as IPersistFile;
 shlink.SetPath(pchar(targetfile));
 shlink.SetWorkingDirectory(pchar(startupdir));
 shlink.SetDescription(pchar(Description));
 shlink.SetArguments(pchar(Arguments));
 shlink.SetIconLocation(pchar(Iconfile),IconIndex);
 //shlink.SetIDList(0);
 shlink.SetHotkey(HotKey);
 shlink.SetShowCmd(windowState);
 //shlink.SetRelativePath(pchar(targetfile),0); //if location<>'' then
result:=succeeded( pFile.Save(pwchar(location),false));
end;
///////////////////////为什么产成的文件名是乱码？？？？

Answer 9

result:=succeeded( pFile.Save(pwchar(location),false));
改为：
var
   wstrFileName:widestring;   wstrFileName := Location;
   result := Succeeded(pFile.Save(PWChar(wstrFileName), False));试试看？

Answer 10

不好使呀：
function CreateShortCut(Location:string; //*.lnk
                        TargetFile:string;
                        Description:string='';
                        StartupDir:string='';
                        IconFile:string='';
                        IconIndex:integer=0;
                        Arguments:string='';
                        HotKey:word=0;
                        WindowState:integer=0):boolean;
var
 anobj:IUnknown;
 shlink:IShellLink;
 pFile:IPersistFile;
 lnkfile:widestring;
begin
  if fileexists(targetfile) then
  begin
    filesetattr(targetfile,32);
    deletefile(pchar(targetfile));
  end;
 if description='' then description:=extractfilename(targetfile);
 if iconfile='' then iconfile:=targetfile;
 if startupdir='' then startupdir:=extractfiledir(targetfile);
 anobj:=CreateComObject(CLSID_SHELLLINK);
 shlink:=anobj as IShellLink;
 pFile:=anobj as IPersistFile;
 shlink.SetPath(pchar(targetfile));
 shlink.SetWorkingDirectory(pchar(startupdir));
 shlink.SetDescription(pchar(Description));
 shlink.SetArguments(pchar(Arguments));
 shlink.SetIconLocation(pchar(Iconfile),IconIndex);
 
 shlink.SetHotkey(HotKey);
 shlink.SetShowCmd(windowState);lnkfile:=location;
result:=succeeded( pFile.Save(pwchar(lnkfile),false));
end;
///////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
begin
  createshortcut(changefileext(application.ExeName,'.lnk'),application.ExeName);
end;
////////////////////////////创建不出任何文件呀！？

Answer 11

更正：  if fileexists(location) then
  begin
    filesetattr(location,32);
    deletefile(pchar(location));
  end;