Delphi-Create desktop, send to ..., Quick Launch bar, Start menu, Program menu, right-click menu

Source: Internet
Author: User

{================================================================= Features: Create desktop, send to ..., Quick Launch bar, Start menu, Program menu, right-click menu shortcut Parameters: FileName: Shortcut Execution FileName Description: Shortcut Description information arguements: Shortcut execution Parameter showname: Shortcut Display Name location: Shortcut Category ID: Queue number to set status (255 set) Createordelete: Whether to create or delete (default is create True) return value: No note: Need to reference Registry, Shlobj, Comobj, ActiveX, regstr unit ========================== =======================================}

Procedure Tmainform.createshortcut (filename,description,arguements,showname:string? Location:shortcuttype? Id:byte? createordelete:boolean=true)? varcobj:iunknown?slink:ishelllink?pfile:ipersistfile?sdir,spath,key,tmp:string? Wfilename:widestring?mreg:tregistry?begincobj: =createcomobject (clsid_shelllink)? Create COM object slink: =cobj as IShellLink? COM object to IShellLink type interface pfile: =cobj as IPersistFile? COM object to IPersistFile type interface//get path spath: =extractfilepath (filename)? with Slink do Beginsetpath (PChar (filename))? Set the execution file name Setarguments (PChar (arguements))? Set the execution parameter SetDescription (Pchar (Description))? Set Description information Setworkingdirectory (PChar (spath))? Set the working path, which is the directory where the program executes end?//get the actual directory for each shortcut Mreg: =tregistry.create?with mreg do beginif location=st_context then// Add right-click menu Beginrootkey: =hkey_classes_root?tmp:= ' *shell ' +showname?if createordelete thenbeginif OpenKey (tmp,true) thenbegin//use WriteString to write the setting value to the open primary key WriteString (", showname+ ' (&k) ')? Closekey?end?if openkey (tmp+ ' command ', true) the contents of the Thenbegin//command subkey areClick the right button after selecting the appropriate program to run,//%1 is the right click when you select the file name//writestring (, ' c:delphimyprogram.exe+ '%1 ')? WriteString (', FileName)? Closekey?end?endelsedeletekey (TMP)? Free?exit?end? Rootkey: =hkey_current_user?key: =regstr_path_explorer? The constant TMP defined by Delphi in Unit Regstr: =key + ' Shell Folders '? Openkey (TMP, FALSE)? Case Location Ofst_desktop:sdir: =readstring (' DESKTOP ')? St_sendto:sdir: =readstring (' SENDTO ')? St_startmenu:sdir: =readstring (' Start Menu ')? St_programs:sdir: =readstring (' PROGRAMS ')? St_quicklaunch:beginsdir: =readstring (' AppData ')? SDir: =sdir + ' microsoftinternet explorerquick Launch '? end?end?// Generate the shortcut file name if Showname= ' thenbeginshowname: =changefileext (filename, '. Lnk ')? ShowName: =extractfilename (showname)? endelseshowname:= showname+ '. lnk '? If Sdir<> ' thenbegin// Generate shortcut full path name wfilename: =sdir + "+ showname?if (id<255) thenbeginif fileexists (wfilename) then// rzcheckgroup1.itemchecked[id]:= true?endelse//Save or delete the generated shortcut file if Createordelete thenpfile.save (Pwchar (WFileName), False) Elsedeletefile (wfilename)? enD? Free?end?end?

Http://www.cnblogs.com/shangdawei/p/4518740.html

Delphi-Create desktop, send to ..., Quick Launch bar, Start menu, Program menu, right-click menu

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.