Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска

Советы » Ярлыки » Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска

uses

Registry, ActiveX, ComObj, ShlObj; type

ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER); function

CreateShortcut(SourceFileName: string

; // the file the shortcut points to Location: ShortcutType; // shortcut location SubFolder, // subfolder of location WorkingDir, // working directory property of the shortcut Parameters, Description: string

): // description property of the shortcut string

; const

SHELL_FOLDERS_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionExplorer'; QUICK_LAUNCH_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionGrpConv'; var

MyObject: IUnknown; MySLink: IShellLink; MyPFile: IPersistFile; Directory, LinkName: string

; WFileName: WideString; Reg: TRegIniFile; begin

MyObject := CreateComObject(CLSID_ShellLink); MySLink := MyObject as

IShellLink; MyPFile := MyObject as

IPersistFile; MySLink.SetPath(PChar(SourceFileName)); MySLink.SetArguments(PChar(Parameters)); MySLink.SetDescription(PChar(Description)); LinkName := ChangeFileExt(SourceFileName, '.lnk'); LinkName := ExtractFileName(LinkName); // Quicklauch if

Location = _QUICKLAUNCH then

begin

Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT); try

Directory := Reg.ReadString('MapGroups', 'Quick Launch', ''); finally

Reg.Free; end

; end

else

// Other locations begin

Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT); try

case

Location of

_OTHERFOLDER : Directory := SubFolder; _DESKTOP : Directory := Reg.ReadString('Shell Folders', 'Desktop', ''); _STARTMENU : Directory := Reg.ReadString('Shell Folders', 'Start Menu', ''); _SENDTO : Directory := Reg.ReadString('Shell Folders', 'SendTo', ''); end

; finally

Reg.Free; end

; end

; if

Directory <> '' then

begin

if

(SubFolder <> '') and

(Location <> _OTHERFOLDER) then

WFileName := Directory + '' + SubFolder + '' + LinkName else

WFileName := Directory + '' + LinkName; if

WorkingDir = '' then

MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName))) else

MySLink.SetWorkingDirectory(PChar(WorkingDir)); MyPFile.Save(PWChar(WFileName), False

); Result := WFileName; end

; end

; function

GetProgramDir: string

; var

reg: TRegistry; begin

reg := TRegistry.Create; try

reg.RootKey := HKEY_CURRENT_USER; reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders', False

); Result := reg.ReadString('Programs'); reg.CloseKey; finally

reg.Free; end

; end

; // Some examples: procedure

TForm1.Button1Click(Sender: TObject); const

PROGR = 'c:YourProgram.exe'; var

resPath: string

; begin

//Create a Shortcut in the Quckick launch toolbar CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description'); //Create a Shortcut on the Desktop CreateShortcut(PROGR, _DESKTOP, '','','','Description'); //Create a Shortcut in the Startmenu /"Programs"-Folder resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description'); if

resPath <> '' then

begin

ShowMessage('Shortcut Successfully created in: ' + resPath); end

; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com