Создать ярлык на рабочем столе

Советы » Ярлыки » Создать ярлык на рабочем столе

unit

Main; interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type

TForm1 = class

(TForm) Button1: TButton; Label1: TLabel; procedure

Button1Click(Sender: TObject); private

{ Private declarations } public

{ Public declarations } end

; var

Form1: TForm1; implementation

{$R *.DFM} uses

ComObj, ActiveX, ShlObj, Registry; const

{ Registry key where Folder information is kept } SFolderKey = 'SoftwareMicrosoftWindowsCurrentVersion' + 'ExplorerShell Folders'; function

GetFolderLocation(const

FolderType: string

): string

; { Retrieves from registry path to folder indicated in FolderType } begin

with

TRegistry.Create do

try

RootKey := HKEY_CURRENT_USER; if

not

OpenKey(SFolderKey, False) then

{ open key where shell folder information is kept. } raise

ERegistryException.CreateFmt('Folder key "%s" not found', [SFolderKey]); { Get path for specified folder } Result := ReadString(FolderType); if

Result = '' then

raise

ERegistryException.CreateFmt('"%s" item not found in registry', [FolderType]); CloseKey; finally

Free; end

; end

; procedure

MakeNotepad; const

// NOTE: Assumed location for Notepad: AppName = 'c:windows otepad.exe'; var

SL: IShellLink; PF: IPersistFile; LnkName: WideString; begin

OleCheck(CoCreateInstance(CLSID_ShellLink, nil

, CLSCTX_INPROC_SERVER, IShellLink, SL)); { IShellLink implementers are required to implement IPersistFile } PF := SL as

IPersistFile; OleCheck(SL.SetPath(PChar(AppName))); // set link path to proper file { create a path location and filename for link file } LnkName := GetFolderLocation('Desktop') + '' + ChangeFileExt(ExtractFileName(AppName), '.lnk'); PF.Save(PWideChar(LnkName), True); // save link file end

; procedure

TForm1.Button1Click(Sender: TObject); begin

MakeNotepad; end

; end

.

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

Категории

Статьи

Советы

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