Delphi World - Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска


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 = 'Software\MicroSoft\Windows\CurrentVersion\Explorer'; 
  QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv'; 
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('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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;

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования