Thema: Delphi Startmenü eintrag

Einzelnen Beitrag anzeigen

Progman

Registriert seit: 31. Aug 2007
Ort: 99974 MHL
695 Beiträge
 
Delphi 10.1 Berlin Starter
 
#5

Re: Startmenü eintrag

  Alt 1. Nov 2007, 14:51
Hier ist die Procedure dazu:
Delphi-Quellcode:
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;
Hab jetzt nur nicht die Zeit, das näher zu erläutern, sorry.
Karl-Heinz
Populanten von Domizilen mit fragiler, transparenter Aussenstruktur sollten sich von der Translation von gegen Deformierung resistenter Materie distanzieren!
(Wer im Glashaus sitzt sollte nicht mit Steinen werfen)
  Mit Zitat antworten Zitat