Solved

Putting shortcut into Startup Folder

Posted on 2002-04-08
13
552 Views
Last Modified: 2010-04-04
I need to create a link for an application to start in the StartUp Folder for both win9x & NT from a Delphi Application. Does someone know how to do this from Delphi for both operating systems?
0
Comment
Question by:skynergy
  • 5
  • 4
  • 4
13 Comments
 
LVL 17

Expert Comment

by:inthe
Comment Utility
this should work:

uses
   ActiveX,ShlObj;

function MakeLinks(AppName: String; Startmenu, Desktop: Boolean): Boolean;
const
   ShellFolderKey =
'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
   DesktopKey = 'Desktop';
   ProgramsKey = 'Startup'; //for startup menu
 //ProgramsKey = 'Programs';  //for programs menu

var
   tmp: array[0..MAX_PATH] of Char;
   MainKey: HKEY;
   ValLen: DWORD;
   SL: IShellLink;
   PF: IPersistFile;
   LnkName: WideString;
begin
   Result := false;
   if RegOpenKeyEx(HKEY_CURRENT_USER, PChar(ShellFolderKey), 0,
    KEY_QUERY_VALUE, MainKey) = ERROR_SUCCESS then begin
     try
       if CoInitialize(nil) <> S_OK then exit;
       try
         if Desktop then begin
           ValLen := MAX_PATH;
           RegQueryValueEx(MainKey, PChar(DesktopKey), nil, nil, @tmp,
@ValLen);
           if CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
             IShellLink, SL) <> S_OK then exit;
           PF := SL as IPersistFile;
           if SL.SetPath(PChar(AppName)) <> S_OK then exit;
           if SL.SetWorkingDirectory(PChar(ExtractFilePath(AppName))) <>
S_OK then exit;
           LnkName := tmp + String('\') +
ChangeFileExt(ExtractFileName(AppName), '') + '.lnk';
           PF.Save(PWideChar(LnkName), True);
         end;
         if Startmenu then begin
           ValLen := MAX_PATH;
           RegQueryValueEx(MainKey, PChar(ProgramsKey), nil, nil, @tmp,
@ValLen);
           if CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
             IShellLink, SL) <> S_OK then exit;
           PF := SL as IPersistFile;
           if SL.SetPath(PChar(AppName)) <> S_OK then exit;
           if SL.SetWorkingDirectory(PChar(ExtractFilePath(AppName))) <>
S_OK then exit;
           LnkName := tmp + String('\') +
ChangeFileExt(ExtractFileName(AppName), '') + '.lnk';
           PF.Save(PWideChar(LnkName), True);
         end;
         Result := True;
       finally
         CoUninitialize;
       end;
     finally
       RegCloseKey(MainKey);
     end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
makelinks('c:\myfile.txt',true,false);
end;
0
 
LVL 3

Expert Comment

by:SteveWaite
Comment Utility
3234 Adding shortcuts to Win95/WinNT4 Desktop/StartMenu

This sample project demonstrates an easy way to add shortcuts to
your Windows 95 or Windows NT 4.0 desktop or start menu.

1. Launch Delphi 3.

2. In a new project, drop a TButton on the form (make sure it's
   called Button1). Then double click on Button1. Now you can go
   ahead and directly replace the code for Unit1 with the code for
   Unit1 below.

The program will set up a shortcut either (see the code) on the
desktop or on the start menu. The shortcut will be called FooBar
and it will open up your AUTOEXEC.BAT in NOTEPAD when executed.

It will read the value of the "Desktop" and "Start Menu" strings
from the registry key named (under HKEY_CURRENT_USER):

 Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders

--------------
The Unit1 unit
--------------

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShlObj, ActiveX, ComObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyObject  : IUnknown;
  MySLink   : IShellLink;
  MyPFile   : IPersistFile;
  FileName  : String;
  Directory : String;
  WFileName : WideString;
  MyReg     : TRegIniFile;
begin
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  FileName := 'NOTEPAD.EXE';
  with MySLink do begin
    SetArguments('C:\AUTOEXEC.BAT');
    SetPath(PChar(FileName));
    SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
  end;
  MyReg := TRegIniFile.Create(
    'Software\MicroSoft\Windows\CurrentVersion\Explorer');

// Use the next line of code to put the shortcut on your desktop
  Directory := MyReg.ReadString('Shell Folders','Desktop','');

// Use the next three lines to put the shortcut on your start menu
//  Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
//      '\Whoa!';
//  CreateDir(Directory);

  WFileName := Directory+'\FooBar.lnk';
  MyPFile.Save(PWChar(WFileName),False);
  MyReg.Free;
end;

end.

        TI
0
 

Author Comment

by:skynergy
Comment Utility
Hi inthe! Thanx for the great code. Additional question that I forgot to ask. How would one add a parameter for the LNK?
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
hi,
to add parameters to it you can do like below where ive added the setarguments() call:

uses
  ActiveX,ShlObj;

function MakeLinks(AppName,args: String; Startmenu, Desktop: Boolean): Boolean;
const
  ShellFolderKey =
'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
  DesktopKey = 'Desktop';
  ProgramsKey = 'Startup'; //for startup menu
//ProgramsKey = 'Programs';  //for programs menu

var
  tmp: array[0..MAX_PATH] of Char;
  MainKey: HKEY;
  ValLen: DWORD;
  SL: IShellLink;
  PF: IPersistFile;
  LnkName: WideString;
begin
  Result := false;
  if RegOpenKeyEx(HKEY_CURRENT_USER, PChar(ShellFolderKey), 0,
   KEY_QUERY_VALUE, MainKey) = ERROR_SUCCESS then begin
    try
      if CoInitialize(nil) <> S_OK then exit;
      try
        if Desktop then begin
          ValLen := MAX_PATH;
          RegQueryValueEx(MainKey, PChar(DesktopKey), nil, nil, @tmp,
@ValLen);
          if CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
            IShellLink, SL) <> S_OK then exit;
          PF := SL as IPersistFile;
          if SL.SetPath(PChar(AppName)) <> S_OK then exit;
          if SL.SetWorkingDirectory(PChar(ExtractFilePath(AppName))) <>
S_OK then exit;
          LnkName := tmp + String('\') +
ChangeFileExt(ExtractFileName(AppName), '') + '.lnk';
          PF.Save(PWideChar(LnkName), True);
        end;
        if Startmenu then begin
          ValLen := MAX_PATH;
          RegQueryValueEx(MainKey, PChar(ProgramsKey), nil, nil, @tmp,
@ValLen);
          if CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
            IShellLink, SL) <> S_OK then exit;
          PF := SL as IPersistFile;
          sl.SetArguments(pchar(args));
          if SL.SetPath(PChar(AppName)) <> S_OK then exit;
          if SL.SetWorkingDirectory(PChar(ExtractFilePath(AppName))) <>
S_OK then exit;
          LnkName := tmp + String('\') +
ChangeFileExt(ExtractFileName(AppName), '') + '.lnk';
          PF.Save(PWideChar(LnkName), True);
        end;
        Result := True;
      finally
        CoUninitialize;
      end;
    finally
      RegCloseKey(MainKey);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
makelinks('c:\test\project1.exe','hello',true,false);
end;


and to test it:

procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.clear;
edit1.text := paramstr(1);
end;

you add the oncreate test on the same program just the first time you run it the edit should stay empty then second time when run from the startmenu the edit will contain hello
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
actually should move this
sl.SetArguments(pchar(args));
to the next line so it is after appname has returned ok
0
 

Author Comment

by:skynergy
Comment Utility
Why does my application exit at "if CoInitialize(nil) <> S_OK then exit;" and a new test application don't?
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 

Author Comment

by:skynergy
Comment Utility
Also how would I remove this shortcut again from Startup?
0
 
LVL 3

Expert Comment

by:SteveWaite
Comment Utility
Why not just use Borland recommended code as shown in ti 3234 above?
0
 

Author Comment

by:skynergy
Comment Utility
Will I be able to remove the link as well? I am only interested in the Startup folder really.
0
 
LVL 3

Expert Comment

by:SteveWaite
Comment Utility
You can create the link wherever you want:

// Use the next line of code to put the shortcut in your startup folder
 Directory := MyReg.ReadString('Shell Folders','Startup','');

which just gets the startup folder from the reg and puts it in the String var, Directory.

Than later you can delete it as with any file:
DeleteFile(Directory+'\FooBar.lnk');
0
 
LVL 17

Accepted Solution

by:
inthe earned 100 total points
Comment Utility
i had some code given from madshi which ive altered a little to only do startup dir and to give a uninstall option.
as it looks like it was originally based on borlands code you should give the points to steve ,no probs here with that :)


uses
Registry, ShlObj,ActiveX, ComObj;

procedure CreateShortcut(FileName,Args: string;uninstall : boolean);
var
LPUnknown : IUnknown;
pShlLnk : IShellLink;
pszFileName : IPersistFile;
Dir,LinkName : string;
FullPath : WideString;
R : TRegIniFile;
begin
LPUnknown := CreateComObject(CLSID_ShellLink);
pShlLnk := LPUnknown as IShellLink;
pszFileName := LPUnknown as IPersistFile;
pShlLnk.SetPath(PChar(FileName));
pShlLnk.SetArguments(PChar(Args));
R := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
try
LinkName := ChangeFileExt(FileName, '.lnk');
LinkName := ExtractFileName(LinkName);
Dir := R.ReadString('Shell Folders', 'Startup', '');
if Dir <> '' then
begin
FullPath := Dir + '\' + LinkName;
if uninstall then
DeleteFile(FullPath)
else
pszFileName.Save(PWChar(FullPath), False);
end;
finally
R.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin //to install
CreateShortcut('c:\windows\notepad.exe','hello',false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin//to uninstall
CreateShortcut('c:\windows\notepad.exe','hello',true);
end;
0
 

Author Comment

by:skynergy
Comment Utility
Just want to thank you for all your help and the fact that you even gave me a simple procedure to implement. It saved me a lot of time and effort. Thanx to Steve too for helping us out! It's a pitty one can't split or share the points? Thanx guys!
0
 
LVL 3

Expert Comment

by:SteveWaite
Comment Utility
:)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now