Fórum Como Criar Atalho no Desktop ao executar o projeto???! #176500

Tirado de 800 dicas e truques em delphi do LloydSoft

http://www.lloydsoft.hpg.ig.com.br/

Criar atalho no desktop
Coloque essas units na seção implementation :

uses ShlObj, ActiveX,ComObj, Registry;
Por último, crie uma procedure que faça o trabalho:

procedure CreateShortcut (FileName, Parameters, InitialDir, ShortcutName, ShortcutFolder : String);
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetArguments(Parameters);
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(InitialDir));
end;
MyReg := TRegIniFile.Create(´Software\MicroSoft\Windows\CurrentVersion\Explorer´);
Directory := MyReg.ReadString (´Shell Folders´,´Desktop´,´´);
WFileName := Directory + ´\´ + ShortcutName + ´.lnk´;
MyPFile.Save (PWChar (WFileName), False);
MyReg.Free;
end;

ei mlk, essa rotina ja rola pela net, peguei mas nao funfou nao.. vc testou???

he preguiça...
tente esta

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;