terça-feira, 24 de novembro de 2009

Criar atalho na area de trabalho e no menu iniciar do windows

uses ShlObj, ActiveX,ComObj, Registry,FileCtrl;
procedure CriarAtalho (NomeDoPrograma,ParametrosdeExcecucao,DiretoriodeInicializacao, NomedoAtalho,IniciarEm,NomedoGrupo : String);
var
MeuObjeto : IUnknown;
MeuAtalho : IShellLink;
MeuArquivo : IPersistFile;
Diretorio : String;
CriarAtalho : WideString;
Var_Registro : TRegIniFile;
begin
MeuObjeto := CreateComObject(CLSID_ShellLink);
MeuAtalho := MeuObjeto as IShellLink;
MeuArquivo := MeuObjeto as IPersistFile;
with MeuAtalho do
begin
SetArguments(PChar(ParametrosdeExcecucao));
SetPath(PChar(NomeDoPrograma));
SetWorkingDirectory(PChar(DiretoriodeInicializacao));
end;
Var_Registro := TRegIniFile.Create('SoftwareMicrosoftWindowsCurrentVersionExplorer');
Diretorio := Var_Registro.ReadString ('Shell Folders','Programs','');
//Cria o Atalho No Menu Iniciar
if trim(NomedoGrupo)<>'' then
begin
Diretorio:=Diretorio+''+NomedoGrupo;
if not DirectoryExists(Diretorio) then
ForceDirectories(Diretorio);
end;
CriarAtalho := Diretorio + '' + NomedoAtalho + '.lnk';
MeuArquivo.Save (PWChar (CriarAtalho), False);
//Cria o Atal]ho na area de Trabalho
Diretorio := Var_Registro.ReadString ('Shell Folders','Desktop','');
CriarAtalho := Diretorio + '' + NomedoAtalho + '.lnk';

MeuArquivo.Save (PWChar (CriarAtalho), False);
Var_Registro.Free;
end;

procedure TForm1.CriarAtalhoClick(Sender: TObject);
begin
CriarAtalho('Arquivo.Exe','parametro pa abertura','Diretorio onde o Arquivo Esta','Nome do Atalho','onde o Arquivo Esta','Nome do Gupo');
end;
o nome do Grupo é uma pasta onde seu atalho vai Ficar
como por exemplo "acessorios"

Nenhum comentário:

Postar um comentário