Crear un acceso directo

Aquí tenemos un pequeño pero interesante procedimiento para crear accesos directos en Windows. Antes de implementarlo hay que añadir en uses una serie de unidades externas:

uses
  Windows, Dialogs, ...,  ShlObj, ActiveX, StdCtrls, Registry, ComObj;

Este sería el procedimiento:

procedure CrearAccesoDirecto( sExe, sArgumentos, sDirTrabajo, sNombreLnk, sDirDestino: string );
var
  Objeto: IUnknown;
  UnSlink: IShellLink;
  FicheroP: IPersistFile;
  WFichero: WideString;
begin
  Objeto := CreateComObject( CLSID_ShellLink );
  UnSlink := Objeto as IShellLink;
  FicheroP := Objeto as IPersistFile;

  with UnSlink do
  begin
    SetArguments( PChar( sArgumentos ) );
    SetPath( PChar( sExe ) );
    SetWorkingDirectory( PChar( sDirTrabajo ) );
  end;

  WFichero := sDirDestino + '\' + sNombreLnk;
  FicheroP.Save( PWChar( WFichero ), False );
end;

Y estos son sus parámetros:

sExe        -> Ruta que apunta al ejecutable o archivo a crear el acceso directo
sArgumentos -> Parámetros que le mandamos al EXE
sDirTrabajo -> Ruta al directorio de trabajo del ejecutable
sNombreLnk  -> Nombre del acceso directo
sDirDestino -> Ruta destino donde se creará el acceso directo

Aquí os muestro un ejemplo de cómo crear un acceso directo de la calculadora de Windows al escritorio:

procedure CrearAccesoCalculadora;
var
  sEscritorio: String;
  Registro: TRegistry;
begin
  Registro := TRegistry.Create;

  // Leemos la ruta del escritorio
  try
    Registro.RootKey := HKEY_CURRENT_USER;

    if Registro.OpenKey( '\Software\Microsoft\Windows\CurrentVersion\explorer\Shell Folders', True ) then
      sEscritorio := Registro.ReadString( 'Desktop' );
  finally
    Registro.CloseKey;
    Registro.Free;
    inherited;
  end;

  CrearAccesoDirecto( 'C:\Windows\System32\calc.exe', '',
                      'C:\Windows\System32\', 'Calculadora.lnk', sEscritorio );
end;

Pruebas realizadas en Delphi 7.