Crear archivo lnk

[Sebastián Almirón]

He hecho un programa de instalación de una aplicación, lo he empaquetado todo con el iexpress para que los clientes se lo puedan bajar de mi servidor ftp.
Durante el proceso de instalación me gustaría darles la posibilidad de que se cree un acceso directo a la aplicación en el escritorio. Sobre como copiar el archivo .lnk al escritorio del usuario no tengo problema, con Gete("USERPROFILE").

¿ Pero como puedo modificar el archivo .lnk (o crear uno nuevo) que lleva originalmente para indicarle que está instalada en el directorio que ha elegido el usuario y que se ejecute en ese directorio.

Saludos y buen fin de semana.

[acuellar]

Sebastian

Así se hace:

Code: Select all | Expand

 cEscritorio:=C_getspecialfolder(CSIDL_DESKTOPDIRECTORY)
pLnk( 'C:\VIADELSISTEMA\SISTEMA.EXE',cEscritorio+"\Sistema.lnk",,'C:\VIADELSISTEMA\SISTEMA.EXE'  )

*Aquí la función
FUNCTION pLnk( cFile, cNameLnk, cWorkingDir, cIcon ) //Crear acceso directo
    LOCAL oShell, oLnk

    DEFAULT cFile        := ''
    DEFAULT cNameLnk     := ''
    DEFAULT cWorkingDir  := ''
    DEFAULT cIcon        := ''

    IF !File( cFile )
       RETU .F.
    ENDIF
    IF Empty( cNameLnk )
       cNameLnk := cFilePath( cFile ) + cFileNoExt( cFile ) + '.lnk'
    ENDIF
    IF Empty( cWorkingDir )
       cWorkingDir := cFilePath( cFile )
    ENDIF
    TRY
      oShell := CreateObject( "Wscript.Shell" )
     CATCH
      MsgAlert( 'Error Create object WScript.Shell', 'Error' )
      RETU  .F.
    END
    oLnk                  := oShell:CreateShortcut( cNameLnk )
    oLnk:TargetPath       := cFile
    oLnk:WindowStyle      := 1 //1=Normal 2=Minimizada 3=Maximizada
    IF !Empty( cIcon )
        oLnk:IconLocation     := cIcon
    ENDIF
    IF !Empty( cWorkingDir )
        oLnk:WorkingDirectory := cWorkingDir
    ENDIF
     oLnk:Save()

Return .T.

 

Espero te sirva

Saludos,

Adhemar

[horacio]

Adhemar, al compilar me arroja este error

Code: Select all | Expand

crear_acceso_directo.prg(6) Error E0030  Syntax error "syntax error at ':'"
 

y corresponde a esta linea

Code: Select all | Expand

cEscritorio := C_getspecialfolder( CSIDL_DESKTOPDIRECTORY )
 

Un par de preguntas, supongo que CSIDL_DESKTOPDIRECTORY es una constante, cual es su valor ? y C_getspecialfolder() es una función que se encuentra en Harbour o xHarbour o en ambos ?
Desde ya muchísimas gracias por este aporte.

Saludos

[acuellar]

Horacio

Aquí va el valor

Code: Select all | Expand

#define CSIDL_DESKTOPDIRECTORY     0x0010
 

Saludos,

Adhemar

[FranciscoA]

y C_getspecialfolder() es una función que se encuentra en Harbour o xHarbour o en ambos ?

+1

[FranciscoA]

http://forums.fivetechsupport.com/viewt ... 32&start=0

[acuellar]

Aquí la función

Code: Select all | Expand

#pragma BEGINDUMP

#include <windows.h>
#include <shlobj.h>
#include "hbapi.h"
#include "hbapiitm.h"

HB_FUNC( C_GETSPECIALFOLDER )
{
    char *lpBuffer = (char*) hb_xgrab( MAX_PATH+1);
    LPITEMIDLIST pidlBrowse;    
    SHGetSpecialFolderLocation(GetActiveWindow(), hb_parni(1), &pidlBrowse)  
;
    SHGetPathFromIDList(pidlBrowse, lpBuffer);
    hb_retc(lpBuffer);
    hb_xfree( lpBuffer);
}
#pragma ENDDUMP

 

Saludos,

Adhemar

[horacio]

Adhemar, muchas gracias. Funcionó perfectamente.

Saludos

[informaticaeloy]

Hola,

habéis tenido en cuenta si el usuario al instalar el programa puede cambiar de ruta ? si lo cambia, tal vez no funcione el link.

[Sebastián Almirón]

Muchas gracias Adhemar, funciona perfecto.

Saludos

[jesusdelamora]

Gracias funiciona excelente