Crear acceso directo desde ejecutable

[leandro]

Hola buenas noches para todos

No se si sea posible crear un acceso directo desde nuestro ejecutable (Acceso directo (.lnk)) y luego copiarlo en la carpeta C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup

Es con el fin de crear como una especie de servicio, que se debe activar automáticamente al momento de iniciar el Windows, para evitar que el usuario que tenga que hacerlo de manera manual.

De antemano gracias

[cnavarro]

Leandro
viewtopic.php?f=3&t=20590&p=109376&hilit=Create+shortcut+on+desktop#p109376

[acuellar]

Leandro

Aquí otro ejemplo:

Code: Select all  Expand view  RUN

#define CSIDL_DESKTOPDIRECTORY     0x0010
Function Main()
     cEscritorio:=C_getspecialfolder(CSIDL_DESKTOPDIRECTORY)
       pLnk( 'C:\SISTEMAS\MOVIECENTER\MovieCenter.EXE',cEscritorio+"\MovieCenter.lnk",,'C:\SISTEMAS\MOVIECENTER\MovieCenter.EXE,0'  )
Return Nil
*
FUNCTION pLnk( cFile, cNameLnk, cWorkingDir, cIcon )
    LOCAL oShell, oLnk

    DEFAULT cFile:= cNameLnk:= cWorkingDir:= 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 ayude,

[csincuir]

Leandro, podrias probar tambien con URLLINK

Code: Select all  Expand view  RUN

REDEFINE URLLINK ID 104 URL "www.fivetechsoft.com" OF oDlg ;
            TOOLTIP "Sitio oficial de FiveTech"

Hay un ejemplo en samples\testurl.prg

Saludos.

Carlos

[leandro]

Hola buenas tardes para todos, gracias por responder

Adhemar
Cuanto intento compilar tu ejemplo me arroja error de compilación

Code: Select all  Expand view  RUN

Turbo Incremental Link 6.80 Copyright (c) 1997-2017 Embarcadero Technologies, Inc.
Error: Unresolved external '_HB_FUN_C_GETSPECIALFOLDER' referenced from C:\FIVEDIT\AACCE.OBJ
Error: Unable to perform link
Link Error

Intente tambien con la clase

Code: Select all  Expand view  RUN

*****************************************************************************
*** Class         : ZLnk()                                                ***
*** Descripction  : To Create Shortcut Links                              ***
*** Author        : Carles Aubia                                          ***
*** Created on    : 04.07.2006                                            ***
*****************************************************************************
 

Pero con esta no hace nada

De antemano gracias

[FiveWiDi]

Con estas funciones yo lo hago:

Code: Select all  Expand view  RUN

/* ***************************************** */
// Pres del foro de FiveTechSoft el 20/11/2010.
#define CSIDL_PROGRAMS                  0x0002        // Start  Menu\Programs
#define CSIDL_DESKTOPDIRECTORY          0x0010        // <user  name>\Desktop
#define CSIDL_COMMON_STARTMENU          0x0016        // <All Users>\Start Menu
#define CSIDL_COMMON_DESKTOPDIRECTORY   0x0019        // <All Users>\Desktop
#define CSIDL_PROFILE                   0x0028        // C:\Documents and Settings\<user name>
#define CSIDL_PROGRAM_FILES             0x0026        // C:\Program Files
#define CSIDL_FAVORITES                 0x0006        // "C:\Documents and Settings\User\Favorites"
#define CSIDL_COMMON_FAVORITES          0x001F        // "C:\Documents and Settings\All Users\Favorites"
#define CSIDL_MYDOCUMENTS               0x000C        // Virtual "C:\Documents and Settings\username\My Documents"
#define CSIDL_PERSONAL                  0x0005        // "C:\Documents and Settings\user\My Documents"
/* ***************************************** */

/* ***************************************** */
/* ***************************************** */
FUNCTION cGetMisDocumentos()
// C:\Documents and Settings\Usuario\Escritorio
Local cMisDocumentos := Nil
cMisDocumentos := GETSPECIALFOLDER( CSIDL_PERSONAL )
Return cMisDocumentos
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetAllUsersProfile()
// A Windows Vista o superior  -->>  C:\ProgramData
// A Windows XP o inferior     -->>  C:\Documents and Settings\All Users
Local cAllUsersProfile := Nil
cAllUsersProfile := GetEnv( "ALLUSERSPROFILE" )
Return cAllUsersProfile
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetProgramFiles()
// C:\Program Files
Local cProgramFiles := Nil
cProgramFiles := GETSPECIALFOLDER( CSIDL_PROGRAM_FILES )
Return cProgramFiles
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetUserFavoritos()
// C:\Documents and Settings\User\Favorites
Local cFavoritos := Nil
cFavoritos := GETSPECIALFOLDER( CSIDL_FAVORITES )
Return cFavoritos
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetAllUsersFavoritos()
// C:\Documents and Settings\All Users\Favorites
Local cFavoritos := Nil
cFavoritos := GETSPECIALFOLDER( CSIDL_COMMON_FAVORITES )
Return cFavoritos
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetUserEscritorio()
// C:\Documents and Settings\Usuario\Escritorio
Local cEscritorio := Nil
cEscritorio := GETSPECIALFOLDER( CSIDL_DESKTOPDIRECTORY )
Return cEscritorio
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetEscritorio()
// C:\Documents and Settings\TodosUsuarios\Escritorio
Local cEscritorio := Nil
cEscritorio := GETSPECIALFOLDER( CSIDL_COMMON_DESKTOPDIRECTORY )
Return cEscritorio
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetUserMenuStart()
// C:\Documents and Settings\Usuario\Menú Inicio\Programas
Local cMenuStart := Nil
cMenuStart := GETSPECIALFOLDER( CSIDL_PROGRAMS )
Return cMenuStart
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetMenuStart()
// C:\Documents and Settings\TodosUsuarios\Menú Inicio\Programas
Local cMenuStart := Nil
cMenuStart := GETSPECIALFOLDER( CSIDL_COMMON_STARTMENU )
Return cMenuStart
/* ***************************************** */
/* ***************************************** */
FUNCTION cGetFolderUser()
// C:\Documents and Settings\Usuario
Local cMenuStart := Nil
cMenuStart := GETSPECIALFOLDER( CSIDL_PROFILE )
Return cMenuStart
/* ***************************************** */


*---------------------------------------------------------------*
Function GETSPECIALFOLDER(nCSIDL) // Contributed By Ryszard Rylko
*---------------------------------------------------------------*
RETURN C_getspecialfolder(nCSIDL)
*---------------------------------------------------------------*
#pragma BEGINDUMP

#include <windows.h>
#include <shlobj.h>

#include "hbapi.h"
#include "hbapiitm.h"

HB_FUNC( C_GETSPECIALFOLDER ) // Contributed By Ryszard RyRko
{
    char *lpBuffer = (char*) hb_xgrab( MAX_PATH+1);
    LPITEMIDLIST pidlBrowse;    // PIDL selected by user
    SHGetSpecialFolderLocation(GetActiveWindow(), hb_parni(1), &pidlBrowse)
;
    SHGetPathFromIDList(pidlBrowse, lpBuffer);
    hb_retc(lpBuffer);
    hb_xfree( lpBuffer);
}

#pragma ENDDUMP
*---------------------------------------------------------------*
 

Code: Select all  Expand view  RUN

*---------------------------------------------------
FUNCTION pLnk( cFile, cNameLnk, cWorkingDir, cIcon, cParameters )
*---------------------------------------------------
    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

    If !Empty(cParameters)
        oLnk:Arguments := cParameters
    //  Else
    //    oLnk:TargetPath       := cFile + '"' + cParameters
    EndIf

    oLnk:WindowStyle      := 3

    IF !Empty( cIcon )
        oLnk:IconLocation     := cIcon
    ENDIF

    IF !Empty( cWorkingDir )
        oLnk:WorkingDirectory := cWorkingDir
    ENDIF

*    oLnk:Description      := 'Hola calc...'
*    oLnk:Hotkey           := "CTRL+ALT+SHIFT+X"

    oLnk:Save()


RETU .T.
/* ***************************************** */
 

Code: Select all  Expand view  RUN

pLnk( cPathEXE( .T. ) + Fileexe( AMPAARRA ), cDummyPathFile, Nil,         Nil,   "/F:" + cDummyParam1 )
   // cFile,                                 cNameLnk,       cWorkingDir, cIcon, cParameters )
 

[acuellar]

Leandro

Aquí la función faltante

Code: Select all  Expand view  RUN

*
#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