Shortcut (*.lnk) from FWH

[Carles]

Hi,

Do you know as creating a shortcut (*.lnk) from FWH?

Thanks.


Regards.

[tnhoe]

sample code in Visual Foxpro, require WSH or at least XP, someone help to translete plz :-

CreateLink( 'DeskTop', "stock", "c:\stock\main.exe", "CTRL+SHIFT+C", "main.exe,0", "c:\stock" )

FUNCTION CreateLink(dest,sName,sPath,sHotKey,sIcon ,sWorkingDirectory)

WshShell = CreateObject("WScript.Shell")
DO Case
Case dest='DeskTop'
sLinkPath = WshShell.SpecialFolders("Desktop")
Case dest='StartMenu'
sLinkPath = WshShell.SpecialFolders("StartMenu")
Case dest='StartUp'
sLinkPath = WshShell.SpecialFolders("StartUp")
Case dest='Programs'
sLinkPath = WshShell.SpecialFolders("Programs")
Endcase


sLinkPath = sLinkPath + "\"
oShellLink = WshShell.CreateShortCut(sLinkPath + "\" + sName + ".lnk")
* oShellLink.WindowStyle = iWinStyle
oShellLink.HotKey = sHotKey
oShellLink.TargetPath = sPath
oShellLink.IconLocation = sIcon
oShellLink.Description = sName
oShellLink.WorkingDirectory = sWorkingDirectory
oShellLink.Save
* oShellLink=nil
* WshShell =nil

RETURN .t.

[Carles]

Hi Tnhoe,

I have adapted the code to FWH.This code works fine, but I have not been able to still solve the method SpecialFolders. If somebody solves it, I would be appreciated him sent it.

Code: Select all  Expand view

#include 'fivewin.ch'

FUNCTION Main()

  CreateLink( 'DeskTop', "My Program", "c:\temp\Test.exe", "main.exe,0", "c:\temp" )

RETU NIL

FUNCTION CreateLink( cDest, sName, sPath, sIcon, sWorkingDirectory )

    LOCAL oShell  := TOleAuto():New( "WScript.Shell" )
    LOCAL oSF     := oShell:Get( 'SpecialFolders' )
    LOCAL o
    LOCAL cTarget

*    cTarget := oSF:Get( cDest )
*    o := oShell:CreateShortCut( cTarget )

    o := oShell:CreateShortCut( 'C:\temp\Test.lnk' )

    o:TargetPath       := sPath
    o:WorkingDirectory := sWorkingDirectory
    o:Description      := sName
    o:IconLocation     := sIcon
    o:Save()

    oShell:End()

RETU NIL


Regrads.

[tnhoe]

i compile it with error :

unresolve external : _HB_FUN_TOLEAUTO

what should i include ???

[Carles]

Tnhoe,

http://fivetechsoft.com/forums/viewtopic.php?t=2855&highlight=toleauto


Regards

[sperceptivas]

I don't use Fivewin, but i hpoe this helps...

//****
FUNCTION CreateAppShorcut( cName, cLetter )
//****
LOCAL oError, oShell, oDeskTop, cDeskTop, cCurDir, cWorkingDir, nRET
//
cName := HB_OemToAnsi( cName )
cCurDir := UPPER( CURDIR() )
IF ( cWorkingDir := CURDRIVE() ) == "\"
cWorkingDir := MapToNextDrive( @cCurDir )
DiskChange( cWorkingDir )
cWorkingDir += "\" + cCurDir + "\"
ELSE
cWorkingDir += ":\" + cCurDir + "\"
ENDIF
TRY
oShell := CreateObject( "WScript.Shell" )
oDesktop := oShell:SpecialFolders()
cDeskTop := oDesktop:Item( "DeskTop" )
fErase( cDesktop + "\Sistema Integrado F‚nix 2005.lnk" )
//
IF ! FILE( cDesktop + "\" + cName + ".lnk" )
WITH OBJECT ( oShell:CreateShortcut( cDesktop + "\" + cName + ".lnk" ) )
:WindowStyle := 1
:HotKey := "CTRL+SHIFT+" + cLetter
:IconLocation := cWorkingDir + "_SYSTEM\IMAGES\Fenix2006.ico"
escription := HB_OemToAnsi( ;
"F‚nix - Sistema Integrado de Informaci¢n por Soluciones Perceptivas" )
:WorkingDirectory := cWorkingDir
:TargetPath := cWorkingDir + "Fenix2k.exe"
:Save()
END
ENDIF
//
fErase( cDesktop + HB_OemToAnsi( "\Conexi¢n Remota.lnk" ) )
//
cDesktop += HB_OemToAnsi( "\Conexi¢n-Remota.lnk" )
IF ! FILE( cDesktop )
WITH OBJECT ( oShell:CreateShortcut( cDesktop ) )
:WindowStyle := 1
:HotKey := "CTRL+SHIFT+R"
:IconLocation := cWorkingDir + "_SYSTEM\IMAGES\Fenix01.ico"
escription := HB_OemToAnsi( "Conexi¢n Remota con Servidores de Soluciones Perceptivas" )
:WorkingDirectory := cWorkingDir
:TargetPath := cWorkingDir + "\_SYSTEM\SERVER\SPremote.exe"
:Save()
END
ENDIF
CATCH oError
//
END
//
RETURN ( oError = NIL )

//****
FUNCTION MapToNextDrive( cShare )
//****
LOCAL i, cDrive, lDone := .F., WshNetwork
//
TRY
WshNetwork := CreateObject( "WScript.Network" )
cRealShare := "\" + STRTRAN( cShare, "\SP\FENIX2K", "" )
cShare := "SP\FENIX2K"
FOR i := 26 TO 5 STEP -1
TRY
cDrive := CHR( i + 64 ) + ":"
WshNetwork:MapNetworkDrive( cDrive, cRealShare, .T. )
lDone := .T.
CATCH
lDone := .F.
END
IF ( lDone )
EXIT
ENDIF
NEXT
CATCH
cDrive := SPACE(0)
END
//
RETURN ( cDrive )

[Carles]

Hi,

My contribution.

Code: Select all  Expand view

#include "FiveWin.ch"

*
* Clase        : ZLnk()
* Descripcion  : Crear accesos directos
* Autor        : Carles Aubia
* Fecha        : 04.07.2006
* Observaciones: El acceso Ole se hace con la clase TOleAuto
*


/*  Test

*--------------
FUNCTION Main()
*--------------

    LOCAL o

    o := ZLnk():New( 'c:\winnt\system32\calc.exe' )
    o:Run()

    o := ZLnk():New( 'c:\winnt\system32\calc.exe' )
    o:cNameLnk     := 'Calculadora.lnk'
    o:cDescription := 'Calculadora del sistema'
    o:Run()



RETU NIL

*/


// cFolder: DeskTop, StartMenu, StartUp, Programs
// cHotKey: "CTRL+SHIFT+C"

*---------
CLASS ZLnk
*---------

    DATA cFolder            AS CHARACTER INIT 'Desktop'
    DATA cWindowStyle       AS NUMERIC   INIT 1
    DATA cFile              AS CHARACTER INIT ''
    DATA cWorkingDirectory  AS CHARACTER INIT ''
    DATA cDescription       AS CHARACTER INIT ''
    DATA cIconLocation      AS CHARACTER INIT ''
    DATA cNameLnk           AS CHARACTER INIT ''
    DATA cHotKey            AS CHARACTER INIT ''

    METHOD New( cFile )  CONSTRUCTOR

    METHOD Run()

ENDCLASS


*-----------------------------
METHOD New( cFile ) CLASS ZLnk
*-----------------------------

    ::cFile := cFile

RETU Self


*----------------------
METHOD Run() CLASS ZLnk
*----------------------
    LOCAL oShell, oSF, o
    LOCAL cTarget

    IF !File( ::cFile )
       RETU .F.
    ENDIF

    IF Empty( ::cNameLnk )
       ::cNameLnk := cFileNoExt( ::cFile ) + '.lnk'
    ENDIF

    oShell  := TOleAuto():New( "WScript.Shell" )

    IF oShell:hObj == 0
       RETU .F.
    ENDIF

    oSF     := oShell:Get( 'SpecialFolders' )

    cTarget := oSF:Item( ::cFolder )

    IF Empty( cTarget )
       RETU .F.
    ENDIF

    o := oShell:CreateShortCut( cTarget + '' + ::cNameLnk )

    o:WindowStyle      := ::cWindowStyle
    o:TargetPath       := ::cFile
    o:WorkingDirectory := ::cWorkingDirectory
    o:Description      := ::cDescription
    o:IconLocation     := ::cIconLocation
    o:HotKey           := ::cHotKey

    o:Save()

RETU .T.


Regards

[Enrico Maria Giordano]

I get the following error:

Error description: Error WScript.Shell:CREATESHORTCUT/16389 E_FAIL: _ICONLOCATION
Args:
[ 1] = C

Stack Calls
===========
Called from: win32ole.prg => TOLEAUTO:_ICONLOCATION(0)
Called from: CREATELINK.prg => ZLNK:RUN(101)
Called from: CREATELINK.prg => MAIN(21)

EMG

[Carles]

Enrico,

Can you try ?

Code: Select all  Expand view

#include "FiveWin.ch"

*
* Clase        : ZLnk()
* Descripcion  : Crear accesos directos
* Autor        : Carles Aubia
* Fecha        : 04.07.2006
* Modificacion : 05.07.2006
* Observaciones: El acceso Ole se hace con la clase TOleAuto
*


/*  Test

*--------------
FUNCTION Main()
*--------------

    LOCAL o

    o := ZLnk():New( 'c:\winnt\system32\calc.exe' )
    o:Run()

    o := ZLnk():New( 'c:\winnt\system32\calc.exe' )
    o:cNameLnk      := 'Calculadora.lnk'
    o:cDescription  := 'Calculadora del sistema'
    o:cIconLocation := 'c:\temp\alert.ico'

    Msginfo( o:IsLnk() )

    o:Run()


RETU NIL

*/


// cFolder: DeskTop, StartMenu, StartUp, Programs
// cHotKey: "CTRL+SHIFT+C"

*---------
CLASS ZLnk
*---------

    DATA cFolder            AS CHARACTER INIT 'Desktop'
    DATA nWindowStyle       AS NUMERIC   INIT 1
    DATA cFile              AS CHARACTER INIT ''
    DATA cWorkingDirectory  AS CHARACTER INIT ''
    DATA cDescription       AS CHARACTER INIT ''
    DATA cIconLocation      AS CHARACTER INIT ''
    DATA cNameLnk           AS CHARACTER INIT ''
    DATA cHotKey            AS CHARACTER INIT ''

    METHOD New( cFile )  CONSTRUCTOR

    METHOD IsLnk()

    METHOD Run()

ENDCLASS


*-----------------------------
METHOD New( cFile ) CLASS ZLnk
*-----------------------------

    ::cFile := cFile

RETU Self


*----------------------
METHOD Run() CLASS ZLnk
*----------------------
    LOCAL oShell, oSF, o
    LOCAL cTarget

    IF !File( ::cFile )
       RETU .F.
    ENDIF

    IF Empty( ::cNameLnk )
       ::cNameLnk := cFileNoExt( ::cFile ) + '.lnk'
    ENDIF

    oShell  := TOleAuto():New( "WScript.Shell" )

    IF oShell:hObj == 0
       RETU .F.
    ENDIF

    oSF     := oShell:Get( 'SpecialFolders' )

    cTarget := oSF:Item( ::cFolder )

    IF Empty( cTarget )
       RETU .F.
    ENDIF

    o := oShell:CreateShortCut( cTarget + '' + ::cNameLnk )

    o:WindowStyle      := ::nWindowStyle
    o:TargetPath       := ::cFile
    o:WorkingDirectory := IF( !Empty( ::cWorkingDirectory ), ::cWorkingDirectory, NIL )
    o:Description      := IF( !Empty( ::cDescription      ), ::cDescription     , NIL )
    o:IconLocation     := IF( !Empty( ::cIconLocation     ), ::cIconLocation    , NIL )
    o:HotKey           := IF( !Empty( ::cHotKey           ), ::cHotKey          , NIL )

    o:Save()

RETU .T.

*------------------------
METHOD IsLnk() CLASS ZLnk
*------------------------
    LOCAL oShell, oSF, o
    LOCAL cTarget
    LOCAL cFileLnk

    IF !File( ::cFile )
       RETU .F.
    ENDIF

    IF Empty( ::cNameLnk )
       ::cNameLnk := cFileNoExt( ::cFile ) + '.lnk'
    ENDIF

    oShell  := TOleAuto():New( "WScript.Shell" )

    IF oShell:hObj == 0
       RETU .F.
    ENDIF

    oSF     := oShell:Get( 'SpecialFolders' )

    cTarget := oSF:Item( ::cFolder )

    IF Empty( cTarget )
       RETU .F.
    ENDIF

    cFileLnk := cTarget + '' + ::cNameLnk

RETU File( cFileLnk )



Regards.

[Enrico Maria Giordano]

Same error:

Error description: Error WScript.Shell:CREATESHORTCUT/16389 E_FAIL: _ICONLOCATION
Args:
[ 1] = U

Stack Calls
===========
Called from: win32ole.prg => TOLEAUTO:_ICONLOCATION(0)
Called from: CREATELINK2.prg => ZLNK:RUN(107)
Called from: CREATELINK2.prg => MAIN(22)

EMG

[Carles]

Hi,

I use it in W2000 and work fine. Perhaps, you should eliminate temporaly the line " o:IconLocation := IF( !Empty( ::cIconLocation ), ::cIconLocation , NIL ) "

Regards.

[Enrico Maria Giordano]

Yes, it works removing o:IconLocation assignment.

I'm using Windows XP Pro SP2.

EMG

[RAMESHBABU]

Mr.Carles

Excellent contribution.

Keep it up.

Regards to you,

- Ramesh Babu P