Shortcut (*.lnk) from FWH

Post Reply
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Shortcut (*.lnk) from FWH

Post by Carles »

Hi,

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

Thanks.


Regards.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
tnhoe
Posts: 83
Joined: Tue Nov 08, 2005 11:09 am
Location: Malaysia
Contact:

Post by 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.
Regards

Hoe, email: easywin3@yahoo.com
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by 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

#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.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
tnhoe
Posts: 83
Joined: Tue Nov 08, 2005 11:09 am
Location: Malaysia
Contact:

Post by tnhoe »

i compile it with error :

unresolve external : _HB_FUN_TOLEAUTO

what should i include ???
Regards

Hoe, email: easywin3@yahoo.com
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by Carles »

Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
sperceptivas
Posts: 1
Joined: Sat Jun 24, 2006 1:10 am

.Lnk for FWH

Post by 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"
:Description := 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"
:Description := 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 )
Julio C. Cantillo Molina
Bucaramanga, Colombia
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by Carles »

Hi,

My contribution.

Code: Select all

#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
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
Enrico Maria Giordano
Posts: 7355
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia
Contact:

Post by 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
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by Carles »

Enrico,

Can you try ?

Code: Select all

#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.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
Enrico Maria Giordano
Posts: 7355
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia
Contact:

Post by 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
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by 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.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
Enrico Maria Giordano
Posts: 7355
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia
Contact:

Post by Enrico Maria Giordano »

Yes, it works removing o:IconLocation assignment.

I'm using Windows XP Pro SP2.

EMG
User avatar
RAMESHBABU
Posts: 591
Joined: Fri Oct 21, 2005 5:54 am
Location: Secunderabad (T.S), India

Post by RAMESHBABU »

Mr.Carles

Excellent contribution.

Keep it up.

Regards to you,

- Ramesh Babu P
Post Reply