Hi,
Do you know as creating a shortcut (*.lnk) from FWH?
Thanks.
Regards.
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.
#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 NILi compile it with error :
unresolve external : _HB_FUN_TOLEAUTO
what should i include ???
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 )
#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.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)
#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 )Same error:
Error description: Error WScript.Shell:CREATESHORTCUT/16389 E_FAIL: _ICONLOCATION
Args:
[ 1] = U
Called from: win32ole.prg => TOLEAUTO:_ICONLOCATION(0)
Called from: CREATELINK2.prg => ZLNK:RUN(107)
Called from: CREATELINK2.prg => MAIN(22)
EMG
Hi,
I use it in W2000 and work fine. Perhaps, you should eliminate temporaly the line " o:IconLocation := IF( !Empty( ::cIconLocation ), ::cIconLocation , NIL ) "
Regards.
Yes, it works removing o:IconLocation assignment.
I'm using Windows XP Pro SP2.
EMG
Mr.Carles
Excellent contribution.
Keep it up.
Regards to you,
