Page 1 of 1
Shortcut (*.lnk) from FWH
Posted: Thu Jun 29, 2006 11:22 am
by Carles
Hi,
Do you know as creating a shortcut (*.lnk) from FWH?
Thanks.
Regards.
Posted: Thu Jun 29, 2006 5:54 pm
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.
Posted: Fri Jun 30, 2006 8:23 am
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.
Posted: Fri Jun 30, 2006 1:53 pm
by tnhoe
i compile it with error :
unresolve external : _HB_FUN_TOLEAUTO
what should i include ???
Posted: Mon Jul 03, 2006 11:43 am
by Carles
.Lnk for FWH
Posted: Tue Jul 04, 2006 5:30 am
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 )
Posted: Tue Jul 04, 2006 10:21 am
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
Posted: Tue Jul 04, 2006 12:34 pm
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
Posted: Wed Jul 05, 2006 6:30 am
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.
Posted: Wed Jul 05, 2006 8:50 am
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
Posted: Wed Jul 05, 2006 11:20 am
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.
Posted: Wed Jul 05, 2006 12:26 pm
by Enrico Maria Giordano
Yes, it works removing o:IconLocation assignment.
I'm using Windows XP Pro SP2.
EMG
Posted: Tue Dec 12, 2006 8:41 am
by RAMESHBABU
Mr.Carles
Excellent contribution.
Keep it up.
Regards to you,
- Ramesh Babu P