Someone have this class run on win 7 or win 10 ?
or have a function to create lnk on desktop ? thanks
// Criar Icone de Atalho no Desktop ********************************************
FUNCTION CriarIconeDesktop( cTitulo )
LOCAL aShortCut, oWSHShell
IF FILE( GETENV('HOMEDRIVE') + GETENV('HOMEPATH') + "\Desktop\" + cTitulo + ".lnk")
RETURN NIL
ENDIF
IF !MsgYesNo( "Não foi localizado o Ícone do Sistema no DeskTop !" + CRLF + CRLF + "Deseja Criar Agora ?", "Aviso do Sistema" )
RETURN NIL
ENDIF
TRY
oWSHShell := CreateObject( "WScript.Shell" )
CATCH error
MsgStop( "Não foi possível criar o Ícone do Sistema no DeskTop !" + CRLF + CRLF + "Entre em Contato com o Administrador do Sistema.", "Erro de Criação" )
RETURN .F.
END TRY
IF !IsDirectory( GETENV("HOMEDRIVE") + GETENV("HOMEPATH") + "\Desktop" )
RELEASE oWSHShell
RETURN .F.
ENDIF
aShortCut := oWSHShell:CreateShortcut( GETENV('HOMEDRIVE') + GETENV('HOMEPATH') + "\Desktop\" + cTitulo + ".lnk" )
aShortCut:TargetPath := CaminhoExecutavel() + "\" + NomeExecutavel()
aShortCut:WorkingDirectory := CaminhoExecutavel() + "\"
aShortCut:Save()
RELEASE oWSHShell
IF !FILE( GETENV('HOMEDRIVE') + GETENV('HOMEPATH') + "\Desktop\" + cTitulo + ".lnk" )
RETURN .F.
ENDIF
RETURN .T.
FUNCTION NomeExecutavel( lPath )
LOCAL nPos, cRet
IF EMPTY(lpath)
nPos := RAT( "\", hb_Argv(0) )
cRet := SUBS( hb_Argv(0), nPos+1 )
ELSE
cRet := hb_Argv(0)
ENDIF
RETURN cRet
FUNCTION CaminhoExecutavel()
RETURN SUBS( NomeExecutavel( .T. ), 1, ( LEN( NomeExecutavel( .T. ) ) - LEN( NomeExecutavel() ) ) - 1 )
// Criar Icone de Atalho no Desktop ********************************************
FUNCTION Main()
LOCAL cTitulo := "Nome do Seu Aplicativo"
CriarIconeDesktop( cTitulo )
RETURN NIL
// Criar Icone de Atalho no Desktop ********************************************
FUNCTION CriarIconeDesktop( cTitulo )
LOCAL aShortCut, oWSHShell, strDesktop := ""
oReg := TReg32():New( HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders" )
strDesktop := oReg:Get("Desktop")
oReg:Close()
IF LEFT(strDesktop,1) == "%"
strDesktop := GETENV('USERPROFILE') + "\Desktop\"
ENDIF
IF FILE( strDesktop + "\" + cTitulo + ".lnk" )
RETURN NIL
ENDIF
IF !MsgYesNo( "Não foi localizado o Ícone do Sistema no DeskTop !" + CRLF + CRLF + "Deseja Criar Agora ?", "Aviso do Sistema" )
RETURN NIL
ENDIF
TRY
oWSHShell := CreateObject( "WScript.Shell" )
CATCH error
MsgStop( "Não foi possível criar o Ícone do Sistema no DeskTop !" + CRLF + CRLF + "Entre em Contato com o Administrador do Sistema.", "Erro de Criação" )
RETURN .F.
END TRY
aShortCut := oWSHShell:CreateShortcut( strDesktop + "\" + cTitulo + ".lnk" )
aShortCut:TargetPath := CaminhoExecutavel() + "\" + NomeExecutavel()
aShortCut:WorkingDirectory := CaminhoExecutavel() + "\"
aShortCut:Description := "Aplicativo para Gerenciamento Administrativo"
aShortCut:WindowStyle := 1
aShortCut:Save()
RELEASE oWSHShell
RELEASE aShortCut
RETURN .T.
#include "FiveWin.ch"
// creare le icone sul desktop
#define HKEY_CURRENT_USER 2147483649
#define HKEY_LOCAL_MACHINE 2147483650
FUNCTION Main()
Local cTitle := "EasyBus 1.00"
Local cFile := 'C:\work\errori\tavoli\test.exe'
]Local cArguments := "1024 700"
Local cWorkingDirectory := 'C:\work\errori\tavoli'
Local cIconPath := 'C:\work\errori\tavoli\bus.ico'
Local cDescription := "EasyBus 1.00"
Local nWindowsStyle := 6
CreateIconeDesktop(cTitle,cFile,cDescription,cArguments,cIconPath,cWorkingDirectory,nWindowsStyle)
RETURN NIL
//------------------------------------------------------------------------------------------------//
Function CreateIconeDesktop(cTitle,cFile,cDescription,cArguments,cIconPath,cWorkingDirectory,nWindowsStyle)
LOCAL aShortCut, oWSHShell, strDesktop := ""
oReg := TReg32():New( HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders" )
strDesktop := oReg:Get("Desktop")
oReg:Close()
IF LEFT(strDesktop,1) == "%"
strDesktop := GETENV('USERPROFILE') + "\Desktop\"
ENDIF
IF FILE( strDesktop + "\" + cTitle + ".lnk" )
RETURN NIL
ENDIF
IF !MsgYesNo( "Non è stato trovato nella icona di sistema desktop" + CRLF + CRLF + "Desideri crearlo ora ?", "Attenzione" )
RETURN NIL
ENDIF
TRY
oWSHShell := CreateObject( "WScript.Shell" )
CATCH error
MsgStop( "Impossibile creare l'icona di sistema sul desktop !", "Errore" )
RETURN .F.
END TRY
aShortCut := oWSHShell:CreateShortcut( strDesktop + "\" + cTitle + ".lnk" )
IF !Empty( nWindowsStyle )
aShortCut:Description := cDescription
Endif
IF !Empty( nWindowsStyle )
aShortCut:WindowStyle := nWindowsStyle
else
aShortCut:WindowStyle := 4
Endif
IF !Empty( cIconPath )
aShortCut:IconLocation := cIconPath
Endif
IF !Empty( cWorkingDirectory )
aShortCut:WorkingDirectory := cWorkingDirectory
Endif
aShortCut:TargetPath := cFile
If !empty(cArguments)
aShortCut:Arguments := cArguments
Endif
aShortCut:Save()
RELEASE oWSHShell
RELEASE aShortCut
RETURN .T.
//--------------------------------------------------------------------------------------------------------//
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 42 guests