ZLINK

[Silvio.Falconi]

Someone have this class run on win 7 or win 10 ?
or have a function to create lnk on desktop ? thanks

[cnavarro]

viewtopic.php?f=3&t=20590&p=109376&hilit=Create+shortcut+on+desktop#p109376

[Silvio.Falconi]

not run

[karinha]

Code: Select all  Expand view

// 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 ********************************************
 

[karinha]

Code: Select all  Expand view

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.

[Silvio.Falconi]

iMUST WRITE A COMAND WITH PARAMETERS
SAMPLE

TEST.EXE XXXX XXXX

[Silvio.Falconi]

it create the link but write the command bad
I explain you

aShortCut := oWSHShell:CreateShortcut( strDesktop + "\" + cTitulo + ".lnk" )
aShortCut:Description := "EasyBus 1.00"
aShortCut:WindowStyle := 1
aShortCut:IconLocation := 'C:\work\errori\tavoli\bus.ico'
aShortCut:WorkingDirectory := 'C:\work\errori\tavoli\'
aShortCut:TargetPath := 'C:\work\errori\tavoli\test.exe 1024 700'


this line aShortCut:TargetPath := 'C:\work\errori\tavoli\test.exe 1024 700'

write the command 'C:\work\errori\tavoli\test.exe 1024 700' with "

but if I eraseit with hand on lnk then the lnk run ok

[Silvio.Falconi]

resolved !!!
now run ok

[karinha]

Very well. In the future, test before you complain. It is very difficult to understand your questions. Greetings.

[Silvio.Falconi]

I resolved seeing on https://stackoverflow.com
the problem was the parameters give to exe

I correct your source
see aShortCut:Arguments := cArguments

Code: Select all  Expand view

#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.
//--------------------------------------------------------------------------------------------------------//

[karinha]

Very good!! Congratulations.