create a desktop shortcut directly from the program

[hag]

I have a program that will set up 4 identical programs (exes) in 4 folders on a net work. Is there a way to set up a shortcut on the network directly from the program to the copies of the exes in their separate folders???

[James Bott]

Harvey,

Can you just do that with the install program?

Regards,
James

[hag]

James took your advice and programmed the install to do what I wank. Thanks.

[ukservice]

Try:

cUser:= GetEnv( "USERPROFILE" )
I
f Left(cUser,8)="C:\Users" //Language of SO
cEscritorio:=cUser+"\desktop\file.lnk"
Else
cEscritorio:=cUser+"\escritorio\file.lnk"
Endif

COPY FILE C:\FILE.LNK TO (cEscritorio)

[pcordonet]

You can try::

File: "shortcut.c"

Code: Select all  Expand view  RUN

#pragma BEGINDUMP

#define _WIN32_IE 0x0500
#define HB_OS_WIN_32_USED
#define _WIN32_WINNT 0x0400


#include <windows.h>
#include <commctrl.h>
#include <shlobj.h>
#include <hbapi.h>
#include "hbstack.h"
#include "hbapiitm.h"
#include "winreg.h"
#include "tchar.h"


#define HB_OS_WIN_32_USED

#define _WIN32_WINNT 0x0400
// #define OEMRESOURCE
#include <windows.h>
#include <shlobj.h>
#include "hbapi.h"
#include "hbapiitm.h"

#define  ID_NOTIFYICON   1
#define  WM_NOTIFYICON   WM_USER+1000

#ifndef BIF_USENEWUI
#ifndef BIF_NEWDIALOGSTYLE
#define BIF_NEWDIALOGSTYLE     0x0040   // Use the new dialog layout with the ability to resize
#endif
#define BIF_USENEWUI           (BIF_NEWDIALOGSTYLE | BIF_EDITBOX)
#endif



// link executor *******************
void ChangePIF(LPCSTR cPIF);
HRESULT WINAPI CreateLink(LPSTR lpszLink, LPSTR lpszPathObj,LPSTR szWorkPath,LPSTR lpszIco, int nIco,LPSTR szDescription);

HB_FUNC( CREATEFILELINK )
{
   hb_retnl( (LONG) CreateLink( hb_parc(1), hb_parc(2), hb_parc(3),hb_parc(4), hb_parni(5) ,hb_parc(6) ) );
}

void ChangePIF(LPCSTR cPIF)
{
   UCHAR buffer[1024];
   HFILE h;
   long filesize;
   
   strcpy(buffer, cPIF);
   strcat(buffer, ".pif");
   if ((h=_lopen(buffer, 2))>0)
   {
      filesize=_hread(h, &buffer, 1024);
      buffer[0x63]=0x10; // Cerrar al salir
      buffer[0x1ad]=0x0a; // Pantalla completa
      buffer[0x2d4]=0x01;
      buffer[0x2c5]=0x22; // No Permitir protector de pantalla
      buffer[0x1ae]=0x11; // Quitar ALT+ENTRAR
      buffer[0x2e0]=0x01;
      _llseek(h, 0, 0);
      _hwrite(h, buffer, filesize);
      _lclose(h);
   }
}


// Canviem el pif
HB_FUNC( CHANGE_PIF )
{
   ChangePIF( hb_parc(1) )   ;
}


HRESULT WINAPI CreateLink(LPSTR lpszLink, LPSTR lpszPathObj,LPSTR  szWorkPath,LPSTR lpszIco, int nIco,LPSTR szDescription)
{
   long hres;
   IShellLink * psl;

   hres = CoInitialize(NULL);
   if (SUCCEEDED(hres))
   {
      hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, &IID_IShellLink, ( LPVOID ) &psl);

      if (SUCCEEDED(hres))
      {

         IPersistFile * ppf;

         psl->lpVtbl->SetPath(psl, lpszPathObj);
         psl->lpVtbl->SetIconLocation(psl, lpszIco, nIco);
         psl->lpVtbl->SetWorkingDirectory(psl, szWorkPath);
         psl->lpVtbl->SetDescription(psl,szDescription);

         hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile,( LPVOID ) &ppf);

         if (SUCCEEDED(hres))
         {
            WORD wsz[MAX_PATH];
            char appPath[MAX_PATH];
   
            strcpy(appPath, lpszLink);
            strcat(appPath, ".lnk");

            MultiByteToWideChar(CP_ACP, 0, appPath, -1, wsz, MAX_PATH);

            hres = ppf->lpVtbl->Save(ppf, wsz, TRUE);
            ppf->lpVtbl->Release(ppf);

            // modificar el PIF para los programas MS-DOS
            ChangePIF(lpszLink);

         }
         psl->lpVtbl->Release(psl);
      }
      CoUninitialize();
   }
   return hres;
}

HB_FUNC( C_GETSPECIALFOLDER ) // Contributed By Ryszard RyRko
{
    char *lpBuffer = (char*) hb_xgrab( MAX_PATH+1);
    LPITEMIDLIST pidlBrowse;    // PIDL selected by user
    SHGetSpecialFolderLocation(GetActiveWindow(), hb_parni(1), &pidlBrowse)  
;
    SHGetPathFromIDList(pidlBrowse, lpBuffer);
    hb_retc(lpBuffer);
    hb_xfree( lpBuffer);
}

// eop link executor *******************


#pragma ENDDUMP-------------------------------------------------------

 

Prg file : XXX.prg

Code: Select all  Expand view  RUN

*-------------------------------------------------------
Procedure CreateLink( lDesk, lMenu )
*--------------------------------------------------------*
local cDesktop := GetSpecialFolder( CSIDL_DESKTOPDIRECTORY )
local cMenuPrgs := GetSpecialFolder( CSIDL_PROGRAMS )
local cLinkName := "proves"
local cExeName := ExeName()
Local cFilePath
local cIco := ""


If CurDrive() = "@"
   cFilePath:= NetRmtName( CurDrive()+":" )+"\"+CURDIR()
Else
   cFilePath:= CurDrive()+":\"+CURDIR()
EndIf  

cIco := cExeName

if lDesk && desktop
   if CreateFileLink( cDesktop + "\" + cLinkName, cExeName,cFilePath,cIco ) # 0
      Duda( "Create Link Error!", "Acceptar")
   endif
endif

if lMenu && menu start
   if CreateFileLink( cMenuPrgs + "\" + cLinkName, cExeName,cFilePath,cIco ) # 0
      Duda( "Create Link Error!", "Acceptar")
   endif
endif

Return

I hope that you have helped.
Pere

[hag]

Thank you all for the help. Working great.

[RAMESHBABU]

Hi,

You can even try this simple class. Works great.

- Ramesh Babu

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

*****************************************************************************
*** Class         : ZLnk()                                                ***
*** Descripction  : To Create Shortcut Links                              ***
*** Author        : Carles Aubia                                          ***
*** Created on    : 04.07.2006                                            ***
*****************************************************************************

FUNCTION Main()

LOCAL o

o := ZLnk():New( 'C:\Windows\system32\notepad.exe' )

o:cFolder := 'Programs' //o:cFolder := 'DeskTop' or 'StartMenu' or 'StartUp' or 'Programs'

o:Run()

/*
o := ZLnk():New( 'C:\xHarbour\bin\Harbour.exe' )
o:cNameLnk          := 'Harbour.lnk'
o:cFolder           := 'DeskTop'  
o:cDescription      := 'xHarbour'
o:cWorkingDirectory := o:cFolder
o:cIconLocation     :='C:\xHarbour\bin'
o:cHotKey           := "CTRL+SHIFT+H"
o:Run()
*/

RETURN nil

*****************************************************************************
*** ZLnk Class                                                            ***                    
*****************************************************************************

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

METHOD New( cFile ) CLASS ZLnk

::cFile := cFile

RETURN Self

*****************************************************************************
*** METHOD Run() CLASS ZLnk                                               ***
*****************************************************************************

METHOD Run() CLASS ZLnk

LOCAL oShell, oSF, o
LOCAL cTarget

IF !File( ::cFile )
   RETURN .F.
ENDIF

IF Empty( ::cNameLnk )
   ::cNameLnk := cFileNoExt( ::cFile ) + '.lnk'
ENDIF

oShell := TOleAuto():New( "WScript.Shell" )

IF oShell:hObj == 0
   RETURN .F.
ENDIF

oSF     := oShell:Get( 'SpecialFolders' )
cTarget := oSF:Item( ::cFolder )

IF Empty( cTarget )
   RETURN .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()

RETURN .T.

**************************
*** EOF() SHORTCUT.PRG ***
**************************

[Ari]

Ramesh Babu,

Alright?, this post is from 2011, and I tried to run it on Windows 7 32bits
and I did as in the example, but it does not create the shortcut.

Do you remember this post?

Code: Select all  Expand view  RUN

* =======================================================================================
FUNCTION CriaLink()
* =======================================================================================
  local o

  o:= ZLnk():New( CurDrive() + ":" + DirWin() + "sisrevH.exe" )  
  o:cWindowStyle           := 1
  o:cFolder                := "Desktop"
  o:cNameLnk               := "Sisrev-Win.lnk"
  o:cDescription           := "Aplicativo Sisrev-Win"
  o:cWorkingDirectory      := "c:\sisrev\win"
  o:cIconLocation          := DirWin()
  o:Run()

  MsgInfo("Concluido","Sisrev-Ass")
 
return nil

*=======================================================================================
*** ZLnk Class                                                            ***                    
*=======================================================================================

CLASS ZLnk

DATA cFolder            AS CHARACTER INIT 'Desktop'
DATA cWindowStyle       AS NUMERIC   INIT 3
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

return Self

*=======================================================================================
METHOD Run() CLASS ZLnk
*=======================================================================================
  local oShell, oSF, o
  local cTarget
 
  if !File( ::cFile )
     return .F.
  Endif

  if Empty( ::cNameLnk )
     ::cNameLnk := cFileNoExt( ::cFile ) + '.lnk'
  Endif
   
  TRY
    oShell := CreateObject( "WScript.Shell" )
  CATCH
      MsgAlert('Error Create object WScript.Shell', 'Error' )
      RETU  .F.
  END

  oSF     := oShell:Get( 'SpecialFolders' )
  cTarget := oSF:Item( ::cFolder )
 
  if Empty( cTarget )
     return .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()
 
return .T.

 

[Jimmy]

hi,

try this without HB_FUNC

Code: Select all  Expand view  RUN

FUNCTION DXE_CreateLink( cLinkTarget, cLinkFile, cWorkingDir, cCmdArgs, cDescr, aHotKey, aIcon )
LOCAL lSuccess       := .F.
LOCAL nPosi          := 0
LOCAL cPath          := ""
LOCAL cFile          := ""
LOCAL cName          := ""
LOCAL oShell
LOCAL oFolder
LOCAL oStorageFolder
LOCAL oShellLink
LOCAL nHandle
LOCAL i, iMax
LOCAL nLoByte
LOCAL nHiByte

   DEFAULT cWorkingDir TO ""
   DEFAULT cCmdArgs TO ""
   DEFAULT cDescr TO ""
   DEFAULT aHotKey TO {}
   DEFAULT aIcon TO {}

   IF !EMPTY( cLinkTarget )
      nPosi := RAT( "\", cLinkFile )
      IF nPosi > 0
         cPath := SUBSTR( cLinkFile, 1, nPosi - 1 )
         cFile := SUBSTR( cLinkFile, nPosi + 1 )
      ENDIF

      // create empty file with 0 (zero) byte
      nHandle := FCREATE( cLinkFile, FC_NORMAL )
      FCLOSE( nHandle )
   ENDIF

   IF !EMPTY( cPath ) .AND. !EMPTY( cFile ) .AND. FILE( cLinkFile )
      oShell := CreateObject( "shell.application" )
      oFolder := oShell:NameSpace( cPath )
      oStorageFolder := oFolder:ParseName( cFile )

      IF !EMPTY( oStorageFolder )
         oShellLink := oStorageFolder:GetLink
         IF !EMPTY( oShellLink )
            // set Property
            oShellLink:Path := cLinkTarget
            oShellLink:WorkingDirectory := cWorkingDir
            oShellLink:Arguments := cCmdArgs
            oShellLink:Description := cDescr
            oShellLink:ShowCommand := 1

            // Shortcut Hotkey
            IF !EMPTY( aHotKey ) .AND. VALTYPE( aHotKey ) = "A"
               IF LEN( aHotKey ) = 2
                  nLoByte := aHotKey[ 1 ]
                  nHiByte := aHotKey[ 2 ]
               ENDIF
            ENDIF

            // Icon need Method
            IF !EMPTY( aIcon ) .AND. VALTYPE( aIcon ) = "A"
               IF LEN( aIcon ) = 2
                  oShellLink:SetIconLocation( aIcon[ 1 ], aIcon[ 2 ] )
               ENDIF
            ENDIF

            // now save
            oShellLink:Save( cLinkFile )

            lSuccess := .T.
         ENDIF
      ENDIF

      oShellLink := NIL
      oStorageFolder := NIL
      oFolder := NIL
      oShell := NIL

   ENDIF

RETURN lSuccess

btw. here opposite Function

Code: Select all  Expand view  RUN

FUNCTION DXE_ResolveLink( cFull )
LOCAL oShell
LOCAL oFolder
LOCAL oStorageFolder
LOCAL oShellLink
LOCAL cPath          := ""
LOCAL cItem          := ""
LOCAL nPosi          := 0
LOCAL cTarget        := ""
LOCAL cPara          := ""

   IF !EMPTY( cFull )
      nPosi := RAT( "\", cFull )
      IF nPosi > 0
         cPath := SUBSTR( cFull, 1, nPosi )
         cItem := SUBSTR( cFull, nPosi + 1 )

         oShell := CreateObject( "shell.application" )
         oFolder := oShell:NameSpace( cPath )
         oStorageFolder := oFolder:ParseName( cItem )

         IF !EMPTY( oStorageFolder )
            oShellLink := oStorageFolder:GetLink
            IF !EMPTY( oShellLink )
               cTarget := oShellLink:Path
               cPara := oShellLink:Arguments
            ENDIF
         ENDIF

         oStorageFolder := NIL
         oFolder := NIL
         oShell := NIL
      ENDIF
   ENDIF

RETURN cTarget + IF( EMPTY( cPara ), "", CHR( 0 ) + cPara )

[Ari]

Jimmy,

It didn't work, how do I put the parameters

Code: Select all  Expand view  RUN

cLinkTarget    := CurDrive() + ":" + DirWin() + "sisrevH.exe"
cLinkFile      := "SisrevWin.lnk"
cWorkingDir    := "c:\sisrev\win\"
cDescr         := "Aplicativo"

DXE_CreateLink( cLinkTarget , cLinkFile  , cWorkingDir  )

[Jimmy]

hi Ari,

try this

Code: Select all  Expand view  RUN

PROCEDURE MAIN
LOCAL cLinkTarget := Getenv("windir")+"\Notepad.exe"            // EXE, BAT
LOCAL cLinkFile   := Getenv("USERPROFILE")+"\Desktop\Test1.LNK" // where create
LOCAL cWorkingDir := Getenv("USERPROFILE")+"\Desktop"           // working Dir
LOCAL cCmdArgs    := "README.TXT"                               // Parameter
LOCAL cDescr      := "Test Create Link with Icon and Hotkey"    // Description

/***************************************
* aHotKey[1] -> ASCI Number e.g. ASC("Z")
* aHotKey[2] -> CTRL+ALT -> 2+4
*
* (1)   SHIFT key
* (2)   CTRL key
* (4)   ALT key
* (8)   Extended key
***************************************/
LOCAL aHotKey     := {ASC("Z"),2+4}        // UPPER(A-Z)
LOCAL aIcon       := { AppName(.T.), 1 }   // { FullpathName, Index }

// Shell Resource Icon Index zero-based
//
// aIcon := {"shell32.dll", 3 }
// aIcon := {cAppPath+"Strait.ico", 0 }

   CLS

   IF FILE(cLinkFile)
      FErase(cLinkFile)
   ENDIF

   DXE_CreateLink(cLinkTarget,cLinkFile,cWorkingDir,cCmdArgs,cDescr, aHotKey,aIcon)

RETURN

[Ari]

Jimmy,

Thank you very much

it worked out