Ho all
Please
How to Add (and remove) shortcut of the program to Desktop and Start\All Programs
Best regards,
FUNCTION CREATELINK( cLnk, cPath )
LOCAL oShell, oLink
LOCAL lOk := .F.
BEGIN SEQUENCE
oShell = CREATEOBJECT( "WScript.Shell" )
oLink = oShell:CreateShortCut( cLnk )
oLink:TargetPath = cPath
oLink:Save()
lOk = .T.
END SEQUENCE
RETURN lOk
#include "fivewin.ch"
#include "winapi.ch"
//-----------------------------------------------------------------------------
Function Main()
CREATELINK( "Proba4","c:\Proba4.exe")
RETURN NIL
//-----------------------------------------------------------------------------
FUNCTION CREATELINK( cLnk, cPath )
LOCAL oShell, oLink
LOCAL lOk := .F.
BEGIN SEQUENCE
oShell = CREATEOBJECT( "WScript.Shell" )
oLink = oShell:CreateShortCut( cLnk )
oLink:TargetPath = cPath
oLink:Save()
lOk = .T.
END SEQUENCE
RETURN lOk
avista wrote:and how to use this function for desktop icon and how for start menu ?
FUNCTION GETDESKTOPDIR()
LOCAL hKey := 0
LOCAL nType := 0
LOCAL cData := SPACE( 256 )
LOCAL nSize := LEN( cData )
REGOPENKEY( HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0, KEY_ALL_ACCESS, @hKey )
REGQUERYVALUE( hKey, "Desktop", 0, @nType, @cData, @nSize )
REGCLOSEKEY( hKey )
RETURN LEFT( cData, AT( CHR( 0 ), cData ) - 1 )
DLL FUNCTION REGOPENKEY( hKey AS LONG, cSubKey AS LPSTR, nOptions AS DWORD, nSamDesired AS DWORD, @nHandle AS PTR ) AS LONG;
PASCAL FROM "RegOpenKeyExA" LIB "advapi32.dll"
DLL FUNCTION REGQUERYVALUE( hKey AS LONG, cValueName AS LPSTR, nReserved AS LONG, @nType AS PTR, @cData AS LPSTR, @nSize AS PTR ) AS LONG;
PASCAL FROM "RegQueryValueExA" LIB "advapi32.dll"
DLL FUNCTION REGCLOSEKEY( hKey AS LONG ) AS LONG;
PASCAL FROM "RegCloseKey" LIB "advapi32.dll"
#include "FiveWin.ch"
#define HKEY_LOCAL_MACHINE (0x80000002)
FUNCTION Main()
local o
local cLinkName, cTarget, cStartIn, cArguments, cIconLoc, cHotKey, cComments
// Create link using icon from same exe
cLinkName := 'Edit Autoexec_nt.lnk'
cTarget := 'Notepad.exe'
cStartin := ''
cArguments := 'c:\windows\system32\autoexec.nt'
cIconLoc := 'notepad.exe, 0'
cHotKey := ''
cComments := ''
CreateLink( cLinkName, cTarget, cStartIn, cArguments, cIconLoc, cHotKey, cComments )
// Create link for windows program and using icon from shell32.dll
cLinkName := 'Dispatch for Windows.lnk'
cTarget := 'g:\dispatch\diwin.exe'
cStartin := 'g:\dispatch'
cArguments := ''
cIconLoc := '%SystemRoot%\system32\shell32.dll,41'
cHotKey := ''
cComments := ''
CreateLink( cLinkName, cTarget, cStartIn, cArguments, cIconLoc, cHotKey, cComments )
// Create link for dos program and using icon from a .ico file
cLinkName := 'Dsettle Dos.lnk'
cTarget := 'c:\windows\system32\cmd.exe'
cStartin := 'f:\dsettle\'
cArguments := '/k "f:\dsettle\dsmenuv7.bat"'
cIconLoc := 'f:\dsettle\dsettle.ico'
cHotKey := ''
cComments := ''
CreateLink( cLinkName, cTarget, cStartIn, cArguments, cIconLoc, cHotKey, cComments )
return nil
FUNCTION CreateLink( cLinkName, cTarget, cStartIn, cArguments, cIconLoc, cHotKey, cComments )
LOCAL o
LOCAL cTarget, cProfileDir
cLinkName := trim( cLinkName ) // Name of link
cProfileDir := LinkDir() // Pass .t. for all users or .f. for current user only
if file( cProfileDir+cLinkName )
if .not. msgyesno( cProfileDir+cLinkName+' already exists.'+CRLF+'Overwrite?')
return( nil )
endif
ferase( cProfileDir+cLinkName )
endif
o := ZLnk():New( cTarget )
o:cLinkName := cLinkName
o:cWorkingDirectory := cStartin
o:cArguments := cArguments
o:lIsSpecialFolder := .f.
o:cLinkFolder := cProfileDir
o:cIconLocation := cIconLoc
o:cHotKey := cHotKey
o:cDescription := cComments
//tracelog( o:cLinkFolder, o:cLinkName, o:cTarget, o:cWorkingDirectory )
o:Run()
RETURN nil
FUNCTION LinkDir( lAllUsers )
local cProfileDir
if lAllUsers == nil
lAllUsers := .t.
endif
if lAllUsers
if GetWinVer()[1] = 6
cProfileDir := 'c:\Users\Public\Desktop\'
else
cProfileDir := 'c:\Documents and Settings\All Users\Desktop\'
endif
else
cProfileDir := gete( 'userprofile')+'\Desktop\'
endif
return( cProfileDir )
*****************************************************************************
*** ZLnk Class ***
*****************************************************************************
CLASS ZLnk
DATA cSpecialFolder AS CHARACTER INIT 'Desktop'
DATA cWindowStyle AS NUMERIC INIT 1
DATA cFileName AS CHARACTER INIT '' // Actual Filename
DATA cTarget AS CHARACTER INIT '' // Complete path and filename of target
DATA cWorkingDirectory AS CHARACTER INIT '' // Working Directory
DATA cDescription AS CHARACTER INIT ''
DATA cIconLocation AS CHARACTER INIT ''
DATA cLinkName AS CHARACTER INIT '' // Name of the Link File
DATA cLinkFolder AS CHARACTER INIT '' // Folder where link file will be created
DATA cHotKey AS CHARACTER INIT ''
DATA cArguments AS CHARACTER INIT ''
DATA lIsSpecialFolder // Get special file director from windows. If .t. then cSpecialFolder is special folder name
METHOD New( cTarget ) CONSTRUCTOR
METHOD Run()
ENDCLASS
*****************************************************************************
*** METHOD New( cTarget ) CLASS ZLnk ***
*****************************************************************************
METHOD New( cTarget ) CLASS ZLnk
::cTarget := cTarget
::lIsSpecialFolder := .t.
RETURN Self
*****************************************************************************
*** METHOD Run() CLASS ZLnk ***
*****************************************************************************
METHOD Run() CLASS ZLnk
LOCAL oShell, oSF, o
LOCAL cTarget, oError
if empty( ::cTarget )
::cTarget := ::cWorkingDirectory+::cFileName
IF !File( ::cTarget )
RETURN .F.
ENDIF
endif
try
IF Empty( ::cLinkName )
::cLinkName := cFileNoExt( ::cTarget ) + '.lnk'
ENDIF
oShell := TOleAuto():New( "WScript.Shell" )
IF oShell:hObj == 0
Throw( ErrorNew( 'WScript Shell Error', 0, 0, 'WScript' ) )
ENDIF
if ::lIsSpecialFolder
oSF := oShell:Get( 'SpecialFolders' )
cTarget := oSF:Item( ::cSpecialFolder )
if .not. empty(::cLinkFolder)
cTarget += '\'+::cLinkFolder
endif
else
cTarget := ::cLinkFolder
endif
IF Empty( cTarget )
Throw( ErrorNew( 'Empty Target Name', 0, 0, 'Target' ) )
ENDIF
o := oShell:CreateShortCut( cTarget + '' + ::cLinkName )
o:WindowStyle := ::cWindowStyle
o:TargetPath := ::cTarget
o:WorkingDirectory := ::cWorkingDirectory
o:Arguments := ::cArguments
o:Description := ::cDescription
if .not. empty( ::cIconLocation )
o:IconLocation := ::cIconLocation
endif
if .not. empty( ::cHotKey )
o:HotKey := ::cHotKey
endif
o:Save()
catch oError
//cReturn := 'ERROR: '+oError:Operation + " -> " + oError:Description
msginfo( oError:Operation + " -> " + oError:Description)
end
RETURN .T.
#include "fivewin.ch"
#define CSIDL_DESKTOP 0x0000 // <desktop>
#define CSIDL_INTERNET 0x0001 // Internet Explorer (icon on desktop)
#define CSIDL_PROGRAMS 0x0002 // Start Menu\Programs
#define CSIDL_CONTROLS 0x0003 // My Computer\Control Panel
#define CSIDL_PRINTERS 0x0004 // My Computer\Printers
#define CSIDL_PERSONAL 0x0005 // My Documents
#define CSIDL_FAVORITES 0x0006 // <user name>\Favorites
#define CSIDL_STARTUP 0x0007 // Start Menu\Programs\Startup
#define CSIDL_RECENT 0x0008 // <user name>\Recent
#define CSIDL_SENDTO 0x0009 // <user name>\SendTo
#define CSIDL_BITBUCKET 0x000a // <desktop>\Recycle Bin
#define CSIDL_STARTMENU 0x000b // <user name>\Start Menu
#define CSIDL_MYDOCUMENTS 0x000c // logical "My Documents" desktop icon
#define CSIDL_MYMUSIC 0x000d // "My Music" folder
#define CSIDL_MYVIDEO 0x000e // "My Videos" folder
#define CSIDL_DESKTOPDIRECTORY 0x0010 // <user name>\Desktop
#define CSIDL_DRIVES 0x0011 // My Computer
#define CSIDL_NETWORK 0x0012 // Network Neighborhood (My Network Places)
#define CSIDL_NETHOOD 0x0013 // <user name>\nethood
#define CSIDL_FONTS 0x0014 // windows\fonts
#define CSIDL_TEMPLATES 0x0015
#define CSIDL_COMMON_STARTMENU 0x0016 // All Users\Start Menu
#define CSIDL_COMMON_PROGRAMS 0X0017 // All Users\Start Menu\Programs
#define CSIDL_COMMON_STARTUP 0x0018 // All Users\Startup
#define CSIDL_COMMON_DESKTOPDIRECTORY 0x0019 // All Users\Desktop
#define CSIDL_APPDATA 0x001a // <user name>\Application Data
#define CSIDL_PRINTHOOD 0x001b // <user name>\PrintHood
#define CSIDL_LOCAL_APPDATA 0x001c // <user name>\Local Settings\Applicaiton Data (non roaming)
#define CSIDL_ALTSTARTUP 0x001d // non localized startup
#define CSIDL_COMMON_ALTSTARTUP 0x001e // non localized common startup
#define CSIDL_COMMON_FAVORITES 0x001f
#define CSIDL_INTERNET_CACHE 0x0020
#define CSIDL_COOKIES 0x0021
#define CSIDL_HISTORY 0x0022
#define CSIDL_COMMON_APPDATA 0x0023 // All Users\Application Data
#define CSIDL_WINDOWS 0x0024 // GetWindowsDirectory()
#define CSIDL_SYSTEM 0x0025 // GetSystemDirectory()
#define CSIDL_PROGRAM_FILES 0x0026 // C:\Program Files
#define CSIDL_MYPICTURES 0x0027 // C:\Program Files\My Pictures
#define CSIDL_PROFILE 0x0028 // USERPROFILE
#define CSIDL_SYSTEMX86 0x0029 // x86 system directory on RISC
#define CSIDL_PROGRAM_FILESX86 0x002a // x86 C:\Program Files on RISC
#define CSIDL_PROGRAM_FILES_COMMON 0x002b // C:\Program Files\Common
#define CSIDL_PROGRAM_FILES_COMMONX86 0x002c // x86 Program Files\Common on RISC
#define CSIDL_COMMON_TEMPLATES 0x002d // All Users\Templates
#define CSIDL_COMMON_DOCUMENTS 0x002e // All Users\Documents
#define CSIDL_COMMON_ADMINTOOLS 0x002f // All Users\Start Menu\Programs\Administrative Tools
#define CSIDL_ADMINTOOLS 0x0030 // <user name>\Start Menu\Programs\Administrative Tools
#define CSIDL_CONNECTIONS 0x0031 // Network and Dial-up Connections
#define CSIDL_COMMON_MUSIC 0x0035 // All Users\My Music
#define CSIDL_COMMON_PICTURES 0x0036 // All Users\My Pictures
#define CSIDL_COMMON_VIDEO 0x0037 // All Users\My Video
#define CSIDL_RESOURCES 0x0038 // Resource Direcotry
//------------------------------------------------------------------------------
Function Main()
CreateDesktopShortcut( "C:\DbTools\DbTools.exe" )
CreateStartMenuFolder( "DbTools" )
CreateStartMenuShortcut( "DbTools","C:\DbTools\DbTools.exe","DbTools Program" )
CreateStartMenuShortcut( "DbTools","C:\DbTools\DbTools.chm","DbTools Help" )
CreateStartMenuShortcut( ,"C:\DbTools\DbTools.exe" )
Return nil
//------------------------------------------------------------------------------
Function CreateDesktopShortcut( cTarget, cLinkName, cStartIn, cIconLoc, cShortcutKey, cComent )
local cDesktop := GetSpecialFolder( CSIDL_DESKTOPDIRECTORY )
DEFAULT cLinkName := "" ,;
cTarget := "" ,;
cStartIn := "" ,;
cIconLoc := "" ,;
cShortcutKey := "" ,; // "Alt + F2" ,;
cComent := "" // "Test"
If Empty( cTarget )
Return nil
EndIf
If Empty( cLinkName )
// I dont use FileNoPath() becouse it returning upper, I want original
// for example "PrObA5.exe"
cLinkName := RIGHT( cTarget, LEN(cTarget) - RAT("\",cTarget) )
cLinkName := LEFT( cLinkName, RAT(".", cLinkName)-1 ) // -1 da se isfrli "."
EndIf
If Empty( cStartIn )
// cStartIn := cFilePath( cTarget )
cStartIn := LEFT( cTarget, RAT("\", cTarget)-1 ) // -1 da se isfrli poslednoto"\"
EndIf
If File(cDesktop + "\" + cLinkName + ".lnk")
Ferase(cDesktop + "\" + cLinkName + ".lnk")
EndIf
if CreateFileLink( cDesktop + "\" + cLinkName, cTarget, cStartIn, cIconLoc, cShortcutKey, cComent ) # 0
MsgAlert( "Create a desktop icon Error !" )
endif
Return nil
//------------------------------------------------------------------------------
Function CreateStartMenuFolder( cFolder )
local cStartMenuPrograms := GetSpecialFolder( CSIDL_PROGRAMS )
DEFAULT cFolder := ""
If Empty( cFolder )
Return nil
EndIf
if !lMkDir( cStartMenuPrograms + "\" + cFolder )
// MsgAlert( "Create a Strt Menu folder Error !" ) // Znaci postoi ...nema potreba od poraka
endif
Return nil
//------------------------------------------------------------------------------
Function CreateStartMenuShortcut( cFolder, cTarget, cLinkName, cStartIn, cIconLoc, cShortcutKey, cComent )
local cStartMenuPrograms := GetSpecialFolder( CSIDL_PROGRAMS )
DEFAULT cFolder := "" ,;
cLinkName := "" ,;
cTarget := "" ,;
cStartIn := "" ,;
cIconLoc := "" ,;
cShortcutKey := "" ,; // "Alt + F2" ,;
cComent := "" // "Test"
If Empty( cTarget )
Return nil
EndIf
If !Empty( cFolder )
cStartMenuPrograms := cStartMenuPrograms + "\" + cFolder
EndIf
If Empty( cLinkName )
// I dont use FileNoPath() becouse it returning upper, I want original
// for example "PrObA5.exe"
cLinkName := RIGHT( cTarget, LEN(cTarget) - RAT("\",cTarget) )
cLinkName := LEFT( cLinkName, RAT(".", cLinkName)-1 ) // -1 da se isfrli "."
EndIf
If Empty( cStartIn )
// cStartIn := cFilePath( cTarget )
cStartIn := LEFT( cTarget, RAT("\", cTarget)-1 ) // -1 da se isfrli poslednoto"\"
EndIf
if CreateFileLink( cStartMenuPrograms + "\" + cLinkName, cTarget, cStartIn, cIconLoc, cShortcutKey, cComent ) # 0
MsgAlert( "Create a Start Menu shortcut Error !" )
endif
Return nil
//------------------------------------------------------------------------------
#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 ) //
{
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);
}
HB_FUNC( CGETSPECIALFOLDER ) // Ista so prethodnata samo razlicno ime radi vo nekoj programi sto se koristi
{
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);
}
HB_FUNC( GETSPECIALFOLDER ) // Ista so prethodnata samo razlicno ime radi vo nekoj programi sto se koristi
{
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-------------------------------------------------------
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot], Silvio.Falconi and 32 guests