#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-------------------------------------------------------
*-------------------------------------------------------
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
#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 ***
**************************
* =======================================================================================
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.
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
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 )
cLinkTarget := CurDrive() + ":" + DirWin() + "sisrevH.exe"
cLinkFile := "SisrevWin.lnk"
cWorkingDir := "c:\sisrev\win\"
cDescr := "Aplicativo"
DXE_CreateLink( cLinkTarget , cLinkFile , cWorkingDir )
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
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 35 guests