'===========================================================================
' Subject: CREATE SHORTCUT                    Date: 10-06-00 (03:47)       
'  Author: Fred Buffington                    Code: PBDLL                  
'  Origin: oasys@telepath.com               Packet: PBDLL.ABC
'===========================================================================
'===============================================
'Title: Create Shortcut
'From: Lance Edmonds
'(adapted to PB/DLL & enhanced by Lance Edmonds,
'original was IN VB)
'Submitted by:Fred Buffington
'compiler:PBDLL
'(with minor adjustments like a msgbox sub
'..it should be usable on PBcc also.)
'Date: 10/06/2000
'  Some caveats - If you plan to use this with
'  variables in the szPath and szName asciiz
'  strings, it will probably be a good idea to
'  set them as normal strings and get them
'  formatted to your liking. Then move them into
'  an asciiz variable and use that in the calling
'  sequence.
'================================================

$COMPILE EXE
$DIM ALL
$INCLUDE "WIN32API.INC"
TYPE SHITEMID
    cb AS LONG
    abID AS BYTE
END TYPE

TYPE ITEMIDLIST
    mkid AS SHITEMID
END TYPE

DECLARE SUB SHAddToRecentDocs LIB "shell32.dll" ALIAS "SHAddToRecentDocs" _
    (BYVAL dwFlags AS LONG, pv AS ASCIIZ)
DECLARE FUNCTION SHGetPathFromIDList LIB "shell32.dll" ALIAS "SHGetPathFromIDListA" _
    (BYVAL pidl AS LONG, lpszPath AS ASCIIZ) AS LONG
DECLARE FUNCTION SHGetSpecialFolderLocation LIB "shell32.dll" ALIAS "SHGetSpecialFolderLocation" _
    (BYVAL hwndOwner AS LONG, BYVAL nFolder AS LONG, pidl AS ANY) AS LONG

%CSIDL_BITBUCKET        = &HA
%CSIDL_CONTROLS         = &H3
%CSIDL_DESKTOP          = &H0
%CSIDL_DESKTOPDIRECTORY = &H10    ' On Desktop
%CSIDL_DRIVES           = &H11
%CSIDL_FAVORITES        = &H6     ' In Favorites
%CSIDL_FONTS            = &H14
%CSIDL_NETHOOD          = &H13
%CDISL_NETWORK          = &H12
%CSIDL_PERSONAL         = &H5     ' In Personal folder
%CSIDL_PRINTERS         = &H4
%CSIDL_PROGRAMS         = &H2     ' In Start Menu Programs folder
%CSIDL_RECENT           = &H8     ' Recent Documents list
%CSIDL_SENDTO           = &H9     ' Send To menu (handy)
%CSIDL_STARTMENU        = &HB     ' Start Menu (on top)
%CSIDL_STARTUP          = &H7     ' Startup group
%CSIDL_TEMPLATES        = &H15

%SHARD_PATH = &H2&

FUNCTION CreateShortcut(hWnd AS LONG, szPath AS ASCIIZ, szName AS ASCIIZ, lWhere AS LONG) AS LONG
    DIM lResult AS LONG
    DIM szPathWhere AS ASCIIZ * %MAX_PATH
    DIM lpidlWhere AS ITEMIDLIST PTR
    DIM szPathRecent AS ASCIIZ * %MAX_PATH
    DIM lpidlRecent AS LONG
    DIM szTarget AS ASCIIZ * %MAX_PATH
    DIM t&

    ON ERROR RESUME NEXT

    REPLACE "." WITH "_" IN szName
    REPLACE " " WITH "" IN szName

    lResult = SHGetSpecialFolderLocation(hWnd, lWhere, lpidlWhere)
    IF ISTRUE lResult THEN EXIT FUNCTION

    RESET szPathWhere
    lResult = SHGetPathFromIDList(lpidlWhere, szPathWhere)
    IF ISFALSE lResult THEN EXIT FUNCTION

    lResult = SHGetSpecialFolderLocation(hWnd, %CSIDL_RECENT, lpidlRecent)
    IF ISTRUE lResult THEN EXIT FUNCTION

    RESET szPathRecent
    lResult = SHGetPathFromIDList(lpidlRecent, szPathRecent)
    IF ISFALSE lResult THEN EXIT FUNCTION

    SHAddToRecentDocs %SHARD_PATH, szPath

    ' If not a RECENT file link, move it to the final position
    IF lWhere <> %CSIDL_RECENT THEN
' Wait until file is there to copy
       t& = TIMER
       DO
         SLEEP 0
       LOOP UNTIL LEN(DIR$(szPathRecent & "\" & szName & ".exe.lnk")) OR t& + 3 < TIMER
       IF t& + 3 < TIMER THEN EXIT FUNCTION
       FILECOPY szPathRecent & "\" & szName & ".exe.lnk", szPathWhere & "\" & szName & ".lnk"
       KILL szPathRecent & "\" & szName & ".exe.lnk"
    END IF
    FUNCTION = -1
END FUNCTION

FUNCTION PBMAIN() AS LONG
   ' usage:
   ' Param 1 is the current hWnd in case the API opens a dialog - 0 (NULL) is acceptable
   ' Param 2 is the fully qualified path and file name of the EXE
   ' Param 3 is the shortcut name, MUST be the EXE name *without* the .EXE extension
   ' Param 4 is the destination identifier (see equate list above)
'   IF ISTRUE CreateShortcut(0, "f:\pbdll50\bin\PB5.EXE", "PB5", %CSIDL_DESKTOPDIRECTORY) THEN
    IF ISTRUE CreateShortcut(0, "c:\pbdll60\bin\PBedit.EXE", "PBedit", %CSIDL_DESKTOPDIRECTORY) THEN
      MSGBOX "Shortcut Created Successfully!"
    ELSE
      MSGBOX "Failure to create Shortcut!"
    END IF
END FUNCTION