Announcement

Collapse
No announcement yet.

VB shortcut creator - Translate to PB?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Gösta H. Lovgren-2
    replied
    Here's Shortcut code I've been using for several years. Nowhere as neat and clean as Jose's but it works right now in PB (no special includes needed).

    Code:
    '****************************************************************************
    'Shortcut code below here
    ' all C&P'ed from POFFS - dunno who to credit
    '-Note shortcut related functions begin with "z_sc_" to group together
    ' =======================================================================================
    ' IIDs for shortcut creator
    ' =======================================================================================
    $CLSID_ShellLink = Guid$("{00021401-0000-0000-C000-000000000046}")
    $IID_IShellLink = Guid$("{000214EE-0000-0000-C000-000000000046}")
    $IID_IPersistFile = Guid$("{0000010B-0000-0000-C000-000000000046}")
    %CLSCTX_INPROC_SERVER = &H1    ' Component is allowed in the same process space.
    ' =======================================================================================
    ' =======================================================================================
    ' Returns a pointer to a specified interface on an object to which a client currently
    ' holds an interface pointer. 
    ' =======================================================================================
    Function z_sc_IUnknown_QueryInterface _
        (ByVal pthis As Dword Ptr, ByRef riid As Guid, ByRef ppvObj As Dword) As Long
      Local HRESULT As Long
      Call Dword @@pthis[0] Using z_sc_IUnknown_QueryInterface (pthis, riid, ppvObj) To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Decrements the reference count for the calling interface on a object. If the reference
    ' count on the object falls to 0, the object is freed from memory.
    ' =======================================================================================
    Function z_sc_IUnknown_Release _
            (ByVal pthis As Dword Ptr) As Dword
      Local DWRESULT As Dword
      Call Dword @@pthis[2] Using z_sc_IUnknown_Release (pthis) To   DWRESULT
      Function = DWRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Retrieves the description string for a Shell link object.
    ' =======================================================================================
    Function z_sc_IShellLink_SetDescription _
             (ByVal pthis As Dword Ptr, ByRef pszName As Asciiz) As Long
      Local HRESULT As Long
      Call Dword @@pthis[7] Using z_sc_IShellLink_SetDescription (pthis, pszName) _
              To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Sets the name of the working directory for a Shell link object.
    ' =======================================================================================
    Function z_sc_IShellLink_SetWorkingDirectory (ByVal pthis As Dword Ptr, ByRef pszDir As Asciiz) As Long
      Local HRESULT As Long
      Call Dword @@pthis[9] Using z_sc_IShellLink_SetWorkingDirectory (pthis, pszDir)_
              To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Sets the command-line arguments for a Shell link object.
    ' =======================================================================================
    Function z_sc_IShellLink_SetArguments _
             (ByVal pthis As Dword Ptr, ByRef pszArgs As Asciiz) As Long
      Local HRESULT As Long
      Call Dword @@pthis[11] Using z_sc_IShellLink_SetArguments (pthis, pszArgs) _
              To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Sets the show command for a Shell link object. The show command sets the initial show
    ' state of the window.
    ' =======================================================================================
    Function z_sc_IShellLink_SetShowCmd _
            (ByVal pthis As Dword Ptr, ByVal iShowCmd As Long) As Long
      Local HRESULT As Long
      Call Dword @@pthis[15] Using z_sc_IShellLink_SetShowCmd (pthis, iShowCmd) _
              To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Sets the path and file name of a Shell link object.
    ' =======================================================================================
    Function z_sc_IShellLink_SetPath (ByVal pthis As Dword Ptr, ByRef pszFile As Asciiz) _
           As Long
      Local HRESULT As Long
      Call Dword @@pthis[20] Using z_sc_IShellLink_SetPath (pthis, pszFile) _
              To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    ' =======================================================================================
    ' Saves the object into the specified file.
    ' =======================================================================================
    Declare Function z_sc_Proto_IPersistFile_Save _
           (ByVal pthis As Dword Ptr, _
            ByVal pszFileName As Dword, _
            ByVal fRemember As Long) As Long
    ' =======================================================================================
    Function z_sc_IPersistFile_Save _
            (ByVal pthis As Dword Ptr, _
             ByVal strFileName As String, _
             ByVal fRemember As Long) As Long
      Local HRESULT As Long
      Local pszFileName As Dword
      If Len(strFileName) Then
         strFileName = UCode$(strFileName) & $Nul
         pszFileName = StrPtr(strFileName)
      End If
      Call Dword @@pthis[6] Using z_sc_Proto_IPersistFile_Save _
           (pthis, pszFileName, fRemember) To HRESULT
      Function = HRESULT
    End Function
    ' =======================================================================================
    
    '// Prototypes
    Declare Function z_sc_IShellLink_Call0( ByVal pUnk As Long ) As Long
    Declare Function z_sc_IShellLink_Call1( ByVal pUnk As Long, ByVal p1 As Long ) As Long
    Declare Function z_sc_IShellLink_Call2( ByVal pUnk As Long, ByVal p1 As Long, ByVal p2 As Long ) As Long
    Function z_sc_SpecialFolder(pidl As Dword) As String
    ' by Wayne Diamond 12-03-01
    ' [URL]http://www.powerbasic.com/support/forums/Forum7/HTML/001233.html[/URL] 
       Local TmpAsciiz As Asciiz * %MAX_PATH
       CoInitialize ByVal 0
       If IsFalse(SHGetSpecialFolderLocation(ByVal %HWND_DESKTOP, ByVal pidl, ByVal VarPtr(pidl))) Then
          SHGetPathFromIDList ByVal pidl, TmpAsciiz
          CoTaskMemFree ByVal pidl
       End If
       CoUninitialize
       Function = TmpAsciiz
    End Function
    Function z_sc_createShortcut(CSIDL As Dword, link As String, source As String, workDir As String) As Long
    ' adapted from Edwin Knoppert's code 07-10-03
    ' [URL]http://www.powerbasic.com/support/forums/Forum7/HTML/001980.html[/URL] 
        'CSIDL   - CSIDL_DESKTOP, CSIDL_PROGRAMS, CSIDL_STARTUP, etc
        'link    - link file to be created like "My calc.lnk"
        'source  - file/document where the shortcut should point to like "c:\windows\calc.exe".
        'workDir - folder where the executable document/file should start in, best not to leave empty.
        Local CLSID_ShellLink As String * 16
        Local IID_IShellLink  As String * 16
        Local IID_Persist     As String * 16
        Local nResult As Long, pShellLnk As Dword Ptr, pPersist As Dword Ptr
        Local sTarget As String, szUniLnkName As Asciiz * (2 * %MAX_PATH)
        Local sArguments As String, sComment As String
        CLSID_ShellLink = Mkl$(&H00021401) & Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
        IID_IShellLink  = Mkl$(&H000214EE) & Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
        IID_Persist     = Mkl$(&H0000010B) & Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
        sArguments = "": sComment = ""
        CoInitialize ByVal 0&
        If CoCreateInstance(ByVal VarPtr(CLSID_ShellLink), ByVal 0&, 1, ByVal VarPtr(IID_IShellLink), pShellLnk) = 0 Then
            '// IShellLink::SetPath
            Call Dword @@pShellLnk[20] Using z_sc_IShellLink_Call1(pShellLnk, StrPtr(source))
            '// IShellLink::SetsArguments
            Call Dword @@pShellLnk[11] Using z_sc_IShellLink_Call1(pShellLnk, StrPtr(sArguments))
            '// IShellLink::SetWorkingDirectory
            Call Dword @@pShellLnk[9] Using z_sc_IShellLink_Call1(pShellLnk, StrPtr(workDir))
            '// IShellLink::SetnShowCmd
            Call Dword @@pShellLnk[15] Using z_sc_IShellLink_Call1(pShellLnk, %SW_SHOW)
            '// IShellLink::SetDescription
            Call Dword @@pShellLnk[7] Using z_sc_IShellLink_Call1(pShellLnk, StrPtr(sComment))
            '// Obtain persist interface (QueryInterface)
            Call Dword @@pShellLnk[0] Using z_sc_IShellLink_Call2(pShellLnk, VarPtr(IID_Persist), VarPtr(pPersist))
            If nResult = %S_OK Then
                '// Convert to unicode
                sTarget = z_sc_SpecialFolder(CSIDL) + "\" + link
                MultiByteToWideChar %CP_ACP, 0, ByVal StrPtr(sTarget), Len(sTarget), ByVal VarPtr(szUniLnkName), %MAX_PATH * 2
                '// IPersistFile::Save
                Call Dword @@pPersist[6] Using z_sc_IShellLink_Call2(pPersist, VarPtr(szUniLnkName), 1)
                '// Release
                Call Dword @@pPersist[2] Using z_sc_IShellLink_Call0(pPersist)
            End If
             '// Release
            Call Dword @@pShellLnk[2] Using z_sc_IShellLink_Call0(pShellLnk)
            Function = -1
        End If
        CoUninitialize
    End Function
    '         
    ' =======================================================================================
    ' Creates a shortcut
    ' =======================================================================================
    Function z_sc_CreateLink ( _
       ByVal csidl As Long _         ' // Value specifying the folder for which to retrieve the location. 
     , szLinkName As Asciiz _        ' // Name of the shortcut
     , szExePath As Asciiz _         ' // Path of the executable file
     , szArguments As Asciiz _       ' // Arguments
     , szWorkingDir As Asciiz _      ' // Working directory
     , ByVal nShowCmd As Dword _     ' // Show command flag
     , szComment As Asciiz _         ' // Comment
     ) As Long
       Local hr As Long                         ' // HRESULT
       Local psl As Dword                       ' // IShellLink interface reference
       Local ppf As Dword                       ' // IPersistFile interrace reference
       Local CLSID_ShellLink As Guid            ' // ShellLink class identifier
       Local IID_IShellLink As Guid             ' // IShellLink interface identifier
       Local IID_IPersistFile As Guid           ' // IPersistFile interface identifier
       Local pidl As Dword                      ' // Item identifier list specifying the folder location
       Local szFileName As Asciiz * %MAX_PATH   ' // Name of the .LNK file
       ' // Fills the guids
       CLSID_ShellLink = $CLSID_ShellLink
       IID_IShellLink = $IID_IShellLink
       IID_IPersistFile = $IID_IPersistFile
       ' // Creates an instance of the IShellLink interface
       hr = CoCreateInstance(CLSID_ShellLink, ByVal %Null, %CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
       If hr <> %S_OK Then Exit Function
       
       ' // Sets the properties of the shortcut
       hr = z_sc_IShellLink_SetPath(psl, szExePath)
       hr = z_sc_IShellLink_SetArguments(psl, szArguments)
       hr = z_sc_IShellLink_SetWorkingDirectory(psl, szWorkingDir)
       hr = z_sc_IShellLink_SetShowCmd(psl, nShowCmd)
       hr = z_sc_IShellLink_SetDescription(psl, szComment)
       ' // Retrieves a pointer to the IPersistFile interface
       hr = z_sc_IUnknown_QueryInterface(psl, IID_IPersistFile, ppf)
       If hr = %S_OK Then
          ' // Retrieves an item identifier list specifying the desktop folder location
          hr = SHGetSpecialFolderLocation(%HWND_DESKTOP, csidl, pidl)
          If hr = %NOERROR Then
             ' // Retrieves the path from the item identifier list
             hr = SHGetPathFromIDList(ByVal pidl, szFileName)
             ' // Frees the memory allocated for the item identifier list
             CoTaskMemFree pidl
             If IsTrue(hr) Then
                ' // Full path
                szFileName = szFileName & "\" & szLinkName & ".LNK"
                ' // Saves the shortcut file
                hr = z_sc_IPersistFile_Save(ppf, szFileName, %TRUE)
             End If
             Function = %TRUE
          End If
          ' // Releases the IPersistFile interface
          z_sc_IUnknown_Release(ppf)
       End If
       
       ' // Releases the IShellLink interface
       z_sc_IUnknown_Release psl
    End Function
    ' =======================================================================================
    '-Note shortcut functions begin with "z_sc_"
    ' 
    Sub Create_Shortcut
       Local hr As Long,  _
      csidl        As Long  , _              
      szLinkName   As Asciiz * %Max_Path, _  ' // Name of the shortcut
      szExePath    As Asciiz * %Max_Path, _  ' // Path of the executable file
      szArguments  As Asciiz * %Max_Path, _  ' // Arguments
      szWorkingDir As Asciiz * %Max_Path, _  ' // Working directory
      nShowCmd     As Dword , _              ' // Show command flag
      szComment    As Asciiz * %Max_Path      ' // Comment
       csidl        = %CSIDL_DESKTOP
       szLinkName   = "Swede's Swiss Knife"                            
       szExePath    = CurDir$ & "\Z-Post.exe" 
       szArguments  = ""                                   
       szWorkingDir = CurDir$                              
       szComment    = "Wonderful Program"                  
       hr = z_sc_CreateLink(csidl, szLinkName, szExePath, _
                       szArguments, szWorkingDir, %SW_MAXIMIZE, szComment)
       If IsTrue (hr)Then
          ? "See Desktop", %top, "Shortcut Created"
       Else
          MsgBox "CreateLink failed"
       End If
    End Sub 
    'End shortcut code
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    ==========================================================
    "It's the repetition of affirmations that leads to belief.
    And once that belief becomes a deep conviction,
    things begin to happen."

    Claude M. Bristol (1891-1951), 'The Magic of Believing'
    ==========================================================

    Leave a comment:


  • Knuth Konrad
    replied
    There's also Semen's version, using direct API calls: http://www.powerbasic.com/support/pb...ad.php?t=23589

    Leave a comment:


  • James Matt
    replied
    Jose,

    Works like a charm. Thanks.

    Jim

    Leave a comment:


  • José Roca
    replied
    The following example posted in my forum is very similar:

    http://www.jose.it-berater.org/smffo...sg6962#msg6962

    Before you ask where you can find "WSHOM.INC", it is part of my Windows API headers package:

    http://www.jose.it-berater.org/smffo...hp?board=344.0

    If you don't want to use my headers, then you will have to generate your own include file with the PB COM Browser: choose the "Windows Script Host Object Model" type library (wshom.ocx).

    Hope this helps!

    Leave a comment:


  • James Matt
    started a topic VB shortcut creator - Translate to PB?

    VB shortcut creator - Translate to PB?

    Can someone translate this VB shortcut creation code into PB. It works great in VB and would be nice to have for PB. I haven't gotten around to working with objects in PB yet.

    Private Sub Command1_Click()
    Dim wshShell As Object, lnkSendTo As Object
    Set wshShell = CreateObject("WScript.Shell")
    Set lnkSendTo = wshShell.CreateShortcut(wshShell.SpecialFolders("SendTo") & "\MyProg.lnk")
    With lnkSendTo
    .Description = "MyProg"
    .TargetPath = "C:\Program Files\MyProg\MyProg.exe"
    .WorkingDirectory = "C:\Program Files\MyProg"
    .Save
    End With
    Set lnkSendTo = Nothing
    Set wshShell = Nothing
    End Sub
Working...
X