Announcement

Collapse
No announcement yet.

VB shortcut creator - Translate to PB?

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

  • 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

  • #2
    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!
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      Jose,

      Works like a charm. Thanks.

      Jim

      Comment


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

        Comment


        • #5
          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
          ' http://www.powerbasic.com/support/fo...ML/001233.html 
             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
          ' http://www.powerbasic.com/support/fo...ML/001980.html 
              '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'
          ==========================================================
          It's a pretty day. I hope you enjoy it.

          Gösta

          JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
          LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

          Comment

          Working...
          X