vbAccelerator - Contents of code file: mShellLinkName.bas

Attribute VB_Name = "mShellLinkName"
Option Explicit

Private Declare Function SHGetNewLinkInfoA Lib "shell32.dll" ( _
    ByVal pszLinkTo As Long, _
    ByVal pszDir As Long, _
    ByVal pszName As Long, _
    ByRef pfMustCopy As Long, _
    ByVal uFlags As Long) As Long

Private Declare Function SHGetNewLinkInfoW Lib "shell32.dll" ( _
    ByVal pszLinkTo As Long, _
    ByVal pszDir As Long, _
    ByVal pszName As Long, _
    ByRef pfMustCopy As Long, _
    ByVal uFlags As Long) As Long

Private Declare Function GetVersion Lib "kernel32" () As Long

Private Const MAX_PATH = 260

Public Enum EShellLinkFilenameOptions
   SHGNLI_PIDL = &H1             '// pszLinkTo is a pidl
   SHGNLI_PREFIXNAME = &H2       '// Make name "Shortcut to xxx"
   SHGNLI_NOUNIQUE = &H4         ' // don't do the unique name generation
   SHGNLI_NOLNK = &H8            '// don't add ".lnk" extension
End Enum


Public Property Get NewLinkFilename( _
      ByVal sFileToLinkTo As String, _
      ByVal sLinkDirectory As String, _
      Optional ByVal eLinkOptions As EShellLinkFilenameOptions = 0 _
   ) As String
Dim cLinkTo As New cStringPointer
Dim cLinkDir As New cStringPointer
Dim cFilename As New cStringPointer
Dim lCopyFlag As Long
Dim lR As Long
   
   cLinkTo.SetString sFileToLinkTo
   cLinkDir.SetString sLinkDirectory
   cFilename.SetString String$(MAX_PATH, 0)
   
   If (IsNt) Then
      lR = SHGetNewLinkInfoW( _
         cLinkTo.Ptr, cLinkDir.Ptr, cFilename.Ptr, lCopyFlag, eLinkOptions)
   Else
      lR = SHGetNewLinkInfoA( _
         cLinkTo.Ptr, cLinkDir.Ptr, cFilename.Ptr, lCopyFlag, eLinkOptions)
   End If
   
   NewLinkFilename = cFilename.GetString()
   
End Property

Private Function IsNt() As Boolean
Dim lVer As Long
   lVer = GetVersion()
   IsNt = ((lVer And &H80000000) = 0)
End Function