Attribute VB_Name = "modStartupLink"
' ----------------------------------------------------------------------------
'  Copyright (C) 2009 Noda (Yohan Lasorsa) - http://nodadev.wordpress.com
' ----------------------------------------------------------------------------
'  This software Is provided 'as-is', without any express or implied
'  warranty. In no event will the author be held liable for any damages
'  arising from the use of this software.
'
'  Permission is granted to anyone to use this software for any purpose,
'  including commercial applications, and to alter it and redistribute it
'  freely, subject to the following restrictions:
'
'  1. The origin of this software must not be misrepresented; you must not
'     claim that you wrote the original software. If you use this software
'     in a product, an acknowledgment in the product documentation would be
'     appreciated but is not required.
'  2. Altered source versions must be plainly marked as such, and must not be
'     misrepresented as being the original software.
'  3. This notice may not be removed or altered from any source distribution.
' ----------------------------------------------------------------------------

Option Explicit

Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, _
    ByVal dwFlags As Long, ByVal pszPath As String) As Long

Public Function GetWindowsPath() As String
    Dim path As String
    Dim res As Long
    
    path = String(255, 0)
    res = SHGetFolderPath(0, &H24, 0, 0, path)
    If res = 0 Then
        GetWindowsPath = Left$(path, InStr(1, path, Chr(0)) - 1)
    Else
        GetWindowsPath = ""
    End If
End Function

Public Function GetStartupPath() As String
    Dim path As String
    Dim res As Long
    
    path = String(255, 0)
    res = SHGetFolderPath(0, 7, 0, 0, path)
    If res = 0 Then
        GetStartupPath = Left$(path, InStr(1, path, Chr(0)) - 1)
    Else
        GetStartupPath = ""
    End If
End Function

Public Function AddStartupShortcut(ByRef sExeName As String, ByRef sPath As String) As Boolean
    Dim wsh As Object
    Dim shortcut As Object
    Dim path As String
    
    Set wsh = CreateObject("WScript.Shell")
    path = wsh.SpecialFolders("Startup")
    Set shortcut = wsh.CreateShortCut(AddSlash(path) & sExeName & ".lnk")
    With shortcut
        .TargetPath = AddSlash(sPath) & sExeName & ".exe"
        .Description = sExeName
        .WorkingDirectory = sPath
        .WindowStyle = 4
    End With
    AddStartupShortcut = shortcut.Save()
End Function

Public Function DeleteStartupShortcut(ByRef sExeName As String)
    Dim path As String
    path = GetStartupPath
    If Len(path) Then
        path = AddSlash(path) & sExeName
        If Right$(path, 4) <> ".lnk" Then
            path = path & ".lnk"
        End If
        On Error GoTo notFound:
        Kill path
        DeleteStartupShortcut = True
        Exit Function
    End If
    
notFound:
    DeleteStartupShortcut = False
End Function

Public Function HasStartupShortcut(ByRef sExeName As String)
    Dim path As String
    path = GetStartupPath
    If Len(path) Then
        path = AddSlash(path) & sExeName
        If Right$(path, 4) <> ".lnk" Then
            path = path & ".lnk"
        End If
        HasStartupShortcut = CBool(Len(Dir(path)))
    End If
End Function

Private Function AddSlash(ByRef sPath As String) As String
    If Right$(sPath, 1) = "\" Then
        AddSlash = sPath
    Else
        AddSlash = sPath & "\"
    End If
End Function
