creating shortcuts

I have this sample created by Skrol29 (whoever that is :) )

seems mucky, but I have never seen other ways to do it...
VB Code:
'Author: Skrol 29 
'Category: Files And Directories 
'Type: Snippets 
'Difficulty: Advanced 
 
 
'Version Compatibility:  Visual Basic 5   Visual Basic 6 
 
 
'More information: The usual code To create shortcuts does Not allow one 
'To create a shortcut For a program With parameters. This code enables you 
'To create a shortcut anywhere For any Command Line With any parameters, 
'the icons you want, the default folder you want And the window mode you want. 
'Enjoy.
 
Option Explicit
 
'---------------------------
'Skrol 29
'[email protected]
'http://www.rezo.net/dir/skrol29/
'---------------------------
'Version 1.00, on 02/13/1999
'Version 1.01, on 04/19/1999
'---------------------------
Private Const CSIDL_DESKTOP = &H0
Private Const CSIDL_PROGRAMS = &H2
Private Const CSIDL_PERSONAL = &H5
Private Const CSIDL_FAVORITES = &H6
Private Const CSIDL_STARTUP = &H7
Private Const CSIDL_RECENT = &H8
Private Const CSIDL_STARTMENU = &HB
Private Const CSIDL_COMMON_STARTMENU = &H16
Private Const CSIDL_COMMON_PROGRAMS = &H17
Private Const CSIDL_COMMON_STARTUP = &H18
Private Const CSIDL_COMMON_FAVORITES = &H1F
 
Private Declare Function api_SHAddToRecentDocs Lib _
   "shell32.dll" Alias "SHAddToRecentDocs" (ByVal dwFlags As _
   Long, ByVal dwData As String) As Long
 
Private Declare Function api_SHGetSpecialFolderLocation Lib _
  "shell32.dll" Alias "SHGetSpecialFolderLocation" (ByVal _
  hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
 
Private Declare Function api_SHGetPathFromIDList Lib _
   "shell32.dll" Alias "SHGetPathFromIDList" _
   (ByVal pidl As Long, ByValsPath As String) _
   As Long
 
Public Sub m_CreateShortcut(ScFolder As Variant, ScCaption As _
   String, TargetPath As String, Optional ScParam As String, _
   Optional StartFolder As String, Optional IcoNum As Integer, _
   Optional IcoPath As String, Optional WindowMode As Integer)
 
'If you want to use one of the windows folders for the shortcut
'location, you can pass one of the constants defined in the declarations, e.g., 
' CSIDL_PROGRAMS  = Programs
' CSIDL_STARTUP = Startup
' CSIDL_RECENT = RecentDocs
' CSIDL_DESKTOP = Desktop
 
'NOTE: AS WRITTEN THIS CODE MUST BE PLACED
'WITHIN A FORM MODULE
 
'Example:  Puts a shortcut to Notepad on the desktop with
'          a .txt document to be opened
 
' m_CreateShortcut CSIDL_DESKTOP, "MyFile", _
'   "C:\windows\Notepad.exe", "C:\MyFile.txt"
    
Dim Shortcut0 As String 'Full path for the temporary shortcut
                         'created in the RecentDocs folder.
Dim n0 As Integer       'Cusror position in Shortcut0.
Dim x0 As String * 1    'Variable while reading Shortcut0.
Dim l0 As Long          'Lenth of the Shortcut0 file.
Dim Shortcut1 As String 'Full path for the final shortcut.
Dim n1 As Integer       'Cusror position in Shortcut1
Dim x1 As String * 1    'Variable while reading Shortcut1.
Dim l1 As Long          'Lenth of the Shortcut1 file
 
Dim T As Double
Dim p As Long
Dim i As Integer
Dim x As String
Dim y0 As String * 2
 
'Check for the target folder
If IsNumeric(ScFolder) Then
    ScFolder = p_GetSpecialFolder(CInt(ScFolder))
ElseIf Dir$(ScFolder, vbDirectory) = "" Then
    MsgBox "Le répertoire '" & ScFolder & "' est introuvable.", _
       vbCritical, "Création d'un raccrourci"
    Exit Sub
End If
 
'Create a temporary shortcut with only the
'target in the the RecentDocs.
If api_SHAddToRecentDocs(2, TargetPath) > 0 Then
 
    'Full path of the created shortcut
    Shortcut0 = p_GetSpecialFolder(8) & "\" & _
        p_File_Folder(TargetPath) & ".lnk"
 
    'Waiting for the end of the creation.
    T = Now()
    Do Until (Dir$(Shortcut0) <> "")
    
    If (Now() - T) > 0.00006 Then 'wait 5 seconds
        If MsgBox("Attendre encore la création du raccourci ?", _
            vbQuestion + vbOKCancel, "Raccourci") <> vbOK Then
            Exit Sub
        Else
            T = Now()
        End If
    End If
    
    Loop
 
    'Open the temporary shortcut file in read mode.
    n0 = FreeFile()
    Open Shortcut0 For Binary Access Read As #n0
    'Wait for the file is correctly feed.
    Do Until LOF(n0) > 0
    Loop
    l0 = LOF(n0)
 
    'Open the shortcut file to create
    Shortcut1 = ScFolder & "\" & ScCaption & ".lnk"
    n1 = FreeFile()
    Open Shortcut1 For Binary Access Write As #n1
 
    'Look for the last byte to get
    p = (l0 - 4)
    y0 = ""
    Do Until (p <= 0) Or (y0 = vbNullChar & vbNullChar)
        Get #n0, p, y0
        p = p - 1
    Loop
    l1 = p + 2
 
    'Copy bytes
    For p = 1 To l1
 
        Get #n0, p, x0
 
        Select Case p
        Case 21 'path for icon, startup, parameters
            i = 3
            If StartFolder <> "" Then
                i = i + 16
            End If
            If ScParam <> "" Then
                i = i + 32
            End If
            If (IcoPath <> "") Or (IcoNum > 0) Then
                i = i + 64
            End If
            x1 = Chr$(i)
        Case 57 'Icon index
            x1 = Chr$(IcoNum)
        Case 61 'Window mode
            x1 = Chr$(WindowMode)
        Case Else
            x1 = x0
        End Select
 
        Put #n1, p, x1
 
    Next p
 
    'Close and delete the temporary shorcut
    Close #n0
    Kill Shortcut0
 
    'Add the Start folder, parameters and icon file
    x = ""
    If StartFolder <> "" Then
        x = x & Chr$(Len(StartFolder)) & vbNullChar & StartFolder
    End If
    If ScParam <> "" Then
        x = x & Chr$(Len(ScParam)) & vbNullChar & ScParam
    End If
    If IcoPath = "" Then
        If IcoNum > 0 Then
            x = x & Chr$(Len(TargetPath)) & vbNullChar _
               & TargetPath
        End If
    Else
        x = x & Chr$(Len(IcoPath)) & vbNullChar & IcoPath
    End If
    x = x & String(4, vbNullChar)
    Put #n1, l1 + 1, x
 
    Close #n1
 
Else
 
    MsgBox "Error when creating the shortcut.", _
          vbCritical, "Shortcut"
 
End If
 
End Sub
 
Private Function p_GetSpecialFolder(CsIdl As Long) As String
 
'Returns the full path of the folder corresponding to the 
'Windows's id system folder.
 
Dim r     As Long
Dim pidl  As Long
Dim sPath As String
 
r = api_SHGetSpecialFolderLocation(Me.hWnd, CsIdl, pidl)
 
If r = 0 Then
 
    sPath = Space$(260)
    r = api_SHGetPathFromIDList(ByVal pidl, ByVal sPath)
    If r Then
        p_GetSpecialFolder = Left$(sPath, _
           InStr(sPath, Chr$(0)) - 1)
    End If
 
End If
 
End Function
 
Private Function p_File_Folder(FullPath As String) As String
'Returns the name of the file alone.
 
Dim i As Integer
 
p_File_Folder = FullPath
i = Len(FullPath)
Do Until i = 0
    If Mid$(FullPath, i, 1) = "\" Then
        p_File_Folder = Mid$(FullPath, i + 1)
        i = 0
    Else
        i = i - 1
    End If
Loop
 
End Function