---

Hej alle !

Jeg har fundet dette lille VB script, som skulle kunne oprette en genvej til
et program på skrivebordet og i startmenuen.

Mit problem er bare lige at jeg ikke kan gennemskue hvordan jeg lige skal
kalde scriptet, men jeg formoder at det er noget i retning af:

call m_CreateSortcut(?, ?, ?, ?, ?, ?, ?, ?) ....

er der nogen der kan hjælpe med et eksempel på hvordan scriptet skal kaldes
?

Option Explicit

'---------------------------
'Skrol 29
'skrol29@freesurf.fr
'http://www.rezo.net/skrol29
'---------------------------
'Version 1.00, on 02/13/1999
'Version 1.01, on 04/19/1999
'---------------------------

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, ByVal sPath As String) As
Long

Public Sub m_CreateSortcut(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)

'Constants for the Windows Folders :
' 2 = Programs
' 7 = Startup
' 8 = RecentDocs
'16 = Desktop

'Private Const SHARD_PATH = &H2& (pour api_SHAddToRecentDocs)

'Full path for the temporary shortcut created in the RecentDocs folder.
Dim Shortcut0 As String
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(Application.hWndAccessApp, 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