Skrive til genvej

lytter med... vil også gerne vide hvordan man åbner en genvej f.eks en url-genvej og for den til at gå til \"sti\"

sådan laver du en genvej til regnemaskinen med notepads ikon:

1. sæt en reference til Windows Script Host Object Model (Ver 1.0)
2. Paste nedenstående ind i koden vinduet:
Private Sub Form_Load()
Dim o As IWshRuntimeLibrary.IWshShell
Dim lLink As IWshRuntimeLibrary.IWshShortcut_Class

Set o = New IWshRuntimeLibrary.IWshShell_Class
Set lLink = o.CreateShortcut(\"C:\\Data\\test.lnk\")

lLink.Description = \"Dette er en beskrivelse!\"
lLink.IconLocation = \"Notepad.exe, 0\"
lLink.WorkingDirectory = \"c:\\winnt\\system32\\\"
lLink.TargetPath = \"calc.exe\"
lLink.Save

End Sub

PS. Jeg tror kun det duer under win2000

Nedenstående kan bruges til Win98 men der er bare det lille problem at der ikke kan skrives:

WSHShell.ExpandEnvironmentStrings(\"C:\\programmer\\CadArc\\RxDatamanager.exe /S C:\\Standard\\Standard.ina\")

/ bliver lavet om til \\ og \" \" bibeholdtes, spørgsmålet om der er andre muligheder, det må da være muligt at kunne skrive til en genvejs egenskaber når de kan sættes ind manuelt

L_Welcome_MsgBox_Message_Text  = \"Dette script laver en genvej til Notesblok på dit skrivebord.\"
L_Welcome_MsgBox_Title_Text    = \"Scripteksempel til Windows Scripting Host\"
Call Welcome()

\' ********************************************************************************
\' *
\' * Metoder relateret til genveje.
\' *

Dim WSHShell
Set WSHShell = WScript.CreateObject(\"WScript.Shell\")


Dim MyShortcut, MyDesktop, DesktopPath

\' Læs stien til skrivebordet ved at bruge objektet WshSpecialFolders
DesktopPath = WSHShell.SpecialFolders(\"Desktop\")

\' Lav et genvejsobjekt på skriverbordet
Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & \"\\Genvej til Notesblok.lnk\")

\' Angiv egenskaberne til genvejen og gem egenskaberne
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(\"%windir%\\notepad.exe\")
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(\"%windir%\")
MyShortcut.WindowStyle = 4
MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings(\"%windir%\\notepad.exe, 0\")
MyShortcut.Save

WScript.Echo \"En genvej til Notesblok ligger nu på dit skrivebord.\"

\' ********************************************************************************
\' *
\' * Velkomst
\' *
Sub Welcome()
    Dim intDoIt

    intDoIt =  MsgBox(L_Welcome_MsgBox_Message_Text,    _
                      vbOKCancel + vbInformation,      _
                      L_Welcome_MsgBox_Title_Text )
    If intDoIt = vbCancel Then
        WScript.Quit
    End If
End Sub

Jøps, her er koden som du paster ind i et modul.
Se funktionen CreateShellLink, det skulle være selvforklarende....

Det er ikke elegant, men det er der.!

Option Explicit
\'---------------------------------------------------------------
\'- Public API Declares...
\'---------------------------------------------------------------
#If UNICODE Then
    Public Declare Function SHGetPathFromIDList Lib \"Shell32\" Alias \"SHGetPathFromIDListW\" (ByVal pidl As Long, ByVal szPath As Long) As Long
#Else
    Public Declare Function SHGetPathFromIDList Lib \"Shell32\" Alias \"SHGetPathFromIDListA\" (ByVal pidl As Long, ByVal szPath As String) As Long
#End If

Public Declare Function SHGetSpecialFolderLocation Lib \"Shell32\" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long

\'---------------------------------------------------------------
\'- Public constants...
\'---------------------------------------------------------------
Public Const MAX_PATH = 255
Public Const MAX_NAME = 40

\'---------------------------------------------------------------
\'- Public enums...
\'---------------------------------------------------------------
Public Enum STGM
    STGM_DIRECT = &H0&
    STGM_TRANSACTED = &H10000
    STGM_SIMPLE = &H8000000
    STGM_READ = &H0&
    STGM_WRITE = &H1&
    STGM_READWRITE = &H2&
    STGM_SHARE_DENY_NONE = &H40&
    STGM_SHARE_DENY_READ = &H30&
    STGM_SHARE_DENY_WRITE = &H20&
    STGM_SHARE_EXCLUSIVE = &H10&
    STGM_PRIORITY = &H40000
    STGM_DELETEONRELEASE = &H4000000
    STGM_CREATE = &H1000&
    STGM_CONVERT = &H20000
    STGM_FAILIFTHERE = &H0&
    STGM_NOSCRATCH = &H100000
End Enum

Public Enum SHELLFOLDERS            \' Shell Folder Path Constants...
    CSIDL_DESKTOP = &H0&            \' ..\\WinNT\\profiles\\username\\Desktop
    CSIDL_PROGRAMS = &H2&          \' ..\\WinNT\\profiles\\username\\Start Menu\\Programs
    CSIDL_CONTROLS = &H3&          \' No Path
    CSIDL_PRINTERS = &H4&          \' No Path
    CSIDL_PERSONAL = &H5&          \' ..\\WinNT\\profiles\\username\\Personal
    CSIDL_FAVORITES = &H6&          \' ..\\WinNT\\profiles\\username\\Favorites
    CSIDL_STARTUP = &H7&            \' ..\\WinNT\\profiles\\username\\Start Menu\\Programs\\Startup
    CSIDL_RECENT = &H8&            \' ..\\WinNT\\profiles\\username\\Recent
    CSIDL_SENDTO = &H9&            \' ..\\WinNT\\profiles\\username\\SendTo
    CSIDL_BITBUCKET = &HA&          \' No Path
    CSIDL_STARTMENU = &HB&          \' ..\\WinNT\\profiles\\username\\Start Menu
    CSIDL_DESKTOPDIRECTORY = &H10&  \' ..\\WinNT\\profiles\\username\\Desktop
    CSIDL_DRIVES = &H11&            \' No Path
    CSIDL_NETWORK = &H12&          \' No Path
    CSIDL_NETHOOD = &H13&          \' ..\\WinNT\\profiles\\username\\NetHood
    CSIDL_FONTS = &H14&            \' ..\\WinNT\\fonts
    CSIDL_TEMPLATES = &H15&        \' ..\\WinNT\\ShellNew
    CSIDL_COMMON_STARTMENU = &H16&  \' ..\\WinNT\\profiles\\All Users\\Start Menu
    CSIDL_COMMON_PROGRAMS = &H17&  \' ..\\WinNT\\profiles\\All Users\\Start Menu\\Programs
    CSIDL_COMMON_STARTUP = &H18&    \' ..\\WinNT\\profiles\\All Users\\Start Menu\\Programs\\Startup
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19& \'..\\WinNT\\profiles\\All Users\\Desktop
    CSIDL_APPDATA = &H1A&          \' ..\\WinNT\\profiles\\username\\Application Data
    CSIDL_PRINTHOOD = &H1B&        \' ..\\WinNT\\profiles\\username\\PrintHood
End Enum

Public Enum SHOWCMDFLAGS
    SHOWNORMAL = 5
    SHOWMAXIMIZE = 3
    SHOWMINIMIZE = 7
End Enum

\'---------------------------------------------------------------
Public Function GetSystemFolderPath(ByVal hwnd As Long, ByVal Id As Integer, sfPath As String) As Long
\'---------------------------------------------------------------
    Dim rc As Long                                      \' Return code
    Dim pidl As Long                                    \' ptr to Item ID List
    Dim cbPath As Long                                  \' char count of path
    Dim szPath As String                                \' String var for path
\'---------------------------------------------------------------
    szPath = Space(MAX_PATH)                            \' Pre-allocate path string for api call

    rc = SHGetSpecialFolderLocation(hwnd, Id, pidl)    \' Get pidl for Id...
    If (rc = 0) Then                                    \' If success is 0
#If UNICODE Then
        rc = SHGetPathFromIDList(pidl, StrPtr(szPath))  \' Get Path from Item Id List
#Else
        rc = SHGetPathFromIDList(pidl, szPath)          \' Get Path from Item Id List
#End If
        If (rc = 1) Then                                \' If success is 1
            szPath = Trim$(szPath)                      \' Fix path string
            cbPath = Len(szPath)                        \' Get length of path
            If (Asc(Right(szPath, 1)) = 0) Then cbPath = cbPath - 1 \' Adjust path length
            If (cbPath > 0) Then sfPath = Left$(szPath, cbPath) \' Adjust path string variable
            GetSystemFolderPath = True                  \' Return success
        End If
    End If
\'---------------------------------------------------------------
End Function
\'---------------------------------------------------------------

\'---------------------------------------------------------------
Public Function CreateShellLink(lnkFile As String, ExeFile As String, WorkDir As String, _
                                ExeArgs As String, IconFile As String, IconIdx As Long, _
                                ShowCmd As SHOWCMDFLAGS, Description As String) As Long
\'---------------------------------------------------------------
    Dim rc As Long
    Dim pidl As Long                                    \' Item id list
    Dim dwReserved As Long                              \' Reserved flag
    Dim cShellLink As ShellLinkA                        \' An explorer IShellLinkA(Win 95/Win NT) instance
    Dim cPersistFile As IPersistFile                    \' An explorer IPersistFile instance
\'---------------------------------------------------------------
    If ((lnkFile = \"\") Or (ExeFile = \"\")) Then Exit Function    \' Validate min. input requirements.
   
    On Error GoTo ErrHandler
    Set cShellLink = New ShellLinkA                    \' Create new IShellLink interface
    Set cPersistFile = cShellLink                      \' Implement cShellLink\'s IPersistFile interface
   
    With cShellLink
        .SetPath ExeFile                                \' set command line exe name & path to new ShortCut.
       
        If (WorkDir <> \"\") Then .SetWorkingDirectory WorkDir \' Set working directory in shortcut
       
        If (ExeArgs <> \"\") Then .SetArguments ExeArgs  \' Add arguments to command line
       
\'      if (LnkDesc <> \"\") then .SetDescription pszName \' Set shortcut description
\'      .SetHotkey wHotKey
     
        If (IconFile <> \"\") Then .SetIconLocation IconFile, IconIdx \' Set shortcut icon location & index
       
        .SetDescription Description & vbNullChar
\'      .SetIDList pidl
\'      dwReserved = 0
\'      .SetRelativePath pszPathRel, dwReserved

        .SetShowCmd ShowCmd                            \' Set shortcut\'s startup mode (min,max,normal)
    End With
   
    cShellLink.Resolve 0, SLR_UPDATE
    cPersistFile.Save StrConv(lnkFile, vbUnicode), 0    \' Unicode conversion hack... This must be done!
    CreateShellLink = True                              \' Return Success

\'---------------------------------------------------------------
ErrHandler:
\'---------------------------------------------------------------
    Set cPersistFile = Nothing                          \' Destroy Object
    Set cShellLink = Nothing                            \' Destroy Object
\'---------------------------------------------------------------
End Function
\'---------------------------------------------------------------

\'---------------------------------------------------------------
Public Function GetShellLinkInfo(lnkFile As String, ExeFile As String, WorkDir As String, _
                                ExeArgs As String, IconFile As String, IconIdx As Long, _
                                ShowCmd As Long, Description As String) As Long
\'---------------------------------------------------------------
    Dim pidl As Long                                    \' Item id list
    Dim wHotKey As Long                                \' Hotkey to shortcut...
    Dim fd As WIN32_FIND_DATA
   
    Dim buffLen As Long
    Dim cShellLink As ShellLinkA                        \' An explorer IShellLink instance
    Dim cPersistFile As IPersistFile                    \' An explorer IPersistFile instance
\'---------------------------------------------------------------
    If (lnkFile = \"\") Then Exit Function                \' Validate min. input requirements.
   
    Set cShellLink = New ShellLinkA                    \' Create new IShellLink interface
    Set cPersistFile = cShellLink                      \' Implement cShellLink\'s IPersistFile interface
   
    \' Load Shortcut file...(must do this UNICODE hack!)
    On Error GoTo ErrHandler
    cPersistFile.Load StrConv(lnkFile, vbUnicode), STGM_DIRECT
   
    With cShellLink
        \' Get command line exe name & path of shortcut
        ExeFile = Space(MAX_PATH)
        buffLen = Len(ExeFile)
        .GetPath ExeFile, buffLen, fd, SLGP_UNCPRIORITY
        Dim s As String
        s = fd.cFileName                                \' Not returned to calling function
       
        \' Get working directory of shortcut
        WorkDir = Space(MAX_PATH)
        buffLen = Len(WorkDir)
        .GetWorkingDirectory WorkDir, buffLen
       
        \' Get command line arguments of shortcut
        ExeArgs = Space(MAX_PATH)
        buffLen = Len(ExeArgs)
        .GetArguments ExeArgs, buffLen
       
        \' Get description of shortcut
        Description = Space(MAX_PATH)
        buffLen = Len(Description)
        .GetDescription Description, buffLen
       
        \' Get the HotKey for shortcut
        .GetHotkey wHotKey                              \' Not returned to calling function
     
        \' Get shortcut icon location & index
        IconFile = Space(MAX_PATH)
        buffLen = Len(IconFile)
        .GetIconLocation IconFile, buffLen, IconIdx
       
        \' Get Item ID List...
        .GetIDList pidl                                \' Not returned to calling function
               
        \' Set shortcut\'s startup mode (min,max,normal)
        .GetShowCmd ShowCmd
    End With

    GetShellLinkInfo = True                            \' Return Success
\'---------------------------------------------------------------
ErrHandler:
\'---------------------------------------------------------------
    Set cPersistFile = Nothing                          \' Destroy Object
    Set cShellLink = Nothing                            \' Destroy Object
\'---------------------------------------------------------------
End Function
\'---------------------------------------------------------------



\'---------------------------------------------------------------
Public Function cmdGetLinkPath(lnkFile As String, oDescription As String) As String
\'---------------------------------------------------------------
    Dim ExeFile As String                              \' Link - Exe file name
    Dim WorkDir As String                              \'      - Working directory
    Dim ExeArgs As String                              \'      - Command line arguments
    Dim IconFile As String                              \'      - Icon File name
    Dim IconIdx As Long                                \'      - Icon Index
    Dim ShowCmd As Long                                \'      - Program start state...
    Dim Description As String
    Dim s As String
    Dim i As Integer
\'---------------------------------------------------------------
       
   
    GetShellLinkInfo lnkFile, _
                          ExeFile, _
                          WorkDir, _
                          ExeArgs, _
                          IconFile, _
                          IconIdx, _
                          ShowCmd, Description    \' Get Info for shortcut file...
                       
  s = Description
  i = InStr(s, Chr(0))
  If i <> 0 Then s = Mid(s, 1, i - 1)
  oDescription = s
 
  s = ExeFile
  i = InStr(s, Chr(0))
  If i <> 0 Then s = Mid(s, 1, i - 1)
  cmdGetLinkPath = s
End Function

Problemet med at skrive til en genvej deltager jeg gerne i.
Jeg har prøvet ligge ovenstående kode fra Jazper ind under et form modul, men får fejlmeddelsen:
Compile error
Constants, fixed-length strings, arrays, user-defined types and declare statements not allowed as public members of object modules.

Jeg følger med spænding den videre udvikling

Men fare for at lyde lidt morgensur: Hvad tror du så selv er galt, hvis du tog dig et øjebliks betænkningstid ?

Svar: du skal lægge det ind i et kode modul.
(-:

Ups der blev min uvidenhed på VB vist afsløret. Det virkede selvfølig da det blev lagt ind i et kode modul. Nu vil jeg se hvad der kan gøres med den genvejs funktion.

(-;

Min husmandsprogrammering rækker ikke. Jazper kan du forklare hvordan funktions kaldet kommer til at fungere, funktions erklæringen ligger i module1.bas. Funktions kaldet ligger under en knap på form1. Først har jeg prøvet at lave variabler (vist udkommenteret)som blev indsat som parametre i funktionen, da det ikke virkede har jeg prøvet at skrive værdierne direkte ind i funktionskaldet, det giver så fejlen \"Statement invalid outside Type block\" Jeg er heller ikke helt sikker på hvad de forskellige parametre skal indeholde. Jeg håber du kan give mig et vink med en vognstang. #:-(

Private Sub Command1_Click()

\'Dim lnkFile As String
\'Dim ExeFile As String
\'Dim WorkDir As String
\'Dim ExeArgs As String
\'Dim IconFile As String
\'Dim ShowCmd As SHOWCMDFLAGS
\'Dim IconIdx As Long
\'Dim Description As String


\'lnkFile = \"C:\\WINDOWS\\Skrivebord\\Genvej til LogIn.Ina\"
\'ExeFile = \"C:\\Programmer\\CadArc\\DataManager\\DataManagerRun.exe\"
\'WorkDir = \"T:\\DokArkiv\\Login\"
\'ExeArgs = \"/S T:\\DokArkiv\\Login\\LogIn.Ina\"
\'IconFile = \"T:\\Dokarkiv\\Icons\\CRDFLE04.ICO\"
\'ShowCmd = SHOWNORMAL
\'IconIdx = \"\"
\'Description = \"\"

\'CreateShellLink(lnkFile, ExeFile, WorkDir, ExeArgs, IconFile, IconIdx, ShowCmd, Description) As Long
CreateShellLink(\"C:\\WINDOWS\\Skrivebord\\Genvej til LogIn.Ina\", \"C:\\Programmer\\CadArc\\DataManager\\DataManagerRun.exe\", \"T:\\DokArkiv\\Login\", \"/S T:\\DokArkiv\\Login\\LogIn.Ina\", \"T:\\Dokarkiv\\Icons\\CRDFLE04.ICO\", \"\", SHOWNORMAL, \"\") As Long
CreateShellLink() As Long

End Sub

Den sidste
CreateShellLink() As Long
hører ikke med.

Spørgsmål lukkes
/ReneLp