+ Post New Thread
Results 1 to 2 of 2
Windows 7 Thread, Windows 7: Shared Start Menus and Desktops in Technical; I wonder if anyone can help with this... We are looking to have a kind of shortcut bank situation in ...
  1. #1
    danbee's Avatar
    Join Date
    Jul 2008
    Location
    Northamptonshire
    Posts
    11
    Thank Post
    5
    Thanked 1 Time in 1 Post
    Rep Power
    0

    Windows 7: Shared Start Menus and Desktops

    I wonder if anyone can help with this...

    We are looking to have a kind of shortcut bank situation in Windows 7 where students and staff have redirected start menus and desktops. But how can you stop shortcuts appearing for programs which aren't installed on that particular device?

  2. #2

    Join Date
    Jan 2009
    Location
    Burton On Trent
    Posts
    127
    Thank Post
    23
    Thanked 28 Times in 20 Posts
    Rep Power
    16
    We have the following as a logon script.
    It will populate their startmenu from a share on the server \\deploymentserver\deploy$\startmenu
    In there place yoru shortcuts. You can set user security to only deploy them to the correct groups.
    They will also only deploy if the shortcut can be resolved (i.e. it is installed on the computer)

    It also pins the Internet Explorer and Outlook icons to the start menu, and hides the My Settings folder in their My Documents (re-directed as the N:\ drive on our system)

    You may need to taylor this to your own.


    'Copy Server start menu to local if available
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oShell = CreateObject("Wscript.Shell")
    strServerStartMenu = "\\deplomentServer\deploy$\StartMenu\"

    If oFSO.FileExists("\\svr-deploy1\deploy$\aup.txt") Then
    strUserProfile = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
    strLocalStartMenu = strUserProfile + "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
    if oFSO.folderexists (strServerStartMenu) then
    if oFSO.folderexists(strLocalStartMenu) Then
    On Error Resume Next
    oFSO.DeleteFolder strLocalStartMenu, true
    end if

    oFSO.createfolder(strLocalStartMenu)
    Call CopyFolderRecursively(strServerStartMenu, strLocalStartMenu)
    Call RemoveEmptyFolders(strLocalStartMenu)
    Call Pin()
    Call HideSettingsFolder()
    End if
    Else
    'WScript.Echo "Not connected to domain"
    End if

    Sub HideSettingsFolder()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    if objFSO.Folderexists("N:\My Settings") then
    Set objFolder = objFSO.GetFolder("N:\My Settings")
    If objFolder.Attributes = objFolder.Attributes AND 2 Then
    objFolder.Attributes = objFolder.Attributes XOR 2
    End If
    End If
    end sub

    Sub CopyFolderRecursively(strSrcPath, strDestPath)
    On Error Resume Next
    Set objCurrentFolder = oFSO.GetFolder(strSrcPath)

    'moved from inside loop
    If Not oFSO.FolderExists(strDestPath) Then
    oFSO.CreateFolder(strDestPath)
    end if

    For Each objFile In objCurrentFolder.Files
    ' Create new folder if it's not there
    on error resume next
    strDestFile = strDestPath & "\" & objFile.Name
    if CheckValidShortcut(objFile) Then
    oFSO.CopyFile objFile, strDestFile
    end if
    err.clear
    Next

    For Each objFolder In objCurrentFolder.subFolders
    Call CopyFolderRecursively(objFolder, strDestPath & "\" & objFolder.Name)
    Next
    End Sub

    Sub RemoveEmptyFolders(strPath)
    Set objCurrentFolder = oFSO.GetFolder(strPath)
    For Each objFolder in ObjCurrentFolder.SubFolders
    On Error Resume Next
    if not FolderEmpty(objFolder) then
    RemoveEmptyFolders(strPath & "\" & objFolder.Name)
    else
    oFSO.deleteFolder strpath & "\" & objFolder.name, true
    end if
    next
    End Sub

    Function CheckValidShortcut(objCheckFile)
    If LCase(oFSO.GetExtensionName(objCheckFile.name)) = "lnk" Then
    Set oLnk = oShell.CreateShortcut(objCheckFile.path)
    If oFSO.FileExists(oLnk.TargetPath) Then
    CheckValidShortcut = true
    Else
    CheckValidShortcut = False
    End If
    End If
    End Function

    Function FolderEmpty(strFolderPathName)
    Dim oFiles, oFile, oFolder, oSubFolders, oSubFolder
    Set oFolder = oFSO.GetFolder(strFolderPathName)
    Set oFiles = oFolder.Files
    Set oSubFolders = oFolder.SubFolders
    if oSubFolders.Count > 0 then
    FolderEmpty = False
    exit Function
    end if

    If oFiles.Count > 0 Then
    FolderEmpty = False
    Exit Function
    End If
    FolderEmpty = True
    End Function

    Sub Pin()
    on error resume next
    'Process Start Menu Pinned Items
    Const CSIDL_COMMON_PROGRAMS = &H17
    Const CSIDL_PROGRAMS = &H2
    Set objShell = CreateObject("Shell.Application")
    'Set objWShell = CreateObject("WScript.Shell")

    sRegKey = "HKCU\Software\Ashby"
    favKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Ex plorer\StartPage2\Favorites"

    On Error Resume Next

    pinnedSM = oShell.RegRead(sRegKey & "\PinningRan")

    'check for marker so we don't run this part if it has already been run
    If pinnedSM <> "woot" Then
    set filesys = CreateObject("Scripting.FileSystemObject")
    strUProfile = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
    strStartMenuPinFiles = strUserProfile + "\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu\"
    strStartMenuPinFilesLocal = "N:\My Settings\Application Data\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu\"
    filesys.DeleteFile strStartMenuPinFilesLocal + "*.lnk"
    oshell.regwrite favKey, 255, "REG_BINARY"

    if error <> 0 then
    wscript.echo "Error " & error
    end if

    oShell.RegWrite sRegKey & "\PinnedInternet", "no"
    oShell.RegWrite sRegKey & "\PinnedEmail", "no"

    WScript.Sleep(2000)

    Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
    strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Ashby School")

    Set objFolderItem = objFolder.ParseName("Internet.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then
    objVerb.DoIt
    oShell.RegWrite sRegKey & "\PinnedInternet", "yes"
    end if
    Next

    WScript.Sleep(2000)

    Set objFolderItem = objFolder.ParseName("E-Mail.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then
    objVerb.DoIt
    oShell.RegWrite sRegKey & "\PinnedEmail", "yes"
    end if
    Next


    'create the marker
    oShell.RegWrite sRegKey & "\PinningRan", "yes"
    End if
    set objShell = Nothing
    End Sub

  3. Thanks to peterp from:

    danbee (30th April 2013)

SHARE:
+ Post New Thread

Similar Threads

  1. Custom Start Menu and Desktop issue
    By ryanplym in forum Windows 7
    Replies: 5
    Last Post: 11th February 2013, 10:24 AM
  2. Replies: 18
    Last Post: 27th April 2012, 01:32 PM
  3. Start Menu and Desktop lost on DFS
    By deano in forum Windows 7
    Replies: 3
    Last Post: 27th November 2011, 12:52 PM
  4. Replies: 4
    Last Post: 10th December 2010, 09:51 AM
  5. Replies: 0
    Last Post: 5th April 2008, 10:46 AM

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •