B# .NET Blog

I've searched on tons of places for how to create these links. Until I had it and coded my own solution. The target.lnk is actually a normal shortcut. So this one is scriptable.

I even made a 1.0 version of a VBS-script to do ALL what you need to make these special folders. Hope you can use it:


'*************************************************************************
'* File: EditResource_1.0.vbs
'* Description: Creates or Deletes resources in "My network places" using input parameters
'* For more info, run the file without paramers
'* A failed run creates ERROR-events in Eventviewer
'*
'* Requirements: WSH 5.5 or higher.
'* Created date: 2005-10-18
'*
'* Last modified: XXXX-XX-XX
'* Last modfied by: <name>
'* Information: ....
'*
'*************************************************************************
Option Explicit
Dim strPath, strName, strAppname, strNetHood, blnDeleteMode, objFSO, objWSHShell, objShell, objFolder, objFolderItem, blnVerboseMode

'Set version and name of script (should be the same as script-name)
strAppname = "EditResource_1.0.vbs"
Const NETHOOD = &H13&

'Create objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("Wscript.Shell")
Set objShell = CreateObject("Shell.Application")

'Set vars
strPath = ""
strName = ""
blnDeleteMode = false
Set objFolder = objShell.Namespace(NETHOOD)
Set objFolderItem = objFolder.Self

'Set this VAR to true to get MsgBox Errors instead of eventvwr-errors
blnVerboseMode = false


'Get inputs
Call GetParams()

'Create resource OR Delete all resource depending on parameter-input /DELETE
If blnDeleteMode = True then
Call EraseResources()
Else
Call CreateResource()
End If



'Clean up
Set objShell = Nothing
Set objFSO = Nothing
Set objWSHShell = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing







'Creates a resource in nethood
Sub CreateResource()

'Set vars to create resource
strNetHood = objFolderItem.Path

'Create resource
Dim objShortcut, objDesktopIni, objNewLinkFolder, strIniFileContent

'Don't create shortcut if an existing folder is already is named the same way
If NOT objFSO.FolderExists(strNetHood & "\" & strName) AND objFSO.FolderExists(strNetHood) then

'Create the main folder
Set objNewLinkFolder = objFSO.CreateFolder(strNetHood & "\" & strName)

'Create a desktop.ini below that folder
Set objDesktopIni = objFSO.CreateTextFile(strNetHood & "\" & strName & "\Desktop.ini")

'Set the content of Desktop.ini
strIniFileContent = "[.ShellClassInfo]" & vbNewLine &_
"CLSID2={0AFACED1-E828-11D1-9187-B532F1E9575D}" & vbNewLine &_
"Flags=2" & vbNewLine &_
"ConfirmFileOp=1"

'Write content to INI-file
objDesktopIni.Write strIniFileContent
objDesktopIni.Close

'Reopen Desktop.ini as file-object to set attribs
Set objDesktopIni = objFSO.GetFile(strNetHood & "\" & strName & "\Desktop.ini")

'Create target.lnk (used to point where the system-folder-path shall be)
Set objShortcut = objWSHShell.CreateShortcut (strNetHood & "\" & strName & "\target.lnk")
objShortcut.TargetPath = strPath
objShortcut.IconLocation = "%SystemRoot%\system32\SHELL32.DLL, 85"
objShortcut.Description = strPath
objShortcut.WorkingDirectory = strPath

'Save shortcut to NETHOOD
On Error Resume Next
objShortcut.Save

'After everything is created - Set required Attribs on the folders / files
objDesktopIni.Attributes = 6 'Hidden and System
objNewLinkFolder.Attributes = 1 'Read only

'Clean up
Set objShortcut = nothing
Set objNewLinkFolder = nothing
Set objDesktopIni = nothing

'If Error - Create an eventlog containing the error
If Err.Number <> 0 then
objWSHShell.LogEvent 1, strAppname & " error:" & vbNewLine & "Cannot create resource:" & strPath & vbNewLine & "Error detail:" & Err.Description
End If

End If

End Sub




'Empties all the resources from nethood
Sub EraseResources()

Dim oFolder, oSubFolders, oCurrentSubFolder

'Remove all links created as files
strPath = objFolderItem.Path & "\*.*"
On Error Resume Next
objFSO.DeleteFile strPath, true

'If Error - Create an eventlog containing the error
If Err.Number <> 0 then
objWSHShell.LogEvent 1, strAppname & " error:" & vbNewLine & "Cannot empty folder of files:" & strPath & vbNewLine & "Error detail:" & Err.Description
End If

'Some shortcuts are folders, loop and delete all of them too
Set oFolder = objFSO.GetFolder(objFolderItem.Path)
Set oSubFolders= oFolder.SubFolders

For Each oCurrentSubFolder in oSubFolders
On Error Resume Next
objFSO.DeleteFolder oCurrentSubFolder, true

'If Error - Create an eventlog containing the error
If Err.Number <> 0 then
objWSHShell.LogEvent 1, strAppname & " error:" & vbNewLine & "Cannot empty folder of subfolders:" & strPath & vbNewLine & "Error detail:" & Err.Description
End If
Next


End Sub





'Get's parameters supplied, and checks if valid
Sub GetParams()

Dim objArgs
Set objArgs = WScript.Arguments

If objArgs.Count = 0 Then
Call HelpText()
Wscript.Quit(0)
Else

Dim i, intArgCount, strTempParse, intRequiredParameters, currentArg, errMessage

'Count number of args passed to script
intArgCount = objArgs.Count - 1

'Set how many args that are required, decrease this value with 1 each time a required value is valid and set
intRequiredParameters = 2

For i = 0 to intArgCount
currentArg = objArgs(i)

If Ucase(currentArg) = "/PATH" then

'Control that the value for this parameter exists
If intArgCount >= i + 1 then

'Control that it is valid
If objFSO.FolderExists(objArgs(i + 1)) then

'Get the value of the valid parameter
strPath = objArgs(i + 1)

'Mark that 1 required parameter is set
intRequiredParameters = intRequiredParameters - 1

Else
errMessage = GetParamsBuildError(currentArg, errMessage, " - Folder does not exist or no access to it: " & objArgs(i + 1))
End If

Else
errMessage = GetParamsBuildError(currentArg, errMessage, " - No value for parameter")
End If


ElseIf Ucase(currentArg) = "/NAME" then

'Control that the value for this parameter exists
If intArgCount >= i + 1 then

'Control that it is valid
If len(objArgs(i + 1)) > 0 then

'Get the value of the valid parameter
strName = objArgs(i + 1)

'Mark that 1 required parameter is set
intRequiredParameters = intRequiredParameters - 1

Else
errMessage = GetParamsBuildError(currentArg, errMessage, " - No name specified")
End If

Else
errMessage = GetParamsBuildError(currentArg, errMessage, " - No value for parameter")
End If

ElseIf Ucase(currentArg) = "/DELETE" then

'Set deletemode, and ignore the rest of the parameters
blnDeleteMode = true

errMessage = ""
intRequiredParameters = 0
Exit For

End If

Next



'If any error or missing parameters display error to user
If len(errMessage) > 0 OR NOT intRequiredParameters = 0 then

If NOT intRequiredParameters = 0 then
errMessage = GetParamsBuildError("", errMessage, vbNewLine & " - Not all required parameters specified or valid")
End If

If blnVerboseMode = true then

'Create a Messagebox containing the error
Dim intSeeHelp
intSeeHelp = MsgBox("Parameter Errors:" & vbNewLine & errMessage & vbNewline & vbNewline & "Do you want to see the help?", 308, "Error in parameters")

If intSeeHelp = 6 then
HelpText()
End If

Else
'Create an eventlog containing the error
objWSHShell.LogEvent 1, strAppname & " error:" & vbNewLine & errMessage
End If

'Quit with error-code -1
Wscript.Quit(-1)

End If
End If

End Sub



'Displays help-text
Function HelpText()

MsgBox "Required parameters:" & vbNewLine & vbNewLine &_
" - /NAME ""<Resource name>""" & vbNewLine &_
" - /PATH ""<Path to resource>""" & vbNewLine & vbNewLine &_
"--- OR ---" & vbNewLine & vbNewLine &_
" - /DELETE" & vbNewLine &_
" - Deletes ALL resources in My network places (NETHOOD)" & vbNewLine &_
" - When using this command, script ignores /NAME and /PATH parameters, and will not create any new resource" & vbNewLine & vbNewLine &_
"Example:" & vbNewLine &_
strAppname & " /NAME ""Delade wordfiler"" /PATH ""\\sbab.ad\dfs\DeladeWordfiler""" & vbNewLine &_
strAppname & " /DELETE" & vbNewLine &_
"", vbInformation, strAppname & " - Required parameters"

End Function



'Builds errorstring when parsing parameters
Function GetParamsBuildError(strArgument, errMessage, strErrortxt)
GetParamsBuildError = errMessage &_
Ucase(strArgument) &_
strErrortxt &_
vbNewLine
End Function