Clever scripting for Webdav Link Creation

[westy]

Hi,

 

I am looking at making it as easy as possible for users to be able to create webdav links in their "my network places" when they are own their machines at home. Effectively I want to remove the step for using the "add a network place wizard" and use a script to automatically create the links to the webdav folders we publish.

 

I don't really claim to know much about scripting but get the concepts. So far my googling has come across this lovely little script which I attach below.

 

What I would like to add to this however, is a prompt for the user to enter their username. This username will then be added to the bit at the end so :-

 

CreateNetworkFolder "https://files.myserver.com/Home/<>", "School Home Area"

 

This should then quite simply create the individual share link.

 

Hope this makes sense, and thanks in advance for any help!

 

Andrew

 

(P.S. Thanks and reference to the site where I swiped this code Re: map web folder)

 

 

CODE

***************************************************************************

Create Network Folder

'This is a fix to the original, which I found did not handle URLs

'longer than 44 characters.

 

Option Explicit

 

Sub CreateNetworkFolder(siteURL, siteName)

 

Dim iRes, jRes, MT, TT

Dim SH, newPath

Dim objFso, f, fs, g

 

Dim bString

Dim ltrIndex

Dim nameLength, urlLength, urlCutoff

Dim aFile

 

'ForWriting (2) is the attribute to be set when writing to a file.

Const ForWriting = 2

 

nameLength = Len(siteName)

urlLength = Len(siteURL)

'44 seems to be the length where we have to change a 00 to a 01.

urlCutoff = 44

 

MT = "OK to create a My Network Places " & vbCr & "folder for " & siteURL & vbCr & "named " & siteName & "?"

TT = "My Network Places"

iRes = MsgBox(MT, vbOKCancel + vbInformation, TT )

 

Set objFso = CreateObject("Scripting.FileSystemObject")

 

If iRes = vbCancel Then

WScript.Quit

End If

 

Set SH = WScript.CreateObject("WScript.Shell")

 

'Create the folder under NetHood that will hold the target.lnk file

newPath = SH.SpecialFolders("NetHood") & "\" & siteName

 

If (objFso.FolderExists(newPath)) Then

WScript.Echo "A Network Place with that name already exists."

WScript.Quit

End If

 

objFso.CreateFolder(newPath)

 

'We ceate a Desktop.ini file

Set fs = CreateObject("Scripting.FileSystemObject")

aFile = newPath & "\Desktop.ini"

 

Set f = fs.OpenTextFile( aFile, ForWriting, True )

 

'Write the data lines that will make this a folder shortcut.

f.WriteLine "[.ShellClassInfo]"

f.WriteLine "CLSID2={0AFACED1-E828-11D1-9187-B532F1E9575D}"

f.WriteLine "Flags=2"

f.WriteLine "ConfirmFileOp=0"

f.Close

 

'We make Desktop.ini a system-hidden file by assigning it attribute of 6

Set fs = CreateObject("Scripting.FileSystemObject")

Set g = fs.GetFile(newPath & "\Desktop.ini")

g.Attributes = 6

 

'We make the folder read-only by assigning it 1.

Set fs = CreateObject("Scripting.FileSystemObject")

Set g = fs.GetFolder(newPath)

g.Attributes = 1

 

'This is where we construct the target.lnk file byte by byte. Most of

'the lines are shown in 16 byte chunks,

'mostly because that is the way I saw it in the Debug utility I was

'using to inspect shortcut files.

 

'Line 1, 16 bytes

bString = Chr(&H4C) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H01) & Chr(&H14) & Chr(&H02) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&HC0) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'Line 2, 16 bytes

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H46) & Chr(&H81) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'Line 3, 16 bytes

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'Line 4., 16 bytes. 13th byte is significant.

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H01) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'Line 5. 13th byte is significant.

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'When I was analyzing the next byte of shortcuts I created, I found

'that it is set to various values,

'and I have no idea what they are referring to. In desperation I tried

'substituting some values.

'00 caused a crash of Explorer. FF seeems to work fine for all.

'If anyone can get back to me on what this byte is or why FF works,

'please contact me.

bString = bString & Chr(&HFF)

 

'This byte is 00 if the URL is 44 characters or less, 01 if greater.

If urlLength > urlCutoff Then

bString = bString & Chr(&H01)

Else

bString = bString & Chr(&H00)

End If

 

bString = bString & Chr(&H14) & Chr(&H00)

 

'Line 6, 16 bytes

bString = bString & Chr(&H1F) & Chr(&H50) & Chr(&HE0) & Chr(&H4F) & Chr(&HD0) & Chr(&H20) & Chr(&HEA) & Chr(&H3A) & Chr(&H69) & Chr(&H10) & Chr(&HA2) & Chr(&HD8) & Chr(&H08) & Chr(&H00) & Chr(&H2B) & Chr(&H30)

 

'Line 7, 16 bytes

bString = bString & Chr(&H30) & Chr(&H9D) & Chr(&H14) & Chr(&H00) & Chr(&H2E) & Chr(&H00) & Chr(&H00) & Chr(&HDF) & Chr(&HEA) & Chr(&HBD) & Chr(&H65) & Chr(&HC2) & Chr(&HD0) & Chr(&H11) & Chr(&HBC) & Chr(&HED)

 

'Line 8, 16 bytes

bString = bString & Chr(&H00) & Chr(&HA0) & Chr(&HC9) & Chr(&H0A) & Chr(&HB5) & Chr(&H0F) & Chr(&HA4)

 

'This byte is 00 if the URL is 44 characters or less, 01 if greater.

If urlLength > urlCutoff Then

bString = bString & Chr(&H01)

Else

bString = bString & Chr(&H00)

End If

 

bString = bString & Chr(&H4C) & Chr(&H50) & Chr(&H00) & Chr(&H01) & Chr(&H42) & Chr(&H57) & Chr(&H00) & Chr(&H00)

 

'Line 9, 16 bytes

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H10) & Chr(&H00)

 

'Line 10, 2 bytes

bString = bString & Chr(&H00) & Chr(&H00)

 

'The next byte represents the length of the site name.

bString = bString & Chr(nameLength)

 

'Take the site name, and write each letter, preceeded by a "00"

'character.

 

For ltrIndex = 1 to nameLength

bString = bString & Chr(&H00) & Mid(siteName, ltrIndex, 1)

Next

 

'Middle line, separates the Folder Name from the URL. 3 bytes.

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'The next byte represents the length of the site URL.

bString = bString & Chr(urlLength)

 

'Take the site URL, and write each letter, preceeded by a "00"

'character.

For ltrIndex = 1 to urlLength

bString = bString & Chr(&H00) & Mid(siteURL, ltrIndex, 1)

Next

 

'Last line, 13 bytes

bString = bString & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00)

 

'Let's create the target.lnk file.

Set fs = CreateObject("Scripting.FileSystemObject")

aFile = newPath & "\target.lnk"

'aFile = newPath & "\vb.sss"

Set f = fs.OpenTextFile(aFile, ForWriting, True)

f.Write bString

f.Close

 

MT = siteName & " created."

jRes = MsgBox(MT, vbOK, TT )

 

End Sub

 

CreateNetworkFolder "https://files.myserver.com/Home/***********", "School Home Area"

 

CODE END

****************************************************************************