On a forum I found a solution for this issue. A guy named DonQ created a vbs script which I used in my logon script. Depending on group memberships, SharePoint sites are automatically created for the users while logging in.
The script I used as a starting point is:
'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 "http://ReallyReallyLongURL.com/big_long_subfolder/", "Really, Really Long"
'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 "http://ReallyReallyLongURL.com/big_long_subfolder/", "Really, Really Long"
Source:
http://totheescrime.org/FolderShortcut/fs.txt
http://www.codecomments.com/archive300-2005-4-452832.html
No comments:
Post a Comment