Re: Nethood Folder
- From: j_r <j_r.227vlp@xxxxxxxxxxxxxxxxxxxxx>
- Date: Wed, 25 Jan 2006 13:39:29 -0600
The shortcut created by this script on a windows 2003 server does not
work.
DonQ wrote:
> *And 13 months later, I find a bug. Seems my original script failed
> if
> you used it with URLs longer than 44 characters. Following is the
> correction.
>
> BTW, I've heard that the Win API function IShellLink can create
> network
> folders. Anybody have any luck scripting that?
> ------------------------
> '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://server/path", "Name that Folder" *
--
j_r
------------------------------------------------------------------------
Posted via http://www.codecomments.com
------------------------------------------------------------------------
.
- Prev by Date: Re: Newbie seeks simple help
- Next by Date: Re: ping anomally
- Previous by thread: Newbie seeks simple help
- Next by thread: creating a new script
- Index(es):
Relevant Pages
|