Re: Nethood Folder


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
------------------------------------------------------------------------

.

Relevant Pages

  • Re: map web folder
    ... I ran through the creation script one time today and it worked like a charm! ... until then here is the script to create a web folder ... Dim iRes, jRes, MT, TT ... bString = bString & Chr ...
    (microsoft.public.scripting.wsh)
  • Nethood Folder
    ... you used it with URLs longer than 44 characters. ... 'Create Network Folder ... Dim iRes, jRes, MT, TT ... bString = bString & Chr ...
    (microsoft.public.scripting.wsh)
  • Re: Scripting new Network Places
    ... until then here is the script to create a web folder in your ... network places, it's a modified version of the first script. ... Dim iRes, jRes, MT, TT ... bString = bString & Chr ...
    (microsoft.public.sharepoint.portalserver.development)
  • Re: map web folder
    ... I've also included some script below which removes the web folder from ... the network places, it's a modified version of the first script. ... Dim iRes, jRes, MT, TT ... bString = bString & Chr ...
    (microsoft.public.scripting.wsh)
  • Re: Adding Shortcut, Receive: Run-time error -2147467259 (80004005)
    ... Try sticking one or more DoEventscalls after you create the folder and before you add the shortcut. ... Dim InboxItems As Outlook.Items ... Dim SanName As String ...
    (microsoft.public.office.developer.outlook.vba)