The complete operation requires the following steps:
1. Create the folder in Nethood.
2. Create a Desktop.ini file in the folder and write the lines as
shown.
3. Make Desktop.ini a hidden-system file.
4. Make the folder read-only.
5. Create you own shortcut. Name it target.lnk. Construct the file
byte by byte.
I've included the code here, and have stored it on my server at...
http://totheescrime.org/FolderShortcut/fs.txt
Now I'm off to turn this into a COM/ActiveX. Anybody have anything to
share about that, please let me know.
Yours,
Don Q
----------------------------------
Option Explicit
Sub CreateNetworkFolder(siteURL, siteName)
Dim iRes, jRes, MT, TT
Dim SH, newPath
Dim objFso, f, fs, g
Dim bString
Dim ltrIndex, nameLength, urlLength
Dim aFile
'ForWriting (2) is the attribute to be set when writing to a file.
Const ForWriting = 2
nameLength = Len(siteName)
urlLength = Len(siteURL)
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)
bString = bString & Chr(&H00) & 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) & Chr(&H00) & 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)
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"
Set f = fs.OpenTextFile(aFile, ForWriting, True)
f.Write bString
f.Close
MT = siteName & " created."
jRes = MsgBox(MT, vbOK, TT )
End Sub
CreateNetworkFolder "http://my.jbbworldwide.com/sites/MIS", "MIS on
My.JBB"
Post more and try to shorten your
discovery times.
"Don Badowski" <Do...@totheescrime.org> wrote in message
news:ef4fb76.04030...@posting.google.com...