China DOS Union

Everyone, the link for the SendTo+(VBS version).rar by moderator 3742668 seems invalid. I believe everyone has downloaded it, please upload it selflessly, thank you.

Go and see if there is.
http://zhenlove.com.cn/cndos/fileup/files/SendTo+.zip

Thanks to brother lxmxn, but this doesn't seem to be the VBS version.

### 1. Install.vbs
```code
On Error Resume Next
strCurrentPath = CreateObject("Scripting.FileSystemObject") _
.GetFile(WScript.ScriptFullName).ParentFolder
Set objShell = CreateObject("WScript.Shell")
strPath = objShell.SpecialFolders("SendTo")

'Part for installing shortcuts
strPathQuick = strPath & "\Shortcuts"
CreateDir strPathQuick
strPrefix = "Add to "
strSourceFile = strCurrentPath & "\Shortcut.vbs"
CreateLink strPathQuick,strPrefix,strSourceFile,"Quick Launch",165
CreateLink strPathQuick,strPrefix,strSourceFile,"Start Menu",39
CreateLink strPathQuick,strPrefix,strSourceFile,"Favorites",43
CreateLink strPathQuick,strPrefix,strSourceFile,"Other Folders",4

'Part for installing open folder
strPathOpen = strPath & "\Open Directory"
CreateDir strPathOpen
strPrefix = "Open "
strSourceFile = strCurrentPath & "\Open Folder.vbs"
CreateLink strPathOpen,strPrefix,strSourceFile,"Control Panel",21
CreateLink strPathOpen,strPrefix,strSourceFile,"My Documents",126
CreateLink strPathOpen,strPrefix,strSourceFile,"Favorites",43
CreateLink strPathOpen,strPrefix,strSourceFile,"Startup",130
CreateLink strPathOpen,strPrefix,strSourceFile,"Recently Opened Documents",20
CreateLink strPathOpen,strPrefix,strSourceFile,"Send To",137
CreateLink strPathOpen,strPrefix,strSourceFile,"Network Neighborhood",17
CreateLink strPathOpen,strPrefix,strSourceFile,"Windows",38
CreateLink strPathOpen,strPrefix,strSourceFile,"System32",27
CreateLink strPathOpen,strPrefix,strSourceFile,"Programs",36
CreateLink strPathOpen,strPrefix,strSourceFile,"Current User Root Directory",170
CreateLink strPathOpen,"",strSourceFile,"Add Current Directory",4
CreateLink strPathOpen,"",strSourceFile,"Remove Current Directory",4
Function CreateDir(strPath)

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(strPath)
CreateDir = f.Path

End Function

Sub CreateLink(strPath,strPrefix,strSourceFile,strArg,intIconNumber)

strFullName = strPath & "\" & strPrefix & strArg & ".lnk"
strArg = Chr(34) & strSourceFile & Chr(34) & Space(1) & strArg

With CreateObject("WScript.Shell").CreateShortcut(strFullName) 'Full path of the shortcut
.TargetPath = WScript.FullName 'Source file, here should be wscript.exe
.Arguments = strArg 'Arguments
' .WindowStyle = 1 'Run style
' .Hotkey = "" 'Hotkey
.IconLocation = "shell32.dll," & intIconNumber 'Icon
' .Description = "" 'Remark
' .WorkingDirectory = "" 'Start directory
.Save
End With

End Sub
```

### 2. Open Folder.vbs
```code
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
arrArgs = Array("IE","All Programs","Control Panel","Printers and Faxes", _
"My Documents","Favorites","Startup","Recently Opened Documents","Send To", _
"Recycle Bin","Start Menu","Temporarily Missing","My Music","My Videos", _
"Temporarily Missing","Desktop","My Computer","Network Neighborhood","NetHood", _
"Fonts","Templates","All User Start Menu","All User All Programs",_
"All User Startup","All User Desktop","MY_AppData","PrintHood", _
"MY_AppData2","Temporarily Missing","Temporarily Missing","All User Favorites","IE Cache", _
"Cookies","History","All User AppData","Windows","System32", _
"Programs","My Pictures","Current User Root Directory","Common Components","Temporarily Missing",_
"Temporarily Missing","Temporarily Missing","All User Templates","Shared Documents", _
"All User Management","Administrative Tools","Network Connections","Temporarily Missing","Temporarily Missing", _
"Temporarily Missing","All User Music","All User Pictures","All User Videos", _
"Desktop Themes","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(objArgs(0)) Then
intNumber = i + 1
End If
Next

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
If Err.Number <> 0 Then
If UCase(objArgs(0)) = UCase("Add Current Directory") Then
AddCurrentFolder(objArgs(1))
ElseIf UCase(objArgs(0)) = UCase("Remove Current Directory") Then
DelCurrentFolder(objArgs(1))
Else
objShell.Open objArgs(0)
'WScript.Quit
End If
End If
objShell.Open objFolderItem.Path


Sub AddCurrentFolder(str)

On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
strName = objDir.Name
Else
strPath = objFile.ParentFolder.Path
strName = objFile.ParentFolder.Name
End If

strFullName = strSendTo & "\Open Directory\Open " & strName & ".lnk"

With CreateObject("WScript.Shell").CreateShortcut(strFullName)
.TargetPath = WScript.FullName
.Arguments = Chr(34) & WScript.ScriptFullName & Chr(34) & _
Space(1) & Chr(34) & strPath & Chr(34)
.IconLocation = "shell32.dll,4"
.Save
End With

End Sub


Sub DelCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
Else
strPath = objFile.ParentFolder.Path
End If
Set objFolder = fso.GetFolder(strSendTo & "\Open Directory")
For Each i In objFolder.Files
Set objLink = objShell.CreateShortcut(i)
If objLink.Arguments = Chr(34) & WScript.ScriptFullName & _
Chr(34) & Space(1) & Chr(34) & strPath & Chr(34) Then
fso.DeleteFile i
End If
Next


End Sub
```

### 3. Shortcut.vbs
```code
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit

intBeganArg = 1
strPath = GetSystemFolder(objArgs(0))
If Len(Trim(strPath)) = 0 Then
If objArgs(0) = "Quick Launch" Then
strPath = GetQuickLaunch()
Else
intBeganArg = 0
strPath = GetDirectory()
End If
End If

For i = intBeganArg To objArgs.Count - 1
CreateLink strPath,objArgs(i)
Next

'************************************************************************************
'Create shortcut
'************************************************************************************
Sub CreateLink(strPath,strFile)

On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strFile)
If Err.Number <> 0 Then
Set f = fso.GetFile(strFile)
strLinkName = Mid(f.Name,1,InStrRev(f.Name,".")-1)
Else
strLinkName = f.Name
End If

If Len(Trim(strLinkName)) = 0 Or Len(Trim(strFile)) = 0 Then Exit Sub
Set objShell = CreateObject("WScript.Shell")
With objShell.CreateShortcut(strPath &"\" & strLinkName & ".lnk") 'Storage directory and file name
.TargetPath = strFile 'Executable file pointed to
' .WindowStyle = 1 'Run style
' .Hotkey = "" 'Hotkey
' .IconLocation = "c:\xxx\xxx, 0" 'Icon
' .Description = "" 'Remark
' .WorkingDirectory = "" 'Start directory
.Save
End With
End Sub


'************************************************************************************
'Pop up window to select directory
'************************************************************************************
Function GetDirectory()

Const MY_COMPUTER = &H10

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(0, "Select Folder:", 0, strPath)

If objFolder Is Nothing Then
WScript.Quit
End If

Set objFolderItem = objFolder.Self
GetDirectory = objFolderItem.Path

End Function

'************************************************************************************
'Get the path of quick launch
'************************************************************************************
Function GetQuickLaunch()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(40)
Set objFolderItem = objFolder.Self
GetQuickLaunch = objFolderItem.Path
GetQuickLaunch = GetQuickLaunch & _
"\Application Data\Microsoft\Internet Explorer\Quick Launch"
' Set objNetwork = CreateObject("Wscript.Network")
' strUserName = objNetwork.UserName
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set f = fso.GetFolder(objShell.SpecialFolders(Favorites))
' GetQuickLaunch = f.ParentFolder.ParentFolder & "\" &strUserName & _
' "\Application Data\Microsoft\Internet Explorer\Quick Launch"

End Function

'************************************************************************************
'Get system folder
'************************************************************************************
Function GetSystemFolder(str)

arrArgs = Array("IE","All Programs","Control Panel","Printers and Faxes", _
"My Documents","Favorites","Startup","Recently Opened Documents","Send To", _
"Recycle Bin","Start Menu","Temporarily Missing","My Music","My Videos", _
"Temporarily Missing","Desktop","My Computer","Network Neighborhood","NetHood", _
"Fonts","Templates","All User Start Menu","All User All Programs",_
"All User Startup","All User Desktop","MY_AppData","PrintHood", _
"MY_AppData2","Temporarily Missing","Temporarily Missing","All User Favorites","IE Cache", _
"Cookies","History","All User AppData","Windows","System32", _
"Programs","My Pictures","Current User Root Directory","Common Components","Temporarily Missing",_
"Temporarily Missing","Temporarily Missing","All User Templates","Shared Documents", _
"All User Management","Administrative Tools","Network Connections","Temporarily Missing","Temporarily Missing", _
"Temporarily Missing","All User Music","All User Pictures","All User Videos", _
"Desktop Themes","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(str) Then
intNumber = i + 1
End If
Next

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
GetSystemFolder = objFolderItem.Path

End Function
```

Note: There are minor bugs in the script, but they do not affect usage. The code will be rewritten when a good idea is available.

Thank you very much, moderator 3742668. It's very valuable.

Great! Received first! Go back and study slowly!

Bookmarked

It seems that there is no Set xxx=Nothing seen?

Thanks, finally found it~~~

Download and bookmark, very good tool