Dim strGUID, strSID, strFolder Dim tempGUID, tempResponse Dim tempIcon, tempFolderName, tempFile Dim tempInputStr, tempTargetFolder,tempCheckResult Const HKEY_USERS = &H80000003 'HKEY_USERS On Error Resume Next Set ws = CreateObject("wscript.shell") Set fso = CreateObject("scripting.filesystemobject") Const ForReading = 1 '---------------------------------------------------------------------------- If wscript.arguments.Count = 0 Then tempResponse = MsgBox("╒══════════╡ 功能说明 ╞══════════╕" & vbCr & _ "│① 功能:将文件夹映射到虚拟盘,并在[我的电脑]上显示 │" & vbCr & _ "│② 操作:拖放目标文件夹到本VBS文件上 │" & vbCr & _ "│ 或 在目标文件夹上点右键相应菜单项 │" & vbCr & _ "│③ 作用:相当于在[我的电脑]生成目标文件夹的快捷方式 │" & vbCr & _ "│④ 注意:若添加右键菜单后移动或删除了本文件, │" & vbCr & _ "│ 右键功能将失效。请重新安装右键菜单 │" & vbCr & _ "│ │" & vbCr & _ "│ By Phanphan │" & vbCr & _ "╘═══════════════════════════╛" & vbCr & vbCr & _ "【右键菜单增强】:按[是]安装;按[否]卸载" & vbCr & vbCr & _ "【常见问题】目标文件夹不存在时,如何撤销无效虚拟盘?答:按[取消]", 64 + 3, "文件夹虚拟盘") Select Case tempResponse Case 2 tempInputStr = InputBox("请输入虚拟盘名称,程序将自动检查其有效性并自动撤销无效虚拟盘。" & vbCr & "按[确定]后,请耐心等待...") If tempInputStr <> "" Then Call GetIDs strPath = strSID & "\Software\Microsoft\Windows\CurrentVersion\Explorer\MyComputer\NameSpace" Set oReg = GetObject("Winmgmts:\root\default:StdRegProv") oReg.EnumKey HKEY_USERS, strPath, arr tempCheckResult="" For Each x In arr If ws.regread("HKEY_USERS\" & strSID & "\Software\Microsoft\Windows\CurrentVersion\Explorer\MyComputer\NameSpace\" & x & "\") = tempInputStr Then 'WScript.Echo x tempTargetFolder = ws.regread("HKEY_CLASSES_ROOT\CLSID\" & x & "\Instance\InitPropertyBag\Target") If fso.FolderExists(tempTargetFolder) = False Then tempCheckResult=tempCheckResult & tempTargetFolder & vbCr call DelRegInfo(x) End If End If Next if tempCheckResult="" then msgbox "检查完毕,未发现无效虚拟盘!",64, "文件夹虚拟盘" else msgbox "发现并撤销对应以下文件夹的无效虚拟盘:" & vbCr & tempCheckResult,64, "文件夹虚拟盘" end if End If Case 7 ws.RegDelete "HKCR\Folder\shell\Folder2VirtDrv\command\" ws.RegDelete "HKCR\Folder\shell\Folder2VirtDrv\" Case 6 ws.RegWrite "HKCR\Folder\shell\Folder2VirtDrv\", "【文件夹映射到虚拟盘】", "REG_SZ" ws.RegWrite "HKCR\Folder\shell\Folder2VirtDrv\command\", Chr(34) & "%SystemRoot%\System32\WScript.exe" & Chr(34) & " " & Chr(34) & wscript.ScriptFullName & Chr(34) & " " & Chr(34) & "%1" & Chr(34), "REG_EXPAND_SZ" End Select Else strFolder = wscript.arguments(0) If (fso.FileExists(strFolder)) Then ws.popup "错误!当前拖放目标不是文件夹", 2, "文件夹虚拟盘", 16 wscript.quit End If If fso.FileExists(strFolder & "\GUID.DAT") Then tempResponse = MsgBox("当前文件夹已经映射为虚拟盘!" & vbCr & vbCr & "是否撤销虚拟盘?", 4 + 32, "文件夹虚拟盘") If tempResponse = 6 Then Call GetIDs tempGUID = fso.OpenTextFile(strFolder & "\GUID.DAT").readline tempRoot = "HKEY_CLASSES_ROOT\CLSID\" & tempGUID call DelRegInfo(tempGUID) fso.GetFile(strFolder & "\GUID.DAT").Delete (True) ws.SendKeys "{F5}+{F10}e" 'ws.run("tskill explorer") 'ws.run("explorer") ws.popup "成功撤销文件夹映射到虚拟盘!", 1, "文件夹虚拟盘", 64 End If Else ws.popup "正在装载虚拟硬盘,请稍后...", 3, "文件夹虚拟盘", 64 Call GetIDs tempGUID = Left(strGUID, 38) tempFolderName = Mid(strFolder, InStrRev(strFolder, "\") + 1) tempIcon = "" tempIndex = -1 Set Fil = fso.CreateTextFile(strFolder & "\GUID.DAT") Fil.WriteLine (tempGUID) Fil.Close fso.GetFile(strFolder & "\GUID.DAT").Attributes = 7 If fso.FileExists(strFolder & "\GUID.DAT") Then If (fso.FileExists(strFolder & "\Desktop.ini")) Then Set tempFile = fso.OpenTextFile(strFolder & "\Desktop.ini", ForReading) '打开文档 Do Until tempFile.AtEndOfStream '遍历每一行 tempLineStr = LCase(tempFile.readline) If InStr(tempLineStr, "iconfile") <> 0 Then tempIcon = Mid(tempLineStr, InStrRev(tempLineStr, "=") + 1) End If If InStr(tempLineStr, "iconindex") <> 0 Then tempIndex = Mid(tempLineStr, InStrRev(tempLineStr, "=") + 1) * 1 End If Loop If tempIcon = "" Then tempIcon = "%SystemRoot%\system32\SHELL32.dll" tempIndex = 7 Else If InStr(tempIcon, ":") = 0 Then tempIcon = strFolder & "\" & tempIcon If tempIndex = -1 Then tempIndex = 0 End If Else tempIcon = "%SystemRoot%\system32\SHELL32.dll" tempIndex = 7 End If tempRoot = "HKEY_CLASSES_ROOT\CLSID\" & tempGUID ws.RegWrite tempRoot & "\", tempFolderName, "REG_SZ" ws.RegWrite tempRoot & "\InfoTip", "路径:" & strFolder, "REG_SZ" ws.RegWrite tempRoot & "\DefaultIcon\", tempIcon & "," & tempIndex, "REG_EXPAND_SZ" ws.RegWrite tempRoot & "\InprocServer32\", "shdocvw.dll", "REG_SZ" ws.RegWrite tempRoot & "\InprocServer32\ThreadingModel", "Apartment", "REG_SZ" ws.RegWrite tempRoot & "\Instance\", "", "REG_SZ" ws.RegWrite tempRoot & "\Instance\CLSID", "{0afaced1-e828-11d1-9187-b532f1e9575d}", "REG_SZ" ws.RegWrite tempRoot & "\Instance\InitPropertyBag\", "", "REG_SZ" ws.RegWrite tempRoot & "\Instance\InitPropertyBag\Target", strFolder, "REG_SZ" ws.RegWrite tempRoot & "\ShellFolder\", "", "REG_SZ" ws.RegWrite tempRoot & "\ShellFolder\Attributes", &HF8800148, "REG_DWORD" ws.RegWrite tempRoot & "\ShellFolder\PinToNameSpaceTree", "", "REG_SZ" ws.RegWrite tempRoot & "\ShellFolder\QueryForOverlay", "", "REG_SZ" ws.RegWrite tempRoot & "\ShellFolder\wantsFORPARSING", "", "REG_SZ" ws.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\MyComputer\NameSpace\" & tempGUID & "\", tempFolderName ws.RegWrite "HKEY_USERS\" & strSID & "\Software\Microsoft\Windows\CurrentVersion\Explorer\MyComputer\NameSpace\" & tempGUID & "\", tempFolderName ws.SendKeys "{F5}+{F10}e" 'ws.run("tskill explorer") 'ws.run("explorer") ws.popup "恭喜!成功将文件夹映射到虚拟盘!", 1, "文件夹虚拟盘", 64 Else ws.popup "真遗憾,文件夹映射到虚拟盘未成功!", 3, "文件夹虚拟盘", 16 End If wscript.quit End If End If Sub DelRegInfo(sGUID) tempRoot = "HKEY_CLASSES_ROOT\CLSID\" & sGUID ws.RegDelete tempRoot & "\ShellFolder\wantsFORPARSING" ws.RegDelete tempRoot & "\ShellFolder\QueryForOverlay" ws.RegDelete tempRoot & "\ShellFolder\PinToNameSpaceTree" ws.RegDelete tempRoot & "\ShellFolder\Attributes" ws.RegDelete tempRoot & "\ShellFolder\" ws.RegDelete tempRoot & "\Instance\InitPropertyBag\Target" ws.RegDelete tempRoot & "\Instance\InitPropertyBag\" ws.RegDelete tempRoot & "\Instance\CLSID" ws.RegDelete tempRoot & "\Instance\" ws.RegDelete tempRoot & "\InprocServer32\ThreadingModel" ws.RegDelete tempRoot & "\InprocServer32\" ws.RegDelete tempRoot & "\DefaultIcon\" ws.RegDelete tempRoot & "\InfoTip" ws.RegDelete tempRoot & "\" ws.RegDelete "HKEY_USERS\" & strSID & "\Software\Microsoft\Windows\CurrentVersion\Explorer\MyComputer\NameSpace\" & sGUID & "\" End Sub Sub GetIDs() Set objNetwork = CreateObject("Wscript.Network") strComputer = objNetwork.ComputerName '获取当前的机器名 strUserName = objNetwork.UserName '获取当前的用户名 Set objLocalSam = GetObject("WinNT://" & strComputer & "/" & strUserName) '这里做了修改,scottlocke中默认strUserName为"Administrator"是不保险的 strGUID = CreateObject("Scriptlet.TypeLib").Guid '获得随机类标识符 strSID = Replace(SIDArray(objLocalSam.objectSID), Chr(0), "") End Sub Function SIDArray(bar) ' Converts Binary Array into Human readable eg: S-1-5-21-XXXXX-XXXXX-XXXXX-XXX Dim seperator, sid, length seperator = "" sid = "" For length = 1 To LenB(bar) sid = sid & seperator & Right("0" & Hex(AscB(MidB(bar, length, 1))), 2) seperator = "," Next SIDArray = sid sid = Split(SIDArray, ",") ' Convert into standard viewable format - little endian format for 4 byte groups SID1 = (HexToDec(Mid(sid(15), 1, 1)) * 268435456) + (HexToDec(Mid(sid(15), 2, 2)) * 16777216) + (HexToDec(Mid(sid(14), 1, 1)) * 1048576) + (HexToDec(Mid(sid(14), 2, 2)) * 65536) + (HexToDec(Mid(sid(13), 1, 1)) * 4096) + (HexToDec(Mid(sid(13), 2, 2)) * 256) + (HexToDec(Mid(sid(12), 1, 1)) * 16) + HexToDec(Mid(sid(12), 2, 2)) SID2 = (HexToDec(Mid(sid(19), 1, 1)) * 268435456) + (HexToDec(Mid(sid(19), 2, 2)) * 16777216) + (HexToDec(Mid(sid(18), 1, 1)) * 1048576) + (HexToDec(Mid(sid(18), 2, 2)) * 65536) + (HexToDec(Mid(sid(17), 1, 1)) * 4096) + (HexToDec(Mid(sid(17), 2, 2)) * 256) + (HexToDec(Mid(sid(16), 1, 1)) * 16) + HexToDec(Mid(sid(16), 2, 2)) SID3 = (HexToDec(Mid(sid(23), 1, 1)) * 268435456) + (HexToDec(Mid(sid(23), 2, 2)) * 16777216) + (HexToDec(Mid(sid(22), 1, 1)) * 1048576) + (HexToDec(Mid(sid(22), 2, 2)) * 65536) + (HexToDec(Mid(sid(21), 1, 1)) * 4096) + (HexToDec(Mid(sid(21), 2, 2)) * 256) + (HexToDec(Mid(sid(20), 1, 1)) * 16) + HexToDec(Mid(sid(20), 2, 2)) RID = (HexToDec(Mid(sid(27), 1, 1)) * 268435456) + (HexToDec(Mid(sid(27), 2, 2)) * 16777216) + (HexToDec(Mid(sid(26), 1, 1)) * 1048576) + (HexToDec(Mid(sid(26), 2, 2)) * 65536) + (HexToDec(Mid(sid(25), 1, 1)) * 4096) + (HexToDec(Mid(sid(25), 2, 2)) * 256) + (HexToDec(Mid(sid(24), 1, 1)) * 16) + HexToDec(Mid(sid(24), 2, 2)) ' Cheating here by just prepending the S-1-5-21- SIDArray = "S-1-5-21-" & SID1 & "-" & SID2 & "-" & SID3 & "-" & RID End Function Function HexToDec(ByVal sHex) HexToDec = "" & CLng("&H" & sHex) End Function
哥,你是想让人帮你把这么多代码敲出来?
能把qq告诉我下么?我想请教你呢!
倒是有vb.net 转c#的工具,但是不符合你的要求。还有,这么多的代码要转换,一般人没有时间帮你,还是自救吧。