【已解决】VBS如何以管理员权限运行/执行当前目录下子目录内的指定程序？

doswork

以下代码xp下执行正常，但win10下无法执行，因为涉及了注册表操作（这个必须是管理员权限才行），网上找到了一段儿“以管理员权限运行”的代码，但是运行之后将“vbs的当前路径”给固定到“c:\windows\system32”这个位置了，造成VBS执行时“找不到指定的文件”，请教这个问题怎么解决？  多谢！

set qq = CreateObject("Wscript.Shell")
ww = qq.CurrentDirectory
wscript.echo ww                  ' 假如当前路径是  “ 桌面\123\ ”，在执行“以管理员权限运行”那段儿代码之后就自动变成“c:\windows\system32”了……

                qq.RegWrite "HKCR\.7z\",  "7zip", "REG_SZ"
                qq.Run ww + "\x64\7zFM.exe",1,true   

'问题：如果不用“以管理员权限运行”这段儿代码，其它run命令可以正常执行（ww是正确的桌面路径），但注册表操作一直提示“……根路径无效……”（因为没有用管理员权限运行）
        ' 用了“以管理员权限运行”这段儿代码之后，上面的注册表也好，这里的执行程序也好，ww的值都是“c:\windows\system32”，造成注册表、执行程序都不正确！

'====== 上面是要用到的代码；下面是“以管理员权限运行”的代码，运行之后“当前路径”取得的值就只能是c:\windows\system32”了……
http://www.bathome.net/redirect. ... 1903&ptid=34121

yu2n

1. Option Explicit
   
2. 
   
3. RunAsAdmin
   
4. 
   
5. Msgbox CreateObject("WScript.Shell").CurrentDirectory
   
6. 
   
7. ' 以管理员身份运行 By Yu2n
   
8. Sub RunAsAdmin()
   
9.         Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
   
10.         Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
    
11.         For Each vItem In oItems
    
12.                 sVer = vItem.Version
    
13.         Next
    
14.         Set oItems = Nothing
    
15.         nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
    
16.         If nVer >= 60 Then
    
17.                 If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
    
18.                         For Each vArg In WScript.Arguments
    
19.                                 sArgs = sArgs & " """ & vArg & """"
    
20.                         Next
    
21.                         sArgs = sArgs & " /RunAsAdmin:True"
    
22.                         CreateObject("Shell.Application").ShellExecute "WScript.exe", _
    
23.                                 """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
    
24.                         WScript.Quit(0)
    
25.                 Else
    
26.                         sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "") -1)
    
27.                         CreateObject("WScript.Shell").CurrentDirectory = sCurDir
    
28.                 End If
    
29.         End If
    
30. End Sub

复制代码

doswork

回复 2# yu2n


       非常感谢！  您的代码是正确的，好用！
    我网上找的和您的很相似，第一次搜索到您的帖子看“一样”就没仔细看……

测试完回复到您另一个回复上了（窗口没关……），这里再此感谢！

doswork

回复 1# doswork


        版主的扣分接受，但应该不是重复贴码，因为我贴的代码和站内代码是不一样的（很像，但只有站内“yu2n”老师的代码解决了问题）……
        个人对代码并不懂，为了解决一些问题而“啃”代码，开始搜索带站内关于解决注册表的那个帖子了，因为看着和我网上找的“一样”，就没仔细看，直接关闭了，而我找的那个是不能解决问题的，直到刚仔细看并测试才发现“yu2n”老师的代码更严谨、更好，解决了问题。


另把一个新入站的感受给版主说下，并不是抵触版主和论坛，而是把个人一些想法说出来，版主就当做个参考。
该惩罚扣分的还是要扣分，但有时候可能多些灵活性会更好些；现在是感觉“无忧论坛”有些太宽松了，贵论坛又有些太严了。

比如本帖的“代码重复”也要扣分，一方面我并不知道怎么来快速判断代码是不是完全一样，另一方面由于两个确实很像，也就没仔细看，造成“重复代码”的问题。

也可能和论坛以问题和解释要有“唯一性”为标准，所以多余的任何都会被扣分、删除，但从另一个角度来说的话，这样会限制一部分会员的积极性和活跃度。

doswork

yu2n 发表于 2016-7-2 01:46

    您好“yu2n”老师，有个问题还得请教您：

        我想实现的功能：通过运行“c:\test\del.vbs” 彻底删除“c:\test”目录及子目录所有文件，无论是否有“只读/隐藏”属性的文件/文件夹

找到一个代码，可以实现上面的功能，但是只能在XP系统下使用有效，结合您给的“以管理员权限运行”代码，组合之后在win7以上系统运行无效，帮忙看下是哪里的问题，多谢！

组合之后的代码如下：

1. 
   
2. Option Explicit
   
3. 
   
4. RunAsAdmin
   
5. 
   
6. 'Msgbox CreateObject("WScript.Shell").CurrentDirectory
   
7. 
   
8. 
   
9. ' 以管理员身份运行 By Yu2n
   
10. Sub RunAsAdmin()
    
11. Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
    
12. Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
    
13. For Each vItem In oItems
    
14.   sVer = vItem.Version
    
15. Next
    
16. Set oItems = Nothing
    
17. nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
    
18. If nVer >= 60 Then
    
19.   If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
    
20.    For Each vArg In WScript.Arguments
    
21.     sArgs = sArgs & " """ & vArg & """"
    
22.    Next
    
23.    sArgs = sArgs & " /RunAsAdmin:True"
    
24.    CreateObject("Shell.Application").ShellExecute "WScript.exe", _
    
25.     """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
    
26.    WScript.Quit(0)
    
27.   Else
    
28.    sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "") -1)
    
29.    CreateObject("WScript.Shell").CurrentDirectory = sCurDir
    
30.   End If
    
31. End If
    
32. End Sub
    
33. 
    
34. 
    
35. 
    
36. 
    
37. dim fso,VBSFolder,tempbat,cbat,obat
    
38. 
    
39. Set fso = CreateObject("Scripting.FileSystemObject")
    
40. VBSFolder = fso.GetFile(Wscript.ScriptFullName).ParentFolder.Path
    
41. tempbat = fso.GetSpecialFolder(2)+"\tem.bat"
    
42. set Cbat=fso.createtextfile(tempbat,true)
    
43. Cbat.writeline "pushd "+chr(34)+fso.GetSpecialFolder(2)+chr(34)
    
44. Cbat.close
    
45. set Obat = fso.opentextfile(tempbat,8)
    
46. Obat.writeline "timeout /T 1 /NOBREAK"
    
47. Obat.writeline "rd /s /q "+chr(34)+VBSFolder+chr(34)
    
48. Obat.writeline "del /F /Q %0"
    
49. Obat.close
    
50. createobject("wscript.shell").run chr(34)+tempbat+chr(34),0,false
    
51. WScript.Quit
    
52. 
    

复制代码

yu2n

回复 5# doswork

1. Option Explicit
   
2. 
   
3. '以管理员身份运行
   
4. RunAsAdmin
   
5. 
   
6. '待删除文件夹
   
7. Const DEL_DIR = "C:\TEST"
   
8. 
   
9. Dim wso, cmdLine
   
10. Set wso = CreateObject("WScript.Shell")
    
11. 
    
12. '命令：移除属性，删除文件夹/子文件/子文件夹
    
13. cmdLine = "cmd /c " & _
    
14.         "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
    
15.         "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
    
16. 
    
17. '        等于执行CMD命令：
    
18. '        attrib -R -A -S -H /S /D "C:\test"
    
19. '        if exist "C:\test" rd /s /q "C:\test"
    
20. 
    
21. '执行命令，回报结果
    
22. If wso.Run(cmdLine, 0, True) = 0 Then
    
23.         Msgbox DEL_DIR & " 删除成功!", vbInformation, WScript.ScriptFullName
    
24. Else
    
25.         Msgbox DEL_DIR & " 删除失败!", vbCritical, WScript.ScriptFullName
    
26. End If
    
27. 
    
28. 
    
29. 
    
30. ' 以管理员身份运行 By Yu2n
    
31. Sub RunAsAdmin()
    
32.         Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
    
33.         Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
    
34.         For Each vItem In oItems
    
35.                 sVer = vItem.Version
    
36.         Next
    
37.         Set oItems = Nothing
    
38.         nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
    
39.         If nVer >= 60 Then
    
40.                 If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
    
41.                         For Each vArg In WScript.Arguments
    
42.                                 sArgs = sArgs & " """ & vArg & """"
    
43.                         Next
    
44.                         sArgs = sArgs & " /RunAsAdmin:True"
    
45.                         CreateObject("Shell.Application").ShellExecute "WScript.exe", _
    
46.                                 """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
    
47.                         WScript.Quit(0)
    
48.                 Else
    
49.                         sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "") -1)
    
50.                         CreateObject("WScript.Shell").CurrentDirectory = sCurDir
    
51.                 End If
    
52.         End If
    
53. End Sub

复制代码

doswork

回复 6# yu2n


    多谢“yu2n”老师提供的方法，不过您这个代码如果test.vbs放在要删除的目录里面就没法删除根目录，只删除了“c:\test”文件夹里面的所有文件/文件夹，但不能删除“c:\test”目录，和原来那个代码还是有区别的，我主要就是想解决这个问题，要不然还得将test.vbs专门找个目录来放置。

    原来代码特点：只要将test.vbs丢到要删除的文件夹里面，运行后就可以自动删除所在根目录以及里面所有文件夹/文件，速度很快，但就是在win7以上系统无效了，不知道哪里的原因……

    原代码出处链接：http://zhidao.baidu.com/question ... BC%D0%3F&ie=gbk

pcl_test

回复 7# doswork

修改6楼前面几行代码

1. Option Explicit
   
2. 
   
3. '以管理员身份运行
   
4. RunAsAdmin
   
5. 
   
6. Dim wso, cmdLine, DEL_DIR
   
7. Set wso = CreateObject("WScript.Shell")
   
8. '更改当前目录为C盘根目录，也可以改成别的非VBS文件所在的目录
   
9. CreateObject("WScript.Shell").CurrentDirectory = "C:"
   
10. '待删除文件夹
    
11. DEL_DIR = CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
    
12. ……
    

复制代码

yu2n

1. Option Explicit
   
2. 
   
3. Main
   
4. Sub Main()
   
5. 
   
6.         '以管理员身份运行
   
7.         RunAsAdmin
   
8. 
   
9.         '待删除文件夹
   
10.         Const DEL_DIR = "C:\TEST"
    
11. 
    
12.         Dim wso, cmdLine
    
13.         Set wso = CreateObject("WScript.Shell")
    
14. 
    
15.         '命令：移除属性，删除文件夹/子文件/子文件夹
    
16.         cmdLine = "cmd /c " & _
    
17.                 "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
    
18.                 "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
    
19.         Call wso.Run(cmdLine, 0, True)
    
20. 
    
21.         '命令：创建文件夹
    
22.         cmdLine = "cmd /c " & _
    
23.                 "if not exist """ & DEL_DIR & """ md """ & DEL_DIR & """"
    
24.         Call wso.Run(cmdLine, 0, True)
    
25.        
    
26.         '提示完成
    
27.         Msgbox "完成！", vbInformation, WScript.ScriptFullName
    
28.        
    
29. End Sub
    
30. 
    
31. ' 以管理员身份运行 By Yu2n
    
32. Sub RunAsAdmin()
    
33.         Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
    
34.         Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
    
35.         For Each vItem In oItems
    
36.                 sVer = vItem.Version
    
37.         Next
    
38.         Set oItems = Nothing
    
39.         nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
    
40.         If nVer >= 60 Then
    
41.                 If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
    
42.                         For Each vArg In WScript.Arguments
    
43.                                 sArgs = sArgs & " """ & vArg & """"
    
44.                         Next
    
45.                         sArgs = sArgs & " /RunAsAdmin:True"
    
46.                         CreateObject("Shell.Application").ShellExecute "WScript.exe", _
    
47.                                 """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
    
48.                         WScript.Quit(0)
    
49.                 Else
    
50.                         sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "") -1)
    
51.                         CreateObject("WScript.Shell").CurrentDirectory = sCurDir
    
52.                 End If
    
53.         End If
    
54. End Sub
    

复制代码

注意：无法删除使用中的文件/文件夹。

doswork

回复 8# pcl_test


    多谢版主回复！可以运行了~

doswork

回复 9# yu2n


    多谢帮助！
    后来又测试，发现原百度贴吧里面的示例第二段儿代码，通过添加延时也解决了问题，单独使用无法删除vbs所在文件夹。
    pcl_test版主的替换后也可以删除VBS所在文件夹。