Board logo

标题: [问题求助] 如何合并验证密码和禁止QQ的VBS脚本的功能？ [打印本页]
作者: ww0000    时间: 2013-1-23 21:52     标题: 如何合并验证密码和禁止QQ的VBS脚本的功能？

这是个验证密码的脚本：
  1. dim a 

  2. const pass="123456" 

  3. do

  4.     a=inputbox("请输入密码")

  5.     if a=pass then 

  6.          msgbox("密码校验成功")

  7.          exit do

  8.     end if

  9. loop
复制代码
这是个禁止QQ程序的脚本：
  1. do

  2. set mi=getobject("winmgmts:win32_process").instances_

  3. for each p in mi

  4. if ucase(p.name)=ucase("QQ.exe") then 

  5. p.terminate

  6. MsgBox "你不能用QQ"

  7. end if

  8. next

  9. wscript.sleep 2000

  10. loop
复制代码
现在要将这两个脚本的功能合并起来，运行QQ程序就会要求你输入密码，密码正确，QQ运行；密码不正确，QQ不能运行！高手们，请考虑一下！谢谢！
作者: wankoilz    时间: 2013-1-23 23:13

我晕，("winmgmts:win32_process").instances_
这样写也行... ...无语了
真够简洁的.
作者: yu2n    时间: 2013-1-26 22:31

回复 1# ww0000


直接用你的代码，自己测试。
  1. dim a 

  2. const pass="123456" 

  3. do

  4.     a=inputbox("请输入密码")

  5.     if a=pass then 

  6.          msgbox("密码校验成功")

  7.          exit do

  8.     else

  9. 

  10.         ' 调用第二段程序

  11.         call check_qq_run()

  12. 

  13.     end if

  14. loop

  15. 

  16. 

  17. sub check_qq_run()

  18. 

  19.     do

  20.         set mi=getobject("winmgmts:win32_process").instances_

  21.         for each p in mi

  22.             if ucase(p.name)=ucase("QQ.exe") then 

  23.                 p.terminate

  24.                 MsgBox "你不能用QQ"

  25.             end if

  26.         next

  27.         wscript.sleep 2000

  28.     loop

  29. 

  30. end sub
复制代码
作者: ww0000    时间: 2013-1-27 08:31

回复 3# yu2n


    这个好象不能达到要求，

要每次运行QQ时，跳出要求输入密码，

如果密码错误，跳出“你不能使用QQ”。

如果密码正确，跳出QQ登陆的界面！
作者: yu2n    时间: 2013-1-27 23:43

本帖最后由 yu2n 于 2013-1-27 23:47 编辑
回复  yu2n


    这个好象不能达到要求，

要每次运行QQ时，跳出要求输入密码，

如果密码错误，跳 ...
ww0000 发表于 2013-1-27 08:31



供参考:
  1. Dim RunQQ

  2. const pass="123456" 

  3. 

  4. 

  5. RunQQ = False

  6. 

  7. 

  8. 

  9. If MeIsRunAgain() = True Then

  10.     Call TipInfo( "程序访问控制", "正在退出监控程序……", 2 )

  11.     Call MeClose()

  12. Else

  13.     Call Main()

  14. End If

  15. 

  16. 

  17. 

  18. Sub Main()

  19.     Do

  20.         If (QQ_IsRun() = False) Then

  21.             RunQQ = False

  22.         Else

  23.         

  24.             If (RunQQ = False) Then

  25.                 Call QAQ()

  26.             End If

  27.             

  28.         End If

  29. 

  30.         WScript.Sleep 1000

  31.     Loop

  32. End Sub

  33. 

  34. 

  35. 

  36. Sub QAQ()

  37. 

  38.     InputPwd = Trim( InputBox("请输入密码：", "程序访问控制", "") )

  39. 

  40.     If InputPwd = pass then 

  41. 

  42.         Call TipInfo( "程序访问控制", "密码校验成功 !", 3 )

  43.         RunQQ = True

  44.         

  45.     Else

  46.         

  47.         Call ErrorInfo( "程序访问控制", "密码校验失败 !", 3 )

  48.         Call QQ_Close()

  49.         RunQQ = False

  50.         

  51.         If Confirm( "程序访问控制 - 继续验证密码" ) = True Then Call QAQ()

  52. 

  53.     End If

  54. 

  55. End Sub

  56. 

  57. 

  58. 

  59. ' 检测 QQ 是否运行

  60. Function QQ_IsRun()

  61. 

  62.     QQ_IsRun = False

  63.     If Not IsRun("QQ.exe", "") = 0 Then QQ_IsRun = True

  64. 

  65. End Function

  66. 

  67. ' 关闭 QQ

  68. Sub QQ_Close()

  69. 

  70.     Call CloseApp("QQ.exe", "")

  71.     

  72. End Sub

  73. 

  74. 

  75. 

  76. ' 提示信息

  77. Sub TipInfo( strTitle, strMsg, sTime )

  78.     If Len(strMsg) < 22 Then strMsg = "　" & strMsg & String(22 - 1 - Len(strMsg), "　")

  79.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 64+4096    ' 提示信息

  80. End Sub

  81. Sub ErrorInfo( strTitle, strMsg, sTime )

  82.     If Len(strMsg) < 22 Then strMsg = "　" & strMsg & String(22 - 1 - Len(strMsg), "　")

  83.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 16+4096    ' 提示信息

  84. End Sub

  85. 

  86. ' 确认继续

  87. Function Confirm( ByVal strMsg )

  88.     Confirm = False

  89.     Set wso = CreateObject("WScript.Shell")

  90.     If wso.Popup("确定要继续吗？" & String(17, "　"), 5, strMsg, 48+4096+1) = 1 Then

  91.         Confirm = True

  92.     End If

  93. End Function

  94. 

  95. 

  96. 

  97. ' 检测程序是否运行

  98. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")

  99.     IsRun = 0 : i = 0

  100.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  101.         IF LCase(ps.name) = LCase(AppName) Then

  102.             If AppPath = "" Then IsRun = 1 : Exit Function

  103.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1

  104.         End IF

  105.     Next

  106.     IsRun = i

  107. End Function

  108. 

  109. ' 关闭程序

  110. Sub CloseApp(byVal AppName, byVal AppPath)   ' Eg: Call CloseApp("mshta.exe", "c:\test.hta")

  111.     On Error Resume Next

  112.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  113.         IF LCase(ps.name) = LCase(AppName) Then

  114.             If AppPath = "" Then

  115.                 ps.terminate

  116.             Else

  117.                 IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then ps.terminate

  118.             End If

  119.         End IF

  120.     Next

  121.     On Error GoTo 0

  122. End Sub

  123. 

  124. 

  125. 

  126. ' 检测自身是否重复运行

  127. Function MeIsRunAgain()

  128.     MeIsRunAgain = False

  129.     Dim ps, i

  130.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  131.         If Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe" Then

  132.             If instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then i = i + 1

  133.         End If

  134.     Next

  135.     If i > 1 Then

  136.         MeIsRunAgain = True

  137.     End If

  138. End Function

  139. 

  140. ' 关闭自身

  141. Function MeClose()

  142.     Dim MeAllPid, i

  143.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")

  144.     For Each ps In pid

  145.         If Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe"Then

  146.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then

  147.                 MeAllPid = MeAllPid & "/PID " & ps.ProcessID & " "

  148.             End If

  149.         End If

  150.     Next

  151.     Set pid = Nothing

  152.     CreateObject("WScript.Shell").Run "TASKKILL " & MeAllPid & " /F /T", 0, False

  153. End Function
复制代码
作者: ww0000    时间: 2013-1-28 08:23

回复 5# yu2n


    谢谢你，辛苦了！功能很强大，但不能达到要求！

你的脚本运行后，不用管它的密码窗口，不用输入任何东西，照样用QQ！
作者: yu2n    时间: 2013-1-29 09:08

本帖最后由 yu2n 于 2013-1-29 09:34 编辑

Ps: 我觉得你应该试着修改别人的代码，一步步学习，而不是要现成的。

参考：
  1. ' QQ 程序设定，自行修改(必须)

  2. Const pass="123456" 

  3. Const QQAppName = "qq.exe"

  4. Const QQFullPath = "E:\AF071\Desktop\qq.exe"

  5. 

  6. 

  7. ' 全局变量

  8. Dim RunQQ, MePID

  9. RunQQ = False

  10. MePID = GetMePid()

  11. 

  12. 

  13. ' 程序初始化，取得参数

  14. If WScript.Arguments.Count = 0 Then

  15. 

  16.     If MeIsRunAgain() = True Then

  17.         Call TipInfo( "程序访问控制", "正在退出监控程序……", 2 )

  18.         Call MeClose()

  19.     Else

  20.         Call CloseApp(QQAppName, "")

  21.         Call TipInfo( "程序访问控制", "正在启动监控程序……", 3 )

  22.         Call Main()

  23.     End If

  24. 

  25.     WScript.Quit

  26.     

  27. Else

  28.     Dim strArg, arrTmp

  29.     For Each strArg In WScript.Arguments

  30.         arrTmp = Split(strArg, "=")

  31.         If UBound( arrTmp ) = 1 Then 

  32.             Select Case LCase( arrTmp(0) )

  33.                 Case "process_stop"

  34.                     Call process_stop( arrTmp(1) )

  35.                 Case Else

  36.                     WScript.Quit

  37.             End Select

  38.         End If

  39.     Next

  40.     WScript.Quit

  41. End If

  42. 

  43. 

  44. 

  45. ' 主程序

  46. Sub Main()

  47.     Do

  48.         If (QQ_IsRun() = False) Then

  49.             RunQQ = False

  50.         Else

  51.         

  52.             If (RunQQ = False) Then

  53.                 Call QQ_Close()

  54.                 Call QAQ()

  55.             End If

  56.             

  57.         End If

  58. 

  59.         WScript.Sleep 1000

  60.     Loop

  61. End Sub

  62. 

  63. 

  64. ' 获取输入的密码

  65. Sub QAQ()

  66. 

  67.     InputPwd = Trim( InputBox("请输入密码：", "程序访问控制", "") )

  68. 

  69.     If InputPwd = pass then 

  70.         

  71.         Call MeSubAppClose( MePID )

  72.         Call TipInfo( "程序访问控制", "密码校验成功 !", 3 )

  73.         Call QQ_Start()

  74.         RunQQ = True

  75. 

  76.     Else

  77.         

  78.         Call ErrorInfo( "程序访问控制", "密码校验失败 !", 3 )

  79.         RunQQ = False

  80.         

  81.         If Confirm( "程序访问控制 - 继续验证密码" ) = True Then Call QAQ()

  82. 

  83.     End If

  84. 

  85. End Sub

  86. 

  87. 

  88. ' 启动QQ

  89. Sub QQ_Start()

  90. 

  91.     CreateObject("WScript.Shell").Run """" & QQFullPath & """", 1, False

  92.     

  93. End Sub

  94. 

  95. 

  96. ' 检测 QQ 是否运行

  97. Function QQ_IsRun()

  98. 

  99.     QQ_IsRun = False

  100.     If Not IsRun(QQAppName, "") = 0 Then QQ_IsRun = True

  101. 

  102. End Function

  103. 

  104. 

  105. ' 关闭 QQ 程序

  106. Sub QQ_Close()

  107. 

  108.     CreateObject("WScript.Shell").Run """" & WScript.ScriptFullName & """ process_stop=" & QQAppName, 0, False

  109.     

  110. End Sub

  111. 

  112. 

  113. ' 持续的关闭 QQ 程序

  114. Sub process_stop( byVal AppName )

  115. 

  116.     Do

  117.         Call CloseApp(AppName, "")

  118.         WScript.Sleep 1000

  119.     Loop

  120.     

  121. End Sub

  122. 

  123. 

  124. 

  125. ' 提示信息

  126. Sub TipInfo( strTitle, strMsg, sTime )

  127.     If Len(strMsg) < 22 Then strMsg = "　" & strMsg & String(22 - 1 - Len(strMsg), "　")

  128.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 64+4096    ' 提示信息

  129. End Sub

  130. Sub ErrorInfo( strTitle, strMsg, sTime )

  131.     If Len(strMsg) < 22 Then strMsg = "　" & strMsg & String(22 - 1 - Len(strMsg), "　")

  132.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 16+4096    ' 提示信息

  133. End Sub

  134. 

  135. ' 确认继续

  136. Function Confirm( ByVal strMsg )

  137.     Confirm = False

  138.     Set wso = CreateObject("WScript.Shell")

  139.     If wso.Popup("确定要继续吗？" & String(17, "　"), 5, strMsg, 48+4096+1) = 1 Then

  140.         Confirm = True

  141.     End If

  142. End Function

  143. 

  144. 

  145. 

  146. ' 检测程序是否运行

  147. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")

  148.     IsRun = 0 : i = 0

  149.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  150.         IF LCase(ps.name) = LCase(AppName) Then

  151.             If AppPath = "" Then IsRun = 1 : Exit Function

  152.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1

  153.         End IF

  154.     Next

  155.     IsRun = i

  156. End Function

  157. 

  158. 

  159. ' 关闭程序

  160. Sub CloseApp(byVal AppName, byVal AppPath)   ' Eg: Call CloseApp("mshta.exe", "c:\test.hta")

  161.     On Error Resume Next

  162.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  163.         IF LCase(ps.name) = LCase(AppName) Then

  164.             If AppPath = "" Then

  165.                 ps.terminate

  166.             Else

  167.                 IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then ps.terminate

  168.             End If

  169.         End IF

  170.     Next

  171.     On Error GoTo 0

  172. End Sub

  173. 

  174. 

  175. ' 获取自身PID

  176. Function GetMePid()

  177.     For Each ps In Getobject("winmgmts:\\.").InstancesOf("Win32_Process")

  178.         If ((LCase(ps.name) = LCase(Right(WScript.FullName, 11))) And _

  179.             Instr(LCase(ps.CommandLine) , LCase(WScript.ScriptFullName))) Then

  180.             GetMePid = ps.ProcessID

  181.             Exit Function

  182.         End If

  183.     Next

  184. End Function

  185. 

  186. 

  187. ' 检测自身是否重复运行

  188. Function MeIsRunAgain()

  189.     MeIsRunAgain = False

  190.     Dim ps, i

  191.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_

  192.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then

  193.             If instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then i = i + 1

  194.         End If

  195.     Next

  196.     If i > 2 Then

  197.         MeIsRunAgain = True

  198.     End If

  199. End Function

  200. 

  201. 

  202. ' 关闭自身

  203. Function MeClose()

  204.     Dim MeAllPid

  205.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")

  206.     For Each ps In pid

  207.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then

  208.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then

  209.                 MeAllPid = MeAllPid & "/PID " & ps.ProcessID & " "

  210.             End If

  211.         End If

  212.     Next

  213.     Set pid = Nothing

  214.     CreateObject("WScript.Shell").Run "TASKKILL " & MeAllPid & " /F /T", 0, False

  215. End Function

  216. 

  217. 

  218. ' 关闭子程序

  219. Function MeSubAppClose( ByVal MePID)

  220.     Dim MeAllPid, i

  221.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")

  222.     For Each ps In pid

  223.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then

  224.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then

  225.                 If Not MePID = ps.ProcessID Then

  226.                     ps.terminate

  227.                 End If

  228.             End If

  229.         End If

  230.     Next

  231.     Set pid = Nothing

  232. End Function
复制代码
作者: ww0000    时间: 2013-1-29 11:00

回复 7# yu2n


    谢谢,你真厉害,那么长的代码!



欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2