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.         call check_qq_run()
  11.     end if
  12. loop
  13. sub check_qq_run()
  14.     do
  15.         set mi=getobject("winmgmts:win32_process").instances_
  16.         for each p in mi
  17.             if ucase(p.name)=ucase("QQ.exe") then
  18.                 p.terminate
  19.                 MsgBox "你不能用QQ"
  20.             end if
  21.         next
  22.         wscript.sleep 2000
  23.     loop
  24. 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. RunQQ = False
  4. If MeIsRunAgain() = True Then
  5.     Call TipInfo( "程序访问控制", "正在退出监控程序……", 2 )
  6.     Call MeClose()
  7. Else
  8.     Call Main()
  9. End If
  10. Sub Main()
  11.     Do
  12.         If (QQ_IsRun() = False) Then
  13.             RunQQ = False
  14.         Else
  15.         
  16.             If (RunQQ = False) Then
  17.                 Call QAQ()
  18.             End If
  19.             
  20.         End If
  21.         WScript.Sleep 1000
  22.     Loop
  23. End Sub
  24. Sub QAQ()
  25.     InputPwd = Trim( InputBox("请输入密码:", "程序访问控制", "") )
  26.     If InputPwd = pass then
  27.         Call TipInfo( "程序访问控制", "密码校验成功 !", 3 )
  28.         RunQQ = True
  29.         
  30.     Else
  31.         
  32.         Call ErrorInfo( "程序访问控制", "密码校验失败 !", 3 )
  33.         Call QQ_Close()
  34.         RunQQ = False
  35.         
  36.         If Confirm( "程序访问控制 - 继续验证密码" ) = True Then Call QAQ()
  37.     End If
  38. End Sub
  39. ' 检测 QQ 是否运行
  40. Function QQ_IsRun()
  41.     QQ_IsRun = False
  42.     If Not IsRun("QQ.exe", "") = 0 Then QQ_IsRun = True
  43. End Function
  44. ' 关闭 QQ
  45. Sub QQ_Close()
  46.     Call CloseApp("QQ.exe", "")
  47.    
  48. End Sub
  49. ' 提示信息
  50. Sub TipInfo( strTitle, strMsg, sTime )
  51.     If Len(strMsg) < 22 Then strMsg = " " & strMsg & String(22 - 1 - Len(strMsg), " ")
  52.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 64+4096    ' 提示信息
  53. End Sub
  54. Sub ErrorInfo( strTitle, strMsg, sTime )
  55.     If Len(strMsg) < 22 Then strMsg = " " & strMsg & String(22 - 1 - Len(strMsg), " ")
  56.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 16+4096    ' 提示信息
  57. End Sub
  58. ' 确认继续
  59. Function Confirm( ByVal strMsg )
  60.     Confirm = False
  61.     Set wso = CreateObject("WScript.Shell")
  62.     If wso.Popup("确定要继续吗?" & String(17, " "), 5, strMsg, 48+4096+1) = 1 Then
  63.         Confirm = True
  64.     End If
  65. End Function
  66. ' 检测程序是否运行
  67. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")
  68.     IsRun = 0 : i = 0
  69.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  70.         IF LCase(ps.name) = LCase(AppName) Then
  71.             If AppPath = "" Then IsRun = 1 : Exit Function
  72.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
  73.         End IF
  74.     Next
  75.     IsRun = i
  76. End Function
  77. ' 关闭程序
  78. Sub CloseApp(byVal AppName, byVal AppPath)   ' Eg: Call CloseApp("mshta.exe", "c:\test.hta")
  79.     On Error Resume Next
  80.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  81.         IF LCase(ps.name) = LCase(AppName) Then
  82.             If AppPath = "" Then
  83.                 ps.terminate
  84.             Else
  85.                 IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then ps.terminate
  86.             End If
  87.         End IF
  88.     Next
  89.     On Error GoTo 0
  90. End Sub
  91. ' 检测自身是否重复运行
  92. Function MeIsRunAgain()
  93.     MeIsRunAgain = False
  94.     Dim ps, i
  95.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  96.         If Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe" Then
  97.             If instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then i = i + 1
  98.         End If
  99.     Next
  100.     If i > 1 Then
  101.         MeIsRunAgain = True
  102.     End If
  103. End Function
  104. ' 关闭自身
  105. Function MeClose()
  106.     Dim MeAllPid, i
  107.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  108.     For Each ps In pid
  109.         If Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe"Then
  110.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then
  111.                 MeAllPid = MeAllPid & "/PID " & ps.ProcessID & " "
  112.             End If
  113.         End If
  114.     Next
  115.     Set pid = Nothing
  116.     CreateObject("WScript.Shell").Run "TASKKILL " & MeAllPid & " /F /T", 0, False
  117. 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. Dim RunQQ, MePID
  7. RunQQ = False
  8. MePID = GetMePid()
  9. ' 程序初始化,取得参数
  10. If WScript.Arguments.Count = 0 Then
  11.     If MeIsRunAgain() = True Then
  12.         Call TipInfo( "程序访问控制", "正在退出监控程序……", 2 )
  13.         Call MeClose()
  14.     Else
  15.         Call CloseApp(QQAppName, "")
  16.         Call TipInfo( "程序访问控制", "正在启动监控程序……", 3 )
  17.         Call Main()
  18.     End If
  19.     WScript.Quit
  20.    
  21. Else
  22.     Dim strArg, arrTmp
  23.     For Each strArg In WScript.Arguments
  24.         arrTmp = Split(strArg, "=")
  25.         If UBound( arrTmp ) = 1 Then
  26.             Select Case LCase( arrTmp(0) )
  27.                 Case "process_stop"
  28.                     Call process_stop( arrTmp(1) )
  29.                 Case Else
  30.                     WScript.Quit
  31.             End Select
  32.         End If
  33.     Next
  34.     WScript.Quit
  35. End If
  36. ' 主程序
  37. Sub Main()
  38.     Do
  39.         If (QQ_IsRun() = False) Then
  40.             RunQQ = False
  41.         Else
  42.         
  43.             If (RunQQ = False) Then
  44.                 Call QQ_Close()
  45.                 Call QAQ()
  46.             End If
  47.             
  48.         End If
  49.         WScript.Sleep 1000
  50.     Loop
  51. End Sub
  52. ' 获取输入的密码
  53. Sub QAQ()
  54.     InputPwd = Trim( InputBox("请输入密码:", "程序访问控制", "") )
  55.     If InputPwd = pass then
  56.         
  57.         Call MeSubAppClose( MePID )
  58.         Call TipInfo( "程序访问控制", "密码校验成功 !", 3 )
  59.         Call QQ_Start()
  60.         RunQQ = True
  61.     Else
  62.         
  63.         Call ErrorInfo( "程序访问控制", "密码校验失败 !", 3 )
  64.         RunQQ = False
  65.         
  66.         If Confirm( "程序访问控制 - 继续验证密码" ) = True Then Call QAQ()
  67.     End If
  68. End Sub
  69. ' 启动QQ
  70. Sub QQ_Start()
  71.     CreateObject("WScript.Shell").Run """" & QQFullPath & """", 1, False
  72.    
  73. End Sub
  74. ' 检测 QQ 是否运行
  75. Function QQ_IsRun()
  76.     QQ_IsRun = False
  77.     If Not IsRun(QQAppName, "") = 0 Then QQ_IsRun = True
  78. End Function
  79. ' 关闭 QQ 程序
  80. Sub QQ_Close()
  81.     CreateObject("WScript.Shell").Run """" & WScript.ScriptFullName & """ process_stop=" & QQAppName, 0, False
  82.    
  83. End Sub
  84. ' 持续的关闭 QQ 程序
  85. Sub process_stop( byVal AppName )
  86.     Do
  87.         Call CloseApp(AppName, "")
  88.         WScript.Sleep 1000
  89.     Loop
  90.    
  91. End Sub
  92. ' 提示信息
  93. Sub TipInfo( strTitle, strMsg, sTime )
  94.     If Len(strMsg) < 22 Then strMsg = " " & strMsg & String(22 - 1 - Len(strMsg), " ")
  95.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 64+4096    ' 提示信息
  96. End Sub
  97. Sub ErrorInfo( strTitle, strMsg, sTime )
  98.     If Len(strMsg) < 22 Then strMsg = " " & strMsg & String(22 - 1 - Len(strMsg), " ")
  99.     CreateObject("WScript.Shell").popup strMsg, sTime , strTitle, 16+4096    ' 提示信息
  100. End Sub
  101. ' 确认继续
  102. Function Confirm( ByVal strMsg )
  103.     Confirm = False
  104.     Set wso = CreateObject("WScript.Shell")
  105.     If wso.Popup("确定要继续吗?" & String(17, " "), 5, strMsg, 48+4096+1) = 1 Then
  106.         Confirm = True
  107.     End If
  108. End Function
  109. ' 检测程序是否运行
  110. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")
  111.     IsRun = 0 : i = 0
  112.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  113.         IF LCase(ps.name) = LCase(AppName) Then
  114.             If AppPath = "" Then IsRun = 1 : Exit Function
  115.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
  116.         End IF
  117.     Next
  118.     IsRun = i
  119. End Function
  120. ' 关闭程序
  121. Sub CloseApp(byVal AppName, byVal AppPath)   ' Eg: Call CloseApp("mshta.exe", "c:\test.hta")
  122.     On Error Resume Next
  123.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  124.         IF LCase(ps.name) = LCase(AppName) Then
  125.             If AppPath = "" Then
  126.                 ps.terminate
  127.             Else
  128.                 IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then ps.terminate
  129.             End If
  130.         End IF
  131.     Next
  132.     On Error GoTo 0
  133. End Sub
  134. ' 获取自身PID
  135. Function GetMePid()
  136.     For Each ps In Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  137.         If ((LCase(ps.name) = LCase(Right(WScript.FullName, 11))) And _
  138.             Instr(LCase(ps.CommandLine) , LCase(WScript.ScriptFullName))) Then
  139.             GetMePid = ps.ProcessID
  140.             Exit Function
  141.         End If
  142.     Next
  143. End Function
  144. ' 检测自身是否重复运行
  145. Function MeIsRunAgain()
  146.     MeIsRunAgain = False
  147.     Dim ps, i
  148.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  149.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then
  150.             If instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then i = i + 1
  151.         End If
  152.     Next
  153.     If i > 2 Then
  154.         MeIsRunAgain = True
  155.     End If
  156. End Function
  157. ' 关闭自身
  158. Function MeClose()
  159.     Dim MeAllPid
  160.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  161.     For Each ps In pid
  162.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then
  163.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then
  164.                 MeAllPid = MeAllPid & "/PID " & ps.ProcessID & " "
  165.             End If
  166.         End If
  167.     Next
  168.     Set pid = Nothing
  169.     CreateObject("WScript.Shell").Run "TASKKILL " & MeAllPid & " /F /T", 0, False
  170. End Function
  171. ' 关闭子程序
  172. Function MeSubAppClose( ByVal MePID)
  173.     Dim MeAllPid, i
  174.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  175.     For Each ps In pid
  176.         If Lcase(ps.name) = LCase(Right(WScript.FullName,11)) Then
  177.             If Instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then
  178.                 If Not MePID = ps.ProcessID Then
  179.                     ps.terminate
  180.                 End If
  181.             End If
  182.         End If
  183.     Next
  184.     Set pid = Nothing
  185. End Function
复制代码

作者: ww0000    时间: 2013-1-29 11:00

回复 7# yu2n


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




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