[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] [已解决]xp/win7系统下,vbs如何获取qq安装路径?并赋值给变量?

本帖最后由 ygqiang 于 2015-5-6 19:27 编辑

[已解决]xp/win7系统下,vbs如何获取qq安装路径?并赋值给变量?
另外,下面的vbs代码,能否进一步简化?
  1. '定义QQ程序路径、帐名、密码
  2. Dim Program1,a,b
  3. Program1= "qq路径"
  4. Set WshShell=createobject("wscript.shell")
  5. '运行QQ主程序
  6. Set oExec=WshShell.Exec(Program1)
  7. WScript.Sleep 3000
  8. '激活QQ窗口
  9. WshShell.AppActivate "qq"
  10. wshShell.SendKeys "+{TAB}"
  11. '输入帐号
  12. a="qq号码"
  13. WshShell.SendKeys a
  14. WScript.Sleep 1000
  15. WshShell.SendKeys "{TAB}"
  16. '输入帐号
  17. a="qq号码"
  18. WshShell.SendKeys a
  19. WScript.Sleep 1000
  20. WshShell.SendKeys "{TAB}"
  21. WScript.Sleep 1000
  22. '输入密码
  23. b="qq密码"
  24. WshShell.SendKeys b
  25. WScript.Sleep 1000
  26. WshShell.SendKeys "{ENTER}"
复制代码
qq路径,以下情况都有可能:
C:\Program Files\Tencent\QQ\Bin\QQ.exe
C:\Program Files (x86)\Tencent\QQ\Bin\QQ.exe
D:\Program Files\Tencent\QQ\Bin\QQ.exe
D:\xxx\???\QQ.exe
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

最终修改后的解决方案:
  1. RunAsAdminstrator
  2. Function GetQQPath()
  3.   Const HKEY_LOCAL_MACHINE = &H80000002
  4.   Dim s, sREG, sDis, sPath, oReg, fso
  5.   sPath = ""
  6.   Set fso = CreateObject("Scripting.FileSystemObject")
  7.   Set Wss = CreateObject("Wscript.Shell")
  8.   Set oReg = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")
  9.   sREG = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
  10.   oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  11.   If IsNull(s) = False Then
  12.     For i = 0 To Ubound(s)
  13.       oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
  14.       If Ucase(sDis) = "腾讯QQ" Then
  15.         oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
  16.       End If
  17.     Next
  18.   End If
  19.   sREG = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
  20.   oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  21.   If IsNull(s) = False Then
  22.     For i = 0 To Ubound(s)
  23.       oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
  24.       If Ucase(sDis) = "腾讯QQ" Then
  25.         oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
  26.       End If
  27.     Next
  28.   End If
  29.   If sPath = "" Then
  30.     'MsgBox "未找到 腾讯QQ 的注册表路径", 4096
  31.     'CreateObject("Wscript.Shell").Popup "未找到 腾讯QQ 的注册表路径", 5
  32.     Wss.Popup "未找到 腾讯QQ 的注册表路径", 5
  33.     WScript.Quit(1)
  34.   Else
  35.     GetQQPath = fso.BuildPath(sPath, "Bin\QQ.exe")
  36.     If fso.FileExists(GetQQPath) = False Then
  37.       'MsgBox "未找到 " & GetQQPath, 4096
  38.       'CreateObject("Wscript.Shell").Popup "未找到 " & GetQQPath, 5
  39.       Wss.Popup "未找到 " & GetQQPath, 5
  40.       WScript.Quit(2)
  41.     End If
  42.   End If
  43. End Function
  44. Sub RunAsAdminstrator()
  45.     Dim shell, os, arg, ver
  46.     Set shell = CreateObject("Shell.Application")
  47.    
  48.     For Each os In GetObject("WinMgmts:").InstancesOf("Win32_OperatingSystem")
  49.         ver = Left(os.Version, 3)
  50.     Next
  51.     If ver <> "6.1" And ver <> "6.0" And ver <> "6.3" Then Exit Sub
  52.    
  53.     For Each arg In WScript.Arguments.Named
  54.         If LCase(arg) = "uac" Then Exit Sub
  55.     Next
  56.    
  57.     Shell.ShellExecute "wscript.exe", Chr(34) & _
  58.     WScript.ScriptFullName & Chr(34) & " /uac", "", "runas", 1
  59.     WScript.Quit
  60. End Sub
  61. '定义QQ程序路径、帐号、密码
  62. Dim Program1,a,b,c
  63. Program1 = GetQQPath()
  64. 'MsgBox Program1
  65. Set WshShell=createobject("wscript.shell")
  66. '运行QQ主程序
  67. Set oExec=WshShell.Exec(Program1)
  68. WScript.Sleep 3000
  69. '激活QQ窗口
  70. WshShell.AppActivate "qq"
  71. wshShell.SendKeys "+{TAB}"
  72. WScript.Sleep 1000
  73. '输入帐号
  74. a="qq帐号"
  75. WshShell.SendKeys a
  76. WScript.Sleep 1000
  77. WshShell.SendKeys "{TAB}"
  78. '输入帐号
  79. a="qq帐号"
  80. WshShell.SendKeys a
  81. WScript.Sleep 1000
  82. WshShell.SendKeys "{TAB}"
  83. WScript.Sleep 2000
  84. '输入密码
  85. b="qq密码前半部分"
  86. WshShell.SendKeys b
  87. WScript.Sleep 2000
  88. '输入密码
  89. c="qq密码后半部分"
  90. WshShell.SendKeys c
  91. WScript.Sleep 1000
  92. WshShell.SendKeys "{ENTER}"
复制代码

TOP

回复 13# zz100001


   赞一个

QQ 20147578

TOP

回复 13# zz100001


    补充一下,QQ 和 TM 都支持命令行参数,例如:
  1. "C:\Program Files\Tencent\TM\Bin\TM.exe" /uin:10000
复制代码

TOP

你这是在弄QQ自动登陆吗?
找马化腾协商一下,弄个命令行接口不是最简单。。。。
下面是一个启动指定QQ号的vbs代码,你可以试试,密码还得自己输
(账号可以是邮箱的)
  1. ' 创建QQ自带的对象
  2. Set c = WScript.CreateObject("QQCPHelper.CPAdder")
  3. ' 启动QQ并指定一个号码
  4. c.StartupIM "273088140"
复制代码
1

评分人数

TOP

回复  ygqiang


    “输入帐号”写两遍有啥原因吗
gawk 发表于 2015-5-6 08:46




为啥要输入2次qq号码??

应该是按键后用于获取焦点之类的
估计是第一次用于获取焦点..第一次可以只直接随意输入一个按键..
然后再输入账号。。

TOP

回复 10# ygqiang

MsgBox "未找到 腾讯QQ 的注册表路径", 4096改为
CreateObject("Wscript.Shell").Popup "未找到 腾讯QQ 的注册表路径", 5

TOP

回复 5# CrLf  

情况2(如果不确定是否装了qq软件)————————————————————————————————————
  1. Function GetQQPath()
  2.   Const HKEY_LOCAL_MACHINE = &H80000002
  3.   Dim s, sREG, sDis, sPath, oReg, fso
  4.   sPath = ""
  5.   Set fso = CreateObject("Scripting.FileSystemObject")
  6.   Set oReg = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")
  7.   sREG = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
  8.   oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  9.   If IsNull(s) = False Then
  10.     For i = 0 To Ubound(s)
  11.       oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
  12.       If Ucase(sDis) = "腾讯QQ" Then
  13.         oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
  14.       End If
  15.     Next
  16.   End If
  17.   sREG = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
  18.   oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  19.   If IsNull(s) = False Then
  20.     For i = 0 To Ubound(s)
  21.       oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
  22.       If Ucase(sDis) = "腾讯QQ" Then
  23.         oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
  24.       End If
  25.     Next
  26.   End If
  27.   If sPath = "" Then
  28.     MsgBox "未找到 腾讯QQ 的注册表路径", 4096
  29.     WScript.Quit(1)
  30.   Else
  31.     GetQQPath = fso.BuildPath(sPath, "Bin\QQ.exe")
  32.     If fso.FileExists(GetQQPath) = False Then
  33.       MsgBox "未找到 " & GetQQPath, 4096
  34.       WScript.Quit(2)
  35.     End If
  36.   End If
  37. End Function
  38. '定义QQ程序路径、帐名、密码
  39. Dim Program1,a,b
  40. Program1 = GetQQPath()
  41. 'MsgBox Program1
  42. Set WshShell=createobject("wscript.shell")
  43. '运行QQ主程序
  44. Set oExec=WshShell.Exec(Program1)
  45. WScript.Sleep 3000
  46. '激活QQ窗口
  47. WshShell.AppActivate "qq"
  48. wshShell.SendKeys "+{TAB}"
  49. WScript.Sleep 1000
  50. '输入帐号
  51. a="273088140"
  52. WshShell.SendKeys a
  53. WScript.Sleep 1000
  54. WshShell.SendKeys "{TAB}"
  55. '输入帐号
  56. a="273088140"
  57. WshShell.SendKeys a
  58. WScript.Sleep 1000
  59. WshShell.SendKeys "{TAB}"
  60. WScript.Sleep 2000
  61. '输入密码
  62. b="ygq$2008"
  63. WshShell.SendKeys b
  64. WScript.Sleep 1000
  65. WshShell.SendKeys "{ENTER}"
复制代码
如果没有装qq。会弹出这个对话框,
能否修改下vbs代码。设置:倒计时5秒后自动关闭对话框。。

TOP

回复 5# CrLf


    初步解决了。。。

情况1(如果已经确定装了qq软件)————————————————————————————————————
  1. '定义QQ程序路径、帐名、密码
  2. Dim Program1,a,b
  3. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
  4. Set WshShell = CreateObject("Wscript.Shell")
  5. Tencent = WshShell.RegRead("HKEY_CLASSES_ROOT\Tencent\shell\open\command\")
  6. Program1 = Replace(Tencent,"""","")
  7. Program1 = fso.GetFolder(Program1&"\..")&"\QQ.exe"
  8. 'MsgBox Program1
  9. '运行QQ主程序
  10. Set oExec=WshShell.Exec(Program1)
  11. WScript.Sleep 3000
  12. '激活QQ窗口
  13. WshShell.AppActivate "qq"
  14. WScript.Sleep 1000
  15. wshShell.SendKeys "+{TAB}"
  16. WScript.Sleep 1000
  17. '输入帐号
  18. a="273088140"
  19. WshShell.SendKeys a
  20. WScript.Sleep 1000
  21. WshShell.SendKeys "{TAB}"
  22. '输入帐号
  23. a="273088140"
  24. WshShell.SendKeys a
  25. WScript.Sleep 1000
  26. WshShell.SendKeys "{TAB}"
  27. WScript.Sleep 2000
  28. '输入密码
  29. b="ygq$2008"
  30. WshShell.SendKeys b
  31. WScript.Sleep 1000
  32. WshShell.SendKeys "{ENTER}"
复制代码

TOP

回复 7# gawk


装最新版本qq,  如果只输入1次。。测试过。不行。。。

TOP

回复 6# ygqiang


    “输入帐号”写两遍有啥原因吗
Talk is cheap. Show me the code.
没事不要瞎扯淡,有能耐就把代码贴出来给我看。

TOP

回复 5# CrLf


    多谢。。。。。下面这个vbs代码,是否有进一步简化的可能。。。。
  1. Dim Program1,a,b
  2. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
  3. Set WshShell = CreateObject("Wscript.Shell")
  4. Tencent = WshShell.RegRead("HKEY_CLASSES_ROOT\Tencent\shell\open\command\")
  5. Program1 = Replace(Tencent,"""","")
  6. Program1 = fso.GetFolder(Program1&"\..")&"\QQ.exe"
  7. 'MsgBox Program1
  8. '运行QQ主程序
  9. Set oExec=WshShell.Exec(Program1)
  10. WScript.Sleep 3000
  11. '激活QQ窗口
  12. WshShell.AppActivate "qq"
  13. wshShell.SendKeys "+{TAB}"
  14. '输入帐号
  15. a="qq号码"
  16. WshShell.SendKeys a
  17. WScript.Sleep 1000
  18. WshShell.SendKeys "{TAB}"
  19. '输入帐号
  20. a="qq号码"
  21. WshShell.SendKeys a
  22. WScript.Sleep 1000
  23. WshShell.SendKeys "{TAB}"
  24. WScript.Sleep 1000
  25. '输入密码
  26. b="qq密码"
  27. WshShell.SendKeys b
  28. WScript.Sleep 1000
  29. WshShell.SendKeys "{ENTER}"
复制代码

TOP

回复 4# ygqiang


vbs 原理一样:
  1. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
  2. Set WS = CreateObject("Wscript.Shell")
  3. Tencent = WS.RegRead("HKEY_CLASSES_ROOT\Tencent\shell\open\command\")
  4. QQ = Replace(Tencent,"""","")
  5. QQ = fso.GetFolder(QQ&"\..")&"\QQ.exe"
  6. MsgBox QQ
复制代码
1

评分人数

TOP

如果是正常安装的官方版本,可以试试这个:实测 QQ7.1 有效,不确定是否通用于 TM、QQ国际版或其他版本 QQ
CrLf 发表于 2015-5-5 23:37



多谢。。win7 64系统下,测试了下。。好用。。。

不过你这个是bat代码。。。不是vbs的。。。

TOP

[quote]如果是正常安装的官方版本,可以试试这个:实测 QQ7.1 有效,不确定是否通用于 TM、QQ国际版或其他版本 QQ
CrLf 发表于 2015-5-5 23:37 %

TOP

返回列表