Board logo

标题: [文件操作] 批处理可以让qq登陆吗？ [打印本页]
作者: sepwolves    时间: 2015-11-17 08:37     标题: 批处理可以让qq登陆吗？

比如我用start "" "d:\...\qq.exe"调用qq之后，出现登陆窗口，我要用什么代码才能让它自己登陆，然后最小化呢？
作者: ads350668398    时间: 2015-11-17 14:40

能 网了怎么做了就是
作者: shuzai    时间: 2015-11-17 15:16

qq登录窗不知道能不能用sendkey，你试试呗
作者: sepwolves    时间: 2015-11-18 08:06

回复 3# shuzai


    还有sendkey功能噢
作者: ygqiang    时间: 2015-11-18 18:05

比如我用start "" "d:\...\qq.exe"调用qq之后，出现登陆窗口，我要用什么代码才能让它自己登陆，然后最小化 ...
sepwolves 发表于 2015-11-17 08:37



    vbs代码。。。
  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. 

  45. Sub RunAsAdminstrator() 

  46.     Dim shell, os, arg, ver

  47.     Set shell = CreateObject("Shell.Application")

  48.     

  49.     For Each os In GetObject("WinMgmts:").InstancesOf("Win32_OperatingSystem")

  50.         ver = Left(os.Version, 3)

  51.     Next

  52.     If ver <> "6.1" And ver <> "6.0" And ver <> "6.3" Then Exit Sub

  53.     

  54.     For Each arg In WScript.Arguments.Named

  55.         If LCase(arg) = "uac" Then Exit Sub

  56.     Next

  57.     

  58.     Shell.ShellExecute "wscript.exe", Chr(34) & _

  59.     WScript.ScriptFullName & Chr(34) & " /uac", "", "runas", 1

  60.     WScript.Quit

  61. End Sub

  62. 

  63. 

  64. '定义QQ程序路径、帐号、密码 

  65. Dim Program1,a,b,c 

  66. 

  67. Program1 = GetQQPath()

  68. 'MsgBox Program1

  69. Set WshShell=createobject("wscript.shell") 

  70. 

  71. '运行QQ主程序 

  72. Set oExec=WshShell.Exec(Program1) 

  73. WScript.Sleep 5000 

  74. '激活QQ窗口 

  75. WshShell.AppActivate "qq" 

  76. wshShell.SendKeys "+{TAB}" 

  77. WScript.Sleep 2000 

  78. '输入帐号 

  79. a="24545640" 

  80. WshShell.SendKeys a 

  81. WScript.Sleep 1000 

  82. WshShell.SendKeys "{TAB}" 

  83. '输入帐号 

  84. a="24545640" 

  85. WshShell.SendKeys a 

  86. WScript.Sleep 1000 

  87. WshShell.SendKeys "{TAB}" 

  88. WScript.Sleep 2000 

  89. '输入密码 

  90. b="245756" 

  91. WshShell.SendKeys b 

  92. WScript.Sleep 2000 

  93. 

  94. WshShell.SendKeys "{ENTER}" 
复制代码
作者: yiwuyun    时间: 2015-11-18 19:29

看了一下代码，感觉75行
75.WshShell.AppActivate "qq"
有问题，可能并不能激活qq 对话框，因此下了代码，试了一下，好像真的不能哦。测试环境：WIN10和最新版QQ，如果我没记错，好像应该 用进程ID才行样。（不知是不是我没用对）。
作者: ygqiang    时间: 2015-11-18 22:08

看了一下代码，感觉75行
75.WshShell.AppActivate "qq"
有问题，可能并不能激活qq 对话框，因此下了代码 ...
yiwuyun 发表于 2015-11-18 19:29



    win7 64系统环境下，

这个vbs代码，实现自动登录qq。以前好用，

最近就不好用了。。。。
作者: CrLf    时间: 2015-11-18 22:27

QQ 貌似有安全机制，输入密码时用钩子接管键盘输入，对输入有影响（监听会得到乱码），但不知道是否也作用于输出
别问我怎么知道的
作者: yiwuyun    时间: 2015-11-18 22:49

现在的新版QQ启动时至少会出现两个进程，不能用title去激活，而且用title激活原来也很不可靠，所以我以前都是用进程ID去激活程序的。现在也应用进程ID去激活，并且我试了下，QQ只能是进程ID大的那个才行。
作者: ygqiang    时间: 2015-11-19 10:08

回复 9# yiwuyun


    你好。。那应该如何修改楼上的那个vbs代码？谢谢了
作者: yiwuyun    时间: 2015-11-19 23:02

本帖最后由 yiwuyun 于 2015-11-20 07:20 编辑 
  1. if ($true){}# == ($true){}# goto ___yiwuyun

  2. <#BeginBatOperation#

  3. :___yiwuyun

  4. @echo off&setlocal&cls

  5. (echo $yiwuyun_fileName="%~f0"&echo $strPath="%~dp0"&type "%~f0")|powershell -command -

  6. exit/b 0

  7. #EndBatOperation#>

  8. 

  9. <#StartPowerShell#>

  10. $QQPath=Get-ChildItem -Path "HKLM:\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"|%{if($_.GetValue("DisplayName") -eq "腾讯QQ"){$_.GetValue("InstallLocation");}}

  11. $QQProgram=Join-Path -Path $QQPath -ChildPath bin\qq.exe;

  12. $wsh=New-Object -ComObject "wscript.shell";

  13. $wsh.Exec($QQProgram);

  14. 

  15. ###此时有10秒中的时间可以作一些其他操作，将焦点转移到其他窗口中去。

  16. sleep 10;

  17. while(-not $wsh.AppActivate("qq")){;};

  18. $wsh.SendKeys("{ESC}");

  19. while(-not $wsh.AppActivate("qq")){;};

  20. $wsh.SendKeys("{ENTER}");

  21. $wsh.SendKeys("{ENTER}");

  22. ###猜测由于有QQ保护进程作怪，因此上述操作需要重复两次

  23. 

  24. $wsh.SendKeys("12345678{ENTER}yiwuyun{ENTER}");

  25. 

  26. 

  27. ###无法解决QQ登陆一次之后记住帐号的情形。我想要彻底解决只有删掉QQ号码下的配置文件才行。这个没有试了。

  28. 

  29. <#EndPowerShell#>
复制代码
<###
以上代码为批处理，扩展名为bat
vbs我不太熟了，但思路是一样，你可以照写。我前面说的用title会出问题不知是原来我写哪个小程序得出的结论，看来有错。但用进程ID同样能激活QQ。
###>
作者: ygqiang    时间: 2015-11-20 00:13

yiwuyun 发表于 2015-11-19 23:02



    你的这个代码，保存成什么扩展名？应该如何运行呢？
作者: sepwolves    时间: 2015-11-23 09:50

谢谢。还要调用vbs啊？
作者: ygqiang    时间: 2015-11-23 10:16

回复 13# sepwolves 
  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. 

  62. '定义QQ程序路径、帐号、密码 

  63. Dim Program1,a,b,c 

  64. Program1 = GetQQPath()

  65. 'MsgBox Program1

  66. Set WshShell=createobject("wscript.shell") 

  67. '运行QQ主程序 

  68. Set oExec=WshShell.Exec(Program1) 

  69. WScript.Sleep 5000 

  70. '激活QQ窗口 

  71. WshShell.SendKeys "{TAB}" 

  72. WshShell.SendKeys "{TAB}" 

  73. WshShell.SendKeys "{TAB}" 

  74. WshShell.SendKeys "{TAB}" 

  75. WshShell.SendKeys "{TAB}" 

  76. WshShell.SendKeys "{TAB}" 

  77. WshShell.SendKeys "{TAB}" 

  78. WshShell.SendKeys "{TAB}" 

  79. WshShell.SendKeys "{TAB}" 

  80. WshShell.SendKeys "{TAB}" 

  81. WshShell.SendKeys "{TAB}" 

  82. WScript.Sleep 3000 

  83. '输入帐号 

  84. a="qq帐号" 

  85. WshShell.SendKeys a 

  86. WScript.Sleep 1000 

  87. WshShell.SendKeys "{TAB}" 

  88. '输入帐号 

  89. a="qq帐号" 

  90. WshShell.SendKeys a 

  91. WScript.Sleep 1000 

  92. WshShell.SendKeys "{TAB}" 

  93. WScript.Sleep 2000 

  94. 

  95. '输入帐号 

  96. a="qq帐号" 

  97. WshShell.SendKeys a 

  98. WScript.Sleep 1000 

  99. WshShell.SendKeys "{ENTER}" 

  100. WScript.Sleep 1000

  101. 

  102. '输入密码 

  103. b="qq密码" 

  104. WshShell.SendKeys b 

  105. WScript.Sleep 2000

  106. 

  107. WshShell.SendKeys "{ENTER}" 
复制代码
作者: ygqiang    时间: 2015-11-23 10:16

以上是vbs代码。。。目前基本解决问题了。。
作者: sepwolves    时间: 2015-11-26 21:38

谢谢啊，没想到引起如此深刻的讨论。代码还那么长。。
作者: sepwolves    时间: 2015-11-26 21:39

不过vbs还真看不懂。。。
作者: 906053584    时间: 2015-11-26 22:38

看不懂，这有点复杂
作者: sepwolves    时间: 2015-12-7 09:26

回复 15# ygqiang
可不可以请教一下为什么要三次输入qq账号吗？
作者: ygqiang    时间: 2015-12-7 09:28

回复 19# sepwolves 
  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. 

  45. Sub RunAsAdminstrator() 

  46.     Dim shell, os, arg, ver

  47.     Set shell = CreateObject("Shell.Application")

  48.     

  49.     For Each os In GetObject("WinMgmts:").InstancesOf("Win32_OperatingSystem")

  50.         ver = Left(os.Version, 3)

  51.     Next

  52.     If ver <> "6.1" And ver <> "6.0" And ver <> "6.3" Then Exit Sub

  53.     

  54.     For Each arg In WScript.Arguments.Named

  55.         If LCase(arg) = "uac" Then Exit Sub

  56.     Next

  57.     

  58.     Shell.ShellExecute "wscript.exe", Chr(34) & _

  59.     WScript.ScriptFullName & Chr(34) & " /uac", "", "runas", 1

  60.     WScript.Quit

  61. End Sub

  62. 

  63. 

  64. '定义QQ程序路径、帐号、密码 

  65. Dim Program1,a,b,c 

  66. 

  67. Program1 = GetQQPath()

  68. 'MsgBox Program1

  69. Set WshShell=createobject("wscript.shell") 

  70. 

  71. '运行QQ主程序 

  72. Set oExec=WshShell.Exec(Program1) 

  73. WScript.Sleep 5000 

  74. 

  75. '激活QQ窗口 

  76. WshShell.SendKeys "{TAB}" 

  77. WshShell.SendKeys "{TAB}" 

  78. WshShell.SendKeys "{TAB}" 

  79. WshShell.SendKeys "{TAB}" 

  80. WshShell.SendKeys "{TAB}" 

  81. WshShell.SendKeys "{TAB}" 

  82. WshShell.SendKeys "{TAB}" 

  83. WshShell.SendKeys "{TAB}" 

  84. WshShell.SendKeys "{TAB}" 

  85. WshShell.SendKeys "{TAB}" 

  86. WshShell.SendKeys "{TAB}" 

  87. WshShell.SendKeys "{TAB}" 

  88. WScript.Sleep 3000 

  89. 

  90. 

  91. '输入帐号 

  92. a="qq号码"

  93. WshShell.SendKeys a

  94. WScript.Sleep 1000 

  95. WshShell.SendKeys "{ENTER}" 

  96. WScript.Sleep 2000 

  97. 

  98. '输入密码 

  99. b="qq密码" 

  100. WshShell.SendKeys b 

  101. WScript.Sleep 2000

  102. 

  103. WshShell.SendKeys "{ENTER}" 
复制代码




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