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

Rank: 1

帖子
36 
积分
51 
技术
0  
捐助
0  
注册时间
2015-11-3 
1楼 跳转到 » 正序看帖
打印
tT
发表于 2015-11-17 08:37 | 只看该作者

[文件操作] 批处理可以让qq登陆吗？

比如我用start "" "d:\...\qq.exe"调用qq之后，出现登陆窗口，我要用什么代码才能让它自己登陆，然后最小化呢？
收藏 分享

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
20楼
发表于 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}" 
复制代码

TOP

sepwolves

Rank: 1

帖子
36 
积分
51 
技术
0  
捐助
0  
注册时间
2015-11-3 
19楼
发表于 2015-12-7 09:26 | 只看该作者
回复 15# ygqiang
可不可以请教一下为什么要三次输入qq账号吗？

TOP

906053584

Rank: 1

帖子
7 
积分
22 
技术
1  
捐助
0  
注册时间
2014-11-22 
18楼
发表于 2015-11-26 22:38 | 只看该作者
看不懂，这有点复杂

TOP

sepwolves

Rank: 1

帖子
36 
积分
51 
技术
0  
捐助
0  
注册时间
2015-11-3 
17楼
发表于 2015-11-26 21:39 | 只看该作者
不过vbs还真看不懂。。。

TOP

sepwolves

Rank: 1

帖子
36 
积分
51 
技术
0  
捐助
0  
注册时间
2015-11-3 
16楼
发表于 2015-11-26 21:38 | 只看该作者
谢谢啊，没想到引起如此深刻的讨论。代码还那么长。。

TOP

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
15楼
发表于 2015-11-23 10:16 | 只看该作者
以上是vbs代码。。。目前基本解决问题了。。

TOP

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
14楼
发表于 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}" 
复制代码

TOP

sepwolves

Rank: 1

帖子
36 
积分
51 
技术
0  
捐助
0  
注册时间
2015-11-3 
13楼
发表于 2015-11-23 09:50 | 只看该作者
谢谢。还要调用vbs啊？

TOP

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
12楼
发表于 2015-11-20 00:13 | 只看该作者
yiwuyun 发表于 2015-11-19 23:02



    你的这个代码，保存成什么扩展名？应该如何运行呢？

TOP

yiwuyun

Rank: 3Rank: 3

帖子
168 
积分
283 
技术
25  
捐助
0  
注册时间
2014-11-23 
11楼
发表于 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。
###>

TOP

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
10楼
发表于 2015-11-19 10:08 | 只看该作者
回复 9# yiwuyun


    你好。。那应该如何修改楼上的那个vbs代码？谢谢了

TOP

yiwuyun

Rank: 3Rank: 3

帖子
168 
积分
283 
技术
25  
捐助
0  
注册时间
2014-11-23 
9楼
发表于 2015-11-18 22:49 | 只看该作者
现在的新版QQ启动时至少会出现两个进程，不能用title去激活，而且用title激活原来也很不可靠，所以我以前都是用进程ID去激活程序的。现在也应用进程ID去激活，并且我试了下，QQ只能是进程ID大的那个才行。

TOP

CrLf

Rank: 8Rank: 8

帖子
6388 
积分
18843 
技术
982  
捐助
100  
注册时间
2010-10-9 
8楼
发表于 2015-11-18 22:27 | 只看该作者
QQ 貌似有安全机制，输入密码时用钩子接管键盘输入，对输入有影响（监听会得到乱码），但不知道是否也作用于输出
别问我怎么知道的
链接：在线第三方命令行工具下载   bat、vbs、js 原生混编

TOP

ygqiang

Rank: 5Rank: 5

帖子
1282 
积分
723 
技术
13  
捐助
50  
注册时间
2010-4-18 
7楼
发表于 2015-11-18 22:08 | 只看该作者
看了一下代码，感觉75行
75.WshShell.AppActivate "qq"
有问题，可能并不能激活qq 对话框，因此下了代码 ...
yiwuyun 发表于 2015-11-18 19:29



    win7 64系统环境下，

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

最近就不好用了。。。。

TOP

12
返回列表