yiwuyun

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

ygqiang

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

    vbs代码。。。

RunAsAdminstrator
Function GetQQPath()
  Const HKEY_LOCAL_MACHINE = &H80000002
  Dim s, sREG, sDis, sPath, oReg, fso
  sPath = ""
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Wss = CreateObject("Wscript.Shell")
  Set oReg = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")
  sREG = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
  oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  If IsNull(s) = False Then
    For i = 0 To Ubound(s)
      oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
      If Ucase(sDis) = "腾讯QQ" Then
        oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
      End If
    Next
  End If
  sREG = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
  oReg.EnumKey HKEY_LOCAL_MACHINE, sREG, s
  If IsNull(s) = False Then
    For i = 0 To Ubound(s)
      oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "DisplayName", sDis
      If Ucase(sDis) = "腾讯QQ" Then
        oReg.GetStringValue HKEY_LOCAL_MACHINE, sREG & "\" & s(i), "InstallLocation", sPath
      End If
    Next
  End If
  If sPath = "" Then
    'MsgBox "未找到 腾讯QQ 的注册表路径", 4096
    'CreateObject("Wscript.Shell").Popup "未找到 腾讯QQ 的注册表路径", 5
    Wss.Popup "未找到 腾讯QQ 的注册表路径", 5
    WScript.Quit(1)
  Else
    GetQQPath = fso.BuildPath(sPath, "Bin\QQ.exe")
    If fso.FileExists(GetQQPath) = False Then
      'MsgBox "未找到 " & GetQQPath, 4096
      'CreateObject("Wscript.Shell").Popup "未找到 " & GetQQPath, 5
      Wss.Popup "未找到 " & GetQQPath, 5
      WScript.Quit(2)
    End If
  End If
End Function

Sub RunAsAdminstrator() 
    Dim shell, os, arg, ver
    Set shell = CreateObject("Shell.Application")
    
    For Each os In GetObject("WinMgmts:").InstancesOf("Win32_OperatingSystem")
        ver = Left(os.Version, 3)
    Next
    If ver <> "6.1" And ver <> "6.0" And ver <> "6.3" Then Exit Sub
    
    For Each arg In WScript.Arguments.Named
        If LCase(arg) = "uac" Then Exit Sub
    Next
    
    Shell.ShellExecute "wscript.exe", Chr(34) & _
    WScript.ScriptFullName & Chr(34) & " /uac", "", "runas", 1
    WScript.Quit
End Sub


'定义QQ程序路径、帐号、密码 
Dim Program1,a,b,c 

Program1 = GetQQPath()
'MsgBox Program1
Set WshShell=createobject("wscript.shell") 

'运行QQ主程序 
Set oExec=WshShell.Exec(Program1) 
WScript.Sleep 5000 
'激活QQ窗口 
WshShell.AppActivate "qq" 
wshShell.SendKeys "+{TAB}" 
WScript.Sleep 2000 
'输入帐号 
a="24545640" 
WshShell.SendKeys a 
WScript.Sleep 1000 
WshShell.SendKeys "{TAB}" 
'输入帐号 
a="24545640" 
WshShell.SendKeys a 
WScript.Sleep 1000 
WshShell.SendKeys "{TAB}" 
WScript.Sleep 2000 
'输入密码 
b="245756" 
WshShell.SendKeys b 
WScript.Sleep 2000 

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

sepwolves

回复 3# shuzai


    还有sendkey功能噢

shuzai

qq登录窗不知道能不能用sendkey，你试试呗

ads350668398

能 网了怎么做了就是