| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2844 人关注过本帖
标题:如何创建新的浏览器进程并自动登录账号
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:20 
我使用这种方法的一个程序.
程序代码:
Option Explicit

Private Const 窗口标题1 = "登录到一点智慧网络办公系统"
Private Const 窗口标题2 = "XXX政务内网"
Private Const 用户标签 = "txtUserName"
Private Const 提交标签 = "Imagebutton1"
Private Const 密码标签 = "txtPwd"
Private Const 登录页URL1 = "http://10.92.9.201/JXoa/login.aspx?ReturnUrl=%2fJXoa%2fFrameAll.aspx"
Private Const 登录页URL2 = "http://10.92.9.201/jxWebBuilder/SGWeb/index.aspx"
Private Const IEPATH = "C:\Program Files\Internet Explorer\IEXPLORE.EXE"

Dim 提示 As Boolean
Dim 窗口标题 As String
Dim 登录页URL As String

Private Sub Command1_Click()
    Dim IEList     As New ShellWindows
    Dim browser
    Dim Doc
      
    Dim yn As Boolean
      
    On Error Resume Next
      
    '遍历当前地浏览器窗口
    For Each browser In IEList
    
    '先找IE窗口
    If browser.FullName = IEPATH Then
          '找到需要地IE窗口
          If browser.Document.Title = 窗口标题 Then
              '获得浏览器地文档对象
              Set Doc = browser.Document
                
              '填写用户名字段
              Doc.body.All(用户标签).Value = Text1.Text
              '填写密码字段
              Doc.body.All(密码标签).Value = Text2.Text
                
              '提交
              Doc.body.All(提交标签).Click
              yn = True
              Exit For
          End If
        End If
    Next
    
    If Not yn Then          '未登录

        
        If Not 提示 Then
            Shell Chr(34) & IEPATH & Chr(34) & " " & 登录页URL, vbNormalFocus
            MsgBox "请等当前窗口打开完成后再次点击 登录 按钮 。", vbInformation, Me.Caption
        Else
            Shell Chr(34) & IEPATH & Chr(34) & " " & 登录页URL, vbNormalNoFocus
            Timer1.Enabled = True
        End If
    Else
        Unload Me
    End If
    
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    
    'user=nyjcxt pass=aassdd
        
    Dim i As String
    Dim j As Long
    Dim o As Long
    Dim k As String
    
    Dim fj() As String
    
    i = Trim(LCase(Command))
    
    If InStr(1, i, "?") > 0 Then
        k = "本程序支持命令启动,参数用如下几个:" & vbCrLf
        k = k & "? 显示本帮助" & vbCrLf
        k = k & "user=XXX 使用 XXX 这个用户进行登录" & vbCrLf
        k = k & "pass=YYY 使用 YYY 这个密码进行登录" & vbCrLf
        k = k & "/auto 在提供了用户名和密码的情况下自动登录" & vbCrLf
        k = k & "/home 在政务网首页进行登录,如果没这个参数,则在内容页登录" & vbCrLf
        k = k & "注意:如果想在开机就自动登录政务网,请制作 快捷方式 或 CMD 文件,放到开启菜单启用里就可以了。" & vbCrLf
        k = k & "如果没有打开 IE 浏览器的情况下,如果带了全部的参数,将会在 10 秒钟后重初,否则提示用户重新登录。" & vbCrLf
    
        MsgBox k, vbInformation, Me.Caption
        End
    End If
    
    If InStr(1, i, " ") > 0 Then
        j = Len(i)
        Do While j <> Len(i)
            j = Len(i)
            i = Replace(i, "  ", " ")
        Loop
        
        fj = Split(i, " ")
        
        For o = 0 To UBound(fj)
            If InStr(1, fj(o), "user=") > 0 Then
                Text1.Text = Mid(fj(o), 6)
            End If
            If InStr(1, fj(o), "pass=") > 0 Then
                Text2.Text = Mid(fj(o), 6)
            End If
        Next o
    End If
    
    If InStr(1, i, "/home") > 0 Then
        Option1(0).Value = True
    Else
        Option1(1).Value = True
    End If
    
    If InStr(1, i, "/auto") > 0 Then
        If Trim(Text1.Text) <> "" And Trim(Text2.Text) <> "" Then
            提示 = True
            Call Command1_Click
        Else
            MsgBox "传递的参数不全,请检查程序的快捷方式属性里的设置。", vbCritical, Me.Caption
            End
        End If
    End If
    
End Sub

Private Sub Option1_Click(Index As Integer)
    
    If Option1(0).Value Then
        窗口标题 = 窗口标题2
        登录页URL = 登录页URL2
    Else
        窗口标题 = 窗口标题1
        登录页URL = 登录页URL1
    End If
    
End Sub

Private Sub Text1_Change()
    If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
    End If
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Or KeyCode = 9 Then
        Text2.SetFocus
    End If
End Sub

Private Sub Text2_Change()
    Call Text1_Change
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Or KeyCode = 9 Then
        If Command1.Enabled Then
            Command1.SetFocus
        End If
    End If
End Sub

Private Sub Timer1_Timer()
    Call Command1_Click
End Sub



这论坛现在有点问题,发重贴子了,版主如果看到,把楼下删掉.

[[it] 本帖最后由 风吹过b 于 2009-7-17 16:02 编辑 [/it]]

授人于鱼,不如授人于渔
早已停用QQ了
2009-07-17 15:58
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
我使用这种方法的一个程序.
程序代码:
Option Explicit

Private Const 窗口标题1 = "登录到一点智慧网络办公系统"
Private Const 窗口标题2 = "XXX政务内网"
Private Const 用户标签 = "txtUserName"
Private Const 提交标签 = "Imagebutton1"
Private Const 密码标签 = "txtPwd"
Private Const 登录页URL1 = "http://10.92.9.201/JXoa/login.aspx?ReturnUrl=%2fJXoa%2fFrameAll.aspx"
Private Const 登录页URL2 = "http://10.92.9.201/jxWebBuilder/SGWeb/index.aspx"
Private Const IEPATH = "C:\Program Files\Internet Explorer\IEXPLORE.EXE"

Dim 提示 As Boolean
Dim 窗口标题 As String
Dim 登录页URL As String

Private Sub Command1_Click()
    Dim IEList     As New ShellWindows
    Dim browser
    Dim Doc
      
    Dim yn As Boolean
      
    On Error Resume Next
      
    '遍历当前地浏览器窗口
    For Each browser In IEList
    
    '先找IE窗口
    If browser.FullName = IEPATH Then
          '找到需要地IE窗口
          If browser.Document.Title = 窗口标题 Then
              '获得浏览器地文档对象
              Set Doc = browser.Document
                
              '填写用户名字段
              Doc.body.All(用户标签).Value = Text1.Text
              '填写密码字段
              Doc.body.All(密码标签).Value = Text2.Text
                
              '提交
              Doc.body.All(提交标签).Click
              yn = True
              Exit For
          End If
        End If
    Next
    
    If Not yn Then          '未登录

        
        If Not 提示 Then
            Shell Chr(34) & IEPATH & Chr(34) & " " & 登录页URL, vbNormalFocus
            MsgBox "请等当前窗口打开完成后再次点击 登录 按钮 。", vbInformation, Me.Caption
        Else
            Shell Chr(34) & IEPATH & Chr(34) & " " & 登录页URL, vbNormalNoFocus
            Timer1.Enabled = True
        End If
    Else
        Unload Me
    End If
    
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    
    'user=nyjcxt pass=aassdd
        
    Dim i As String
    Dim j As Long
    Dim o As Long
    Dim k As String
    
    Dim fj() As String
    
    i = Trim(LCase(Command))
    
    If InStr(1, i, "?") > 0 Then
        k = "本程序支持命令启动,参数用如下几个:" & vbCrLf
        k = k & "? 显示本帮助" & vbCrLf
        k = k & "user=XXX 使用 XXX 这个用户进行登录" & vbCrLf
        k = k & "pass=YYY 使用 YYY 这个密码进行登录" & vbCrLf
        k = k & "/auto 在提供了用户名和密码的情况下自动登录" & vbCrLf
        k = k & "/home 在政务网首页进行登录,如果没这个参数,则在内容页登录" & vbCrLf
        k = k & "注意:如果想在开机就自动登录政务网,请制作 快捷方式 或 CMD 文件,放到开启菜单启用里就可以了。" & vbCrLf
        k = k & "如果没有打开 IE 浏览器的情况下,如果带了全部的参数,将会在 10 秒钟后重初,否则提示用户重新登录。" & vbCrLf
    
        MsgBox k, vbInformation, Me.Caption
        End
    End If
    
    If InStr(1, i, " ") > 0 Then
        j = Len(i)
        Do While j <> Len(i)
            j = Len(i)
            i = Replace(i, "  ", " ")
        Loop
        
        fj = Split(i, " ")
        
        For o = 0 To UBound(fj)
            If InStr(1, fj(o), "user=") > 0 Then
                Text1.Text = Mid(fj(o), 6)
            End If
            If InStr(1, fj(o), "pass=") > 0 Then
                Text2.Text = Mid(fj(o), 6)
            End If
        Next o
    End If
    
    If InStr(1, i, "/home") > 0 Then
        Option1(0).Value = True
    Else
        Option1(1).Value = True
    End If
    
    If InStr(1, i, "/auto") > 0 Then
        If Trim(Text1.Text) <> "" And Trim(Text2.Text) <> "" Then
            提示 = True
            Call Command1_Click
        Else
            MsgBox "传递的参数不全,请检查程序的快捷方式属性里的设置。", vbCritical, Me.Caption
            End
        End If
    End If
    
End Sub

Private Sub Option1_Click(Index As Integer)
    
    If Option1(0).Value Then
        窗口标题 = 窗口标题2
        登录页URL = 登录页URL2
    Else
        窗口标题 = 窗口标题1
        登录页URL = 登录页URL1
    End If
    
End Sub

Private Sub Text1_Change()
    If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
    End If
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Or KeyCode = 9 Then
        Text2.SetFocus
    End If
End Sub

Private Sub Text2_Change()
    Call Text1_Change
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Or KeyCode = 9 Then
        If Command1.Enabled Then
            Command1.SetFocus
        End If
    End If
End Sub

Private Sub Timer1_Timer()
    Call Command1_Click
End Sub


授人于鱼,不如授人于渔
早已停用QQ了
2009-07-17 16:01
leilei88
Rank: 2
来 自:青岛
等 级:论坛游民
帖 子:217
专家分:27
注 册:2008-3-30
收藏
得分:0 
回复 10楼 风吹过b
非常感谢!!
但是我要登录多个号,所以要打开多个IE页面,但每个IE页面的标题肯定是一样的。。
我对VB不是很懂。。browser.Document.Title 有没有什么属性能得到这个浏览器的PID值的?shell执行一个进程后会返回一个PID值,我想通过PID值来区分是哪个页面。
2009-07-17 17:46
leilei88
Rank: 2
来 自:青岛
等 级:论坛游民
帖 子:217
专家分:27
注 册:2008-3-30
收藏
得分:0 
OK..忘记了。。只要登录后标题就改变了。。
2009-07-17 18:08
fangbnu
Rank: 1
等 级:新手上路
帖 子:6
专家分:7
注 册:2017-10-25
收藏
得分:0 
回复 10楼 风吹过b
老师,按您的方法实现了自动登录,诡异的是过了没几个小时再测试时,运行到“Browser.Document.Title”语句时出现提示“实时错误438,对象不支持该属性和方法”。请问是什么原因呢?

问题解决了,回帖完才看到这个帖子还有第二页,没对IE进行判断,谢谢老师

[此贴子已经被作者于2017-10-30 10:56编辑过]

2017-10-30 10:31
快速回复:如何创建新的浏览器进程并自动登录账号
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.053447 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved