我使用这种方法的一个程序.
程序代码:
这论坛现在有点问题,发重贴子了,版主如果看到,把楼下删掉.
[[it] 本帖最后由 风吹过b 于 2009-7-17 16:02 编辑 [/it]]
程序代码:
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了










