电大在线学习软件

 

'因为没有那么多时间挂在线上学习，所以写了个程序偷点懒，基本思想是:建立控件组，重复装载登陆页面．在线时间与登录页面成正比．用sendMessage 函数模拟人工输入．基本上没有技术含量，能用就行了．

Dim ttimerss
Dim username
Dim password
Dim rul
Dim myi
Dim myii
Dim lef
Dim topp
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const BM_CLICK = &HF5   '模拟点击
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Check1_Click()
On Error Resume Next
If Me.Check1.Value = 1 Then
rul2 = IIf(Right(App.Path, 1) = "\", Left(App.Path, Len(App.Path) - 1), App.Path) + "\flas.exe"
Shell rul2
Else

End If

End Sub

Private Sub Text1_Change()
If Val(Me.Text1.Text) > 7 Then Me.Text1.Text = 7
End Sub

Private Sub Text2_Change()
If Val(Me.Text2.Text) > 7 Then Me.Text2.Text = 7
End Sub

Private Sub Text3_Change()
username = Text3.Text
End Sub

Private Sub Timer1_Timer()
h = FindWindow(vbNullString, "Microsoft Internet Explorer")
hh = FindWindowEx(h, 0, "Button", "确定")
hhh = FindWindow(vbNullString, "Microsoft Internet Explorer")
hhhh = FindWindowEx(h, 0, "Button", "否(&N)")
a = SendMessage(hh, BM_CLICK, 0, 0)
aa = SendMessage(hhhh, BM_CLICK, 0, 0)
ttimerss = ttimerss + 1

If ttimerss Mod 120 = 0 Then
Me.Label6.Caption = "现在系统累计学习时间：" & Val(Text1.Text) * Val(Text2.Text) * (ttimerss / 120) & "分钟"
End If

End Sub

Private Sub hua(i, ii)
lef = (i - 1) * 2000
topp = (ii - 1) * 2000 + 2000
End Sub

Private Sub Command1_Click()
myi = Val(Me.Text1.Text)
myii = Val(Me.Text2.Text)
Me.Check2.Enabled = False
WebBrowser1(0).Navigate rul 'WebBrowser控件装入页面
For i = 1 To myi
  

    For ii = 1 To myii
      Call hua(i, ii)
         x = x + 1
       Load Me.WebBrowser1(x)
      Me.WebBrowser1(x).Left = lef
      Me.WebBrowser1(x).Top = topp
      WebBrowser1(x).Navigate rul
      If Me.Check2.Value = 1 Then
        Me.WebBrowser1(x).Visible = True
      Else
        Me.WebBrowser1(x).Visible = False
      End If
     
     
    Next ii
Next i

Me.Text1.Visible = False
Me.Text2.Visible = False
End Sub

Private Sub Form_Load()
myi = Val(Me.Text1.Text)
myii = Val(Me.Text2.Text)
If username = "" Then username = "XXX"
password = "1234"
rul = IIf(Right(App.Path, 1) = "\", Left(App.Path, Len(App.Path) - 1), App.Path) + "\1.htm"

End Sub

 

Private Sub WebBrowser1_DocumentComplete(index As Integer, ByVal pDisp As Object, URL As Variant)
 Me.Command1.Enabled = False
 Me.Command1.Value = False
 Dim vDoc, vTag
Dim i As Integer
Set vDoc = WebBrowser1(index).Document
For i = 0 To vDoc.All.length - 1 '检测所有标签
   If UCase(vDoc.All(i).tagName) = "INPUT" Then '找到input标签
     Set vTag = vDoc.All(i)
     If vTag.Type = "text" Then '检测类型
        Select Case vTag.Name
           Case "username" '填写用户名的文本框的值
              vTag.Value = username
        End Select
     End If
    If vTag.Type = "password" Then        '检测密码框类型
       Select Case vTag.Name
           Case "password"                  '密码框的值
            vTag.Value = password
       End Select
    End If

    If vTag.Type = "submit" And vTag.Value = "提交" Then '登陆按钮
      vTag.Click
    End If
End If
Next i
End Sub

 

 

本文出自 “mmaxcai” 博客，谢绝转载！