電大在線學習軟件

 

'因爲沒有那麼多時間掛在線上學習，所以寫了個程序偷點懶，基本思想是:建立控件組，重複裝載登陸頁面．在線時間與登錄頁面成正比．用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