VB制作刷易班軟件

1、用VB制作刷易班軟件俞佳星首先是界面設計:這次開源的V2.1版V3.5完成之后，V3.0版很快也會開源窗口 1：窗口 2：面是窗口 1 的源碼：Dim timerx As Integer' 長延時函數(shù)中使用Public strx1, strx2, strx3 As String ' 發(fā)布容狀態(tài)Public stry1, stry2, stry3 As String'發(fā)布的容自動回帖Public num1, num2, num3 As Integer ' 用于鎖定登陸按鈕 發(fā)布按鈕 自動回帖按鈕Public urlx1, urlx2 As String'發(fā)

2、狀態(tài)的網(wǎng)址 自動回帖的網(wǎng)址Dim runflag As Boolean ' 任務運行標志Private Sub Command1_Click() ' 登陸On Error GoTo extDim vDoc, vTagSet vDoc = WebBrowser1.DocumentWebBrowser1.Document.getelementbyid("username").Value = Label2.CaptionWebBrowser1.Document.getelementbyid("password").Value = Label3.

3、CaptionCall delay' 延時 1 秒WebBrowser1.Document.getElementsByTagName("a")(num1).ClickList1.AddItem Time & " " & " 登陸成功 ", 0Exit Subext:Call MsgBox("網(wǎng)絡異常，或有其他錯誤", vbExclamation,"警告)List1.AddItem Time & " " & " 登陸錯誤", 0

4、End SubSub delay()'1 秒鐘延時函數(shù)Timer1.Enabled = TrueDo While Timer1.Enabled = TrueDoEventsLoopEnd SubPrivate Sub Command2_Click()' 后退WebBrowser1.GoBackEnd SubPrivate Sub Command3_Click()' 前進WebBrowser1.GoForwardEnd SubPrivate Sub Command4_Click()' 刷新WebBrowser1.RefreshEnd SubPrivate Sub

5、Command5_Click() ' 發(fā)布On Error GoTo extWebBrowser1.Navigate urlx1Call delayCall delayDim i As IntegerDim a As IntegerList1.AddItem Date & " " & " 發(fā)布任務開始 ", 0 runflag = True'任務運行標志翻開For i = 1 To Text2.TextCall outputList1.AddItem Date & " " & "

6、; 成功發(fā)布 " & i & " 次", 0Call delayxNext iList1.AddItem Date & " " & " 發(fā)布任務完畢 ", 0 runflag = False' 任務運行標志關閉Exit Subext:Call MsgBoxC你可能尚未登錄，或有其他錯誤", vbExclamation,"警告)runflag = FalseEnd SubSub output()Dim data As StringCall choose(data)We

7、bBrowser1.Document.getelementbyid("msgTxt").Value = data WebBrowser1.Document.getElementsByTagName("INPUT")(num2).ClickCall delay'延時 1 秒WebBrowser1.Document.getElementsByTagName("INPUT")(num2).Click ' 確保發(fā)布成功List1.AddItem Date & " " & " 發(fā)布容

8、:" & data, 0End SubSub choose(ByRef data As String)Dim i As Integeri = Int(Rnd * 2) + 1Select Case iCase 1data = strx1Case 2data = strx2Case 3data = strx3End SelectEnd SubPrivate Sub Command6_Click()Form2.ShowEnd SubPrivate Sub Command7_Click()'自動回帖If Text2.Text > 25 ThenCall MsgBox(

9、"次數(shù)過多，會被認為是惡意刷帖子", vbExclamation,"警告)Exit SubEnd IfIf Text1.Text < 30 ThenCall MsgBox("時間間隔太短，會被認為是惡意刷帖", vbExclamation,"警告)Exit SubEnd IfCall autolendtipEnd SubSub autolendtip()WebBrowser1.Navigate urlx2Call delayCall delayDim i As IntegerList1.AddItem Date & &q

10、uot; " & " 自動回帖任務開始 ", 0 runflag = True'任務運行標志翻開For i = 1 To Text2.TextCall lendtipList1.AddItem Date & " " & " 第" & i & "次發(fā)帖", 0Call delayxNext irunflag = FalseList1.AddItem Date & " " & " 自動回帖任務完成 ", 0

11、End SubSub lendtip()'登錄發(fā)帖網(wǎng)址On Error GoTo ext' WebBrowser1.Navigate "sdju.yiban/bbs/publish?area=34900"'Call delay'Call delay' WebBrowser1.Document.getelementbyid("P_title").Value = " 自動發(fā)布測試標題 "' WebBrowser1.Document.getelementbyid("P_text&qu

12、ot;) = " 自動發(fā)布測試正文 "Dim data As StringCall choose2(data)WebBrowser1.Document.getelementbyid("P_text").Value = dataCall delayWebBrowser1.Document.getElementsByTagName("INPUT")(num3).ClickExit Subext:Call MsgBox("錯誤代碼：lendtip，請于作者聯(lián)系", vbExclamation,"警告)List1

13、.AddItem Time & " " & " 回帖錯誤", 0End SubSub choose2(ByRef data As String)Dim i As Integeri = Int(Rnd * 2) + 1Select Case iCase 1data = stry1Case 2data = stry2Case 3data = stry3End SelectEnd SubPrivate Sub Command8_Click()WebBrowser1.Document.getElementsByTagName("a&qu

14、ot;)(11).ClickEnd SubPrivate Sub Form_Load()Label2.Caption = "用戶名 " Label3.Caption = "密碼" Label4.Caption = "說點什么吧 " Call formchange1 Call fileinput WebBrowser1.Navigate urlx1 Timer1.Enabled = False Timer2.Enabled = Falsetimerx = 0Text1.Text = 5Text2.Text = 100runflag =

15、False' 任務運行標志默認關閉End SubSub formchange1()'窗口大小函數(shù)WebBrowser1.Height = Me.Height - 800WebBrowser1.Width = Me.Width - 4000Command1.Left = Me.Width - Command1.Width - 1000Command2.Width = (Me.Width - WebBrowser1.Width) / 3 - 300Command3.Width = (Me.Width - WebBrowser1.Width) / 3 - 300Command4.Wi

16、dth = (Me.Width - WebBrowser1.Width) / 3 - 300Command2.Left = WebBrowser1.Left + WebBrowser1.Width + 100Command3.Left = Command2.Left + Command2.Width + 100Command4.Left = Command3.Left + Command3.Width + 100 Label1.Left = Me.Width - Label1.Width - 500Label1.Top = Me.Height - 1000Label2.Left = Me.Wi

17、dth - Label2.Width - 550Label3.Left = Me.Width - Label3.Width - 550Label5.Left = Label2.Left - Label5.WidthLabel6.Left = Label3.Left - Label6.Width Command5.Left = Me.Width - Command5.Width - 300 Command7.Left = Me.Width - Command7.Width - 300 Label4.Left = Me.Width - Label4.Width - 300Command6.Left

18、 = Command1.Left - Command6.Width - 100 Text1.Left = Command5.Left - Text1.Width - 100Text2.Left = Command5.Left - Text2.Width - 100Label7.Left = Text1.Left - Label7.WidthLabel8.Left = Text2.Left - Label8.WidthList1.Left = Me.Width - List1.Width - 300List1.Height = Label1.Top - List1.TopEnd SubPriva

19、te Sub Form_Resize()'改變窗口大小If WindowState <> 1 ThenCall formchange1End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer) If runflag = True Then'退出前程序msg = "任務正在運行中，確認關閉？ " response = MsgBox(msg, vbQuestion + vbYesNo, "退出 ")Select Case responseCase vbYesEndCase vbN

20、oCancel = -1End SelectEnd IfEnd SubPrivate Sub Text1_Click() If runflag = True ThenCall MsgBoxC任務正在運行中，請勿更改配置 ", vbExclamation,"警告")WebBrowser1.SetFocusElseText1.Text = "" End IfEnd SubPrivate Sub Text2_Click()If runflag = True ThenCall MsgBox("任務正在運行中，請勿更改配置", vbE

21、xclamation,"警告")WebBrowser1.SetFocusElseText2.Text = ""End IfEnd SubPrivate Sub Text3_Click()Text3.Text = ""End Sub'用于 1 秒鐘延時函數(shù)'長延時函數(shù)Private Sub Timer1_Timer()Timer1.Enabled = False End SubSub delayx()timery = 10Timer2.Enabled = TrueDo While Timer2 = TrueDoEvent

22、sLoop'用于長延時函數(shù)End SubPrivate Sub Timer2_Timer() timerx = timerx + 1 If timerx = Text1.Text Then timerx = 0 Timer2.Enabled = FalseEnd IfEnd SubPrivate Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean) ' 判斷可否后退，前進If (Command = CSC_NAVIGATEBACK) Then Command2.Ena

23、bled = EnableEnd IfIf (Command = CSC_NAVIGATEFORWARD) Then Command3.Enabled = EnableEnd IfEnd SubSub fileinput() On Error GoTo extDim name, password As StringDim i As Integer'讀入登陸按鈕的位置'讀入發(fā)布按鈕的位置 '讀入自動回帖按鈕的位置 '讀入用戶名'讀入密碼Open App.Path & "ybBX1210.ini" For Input As #1

24、Input #1, num1Input #1, num2Input #1, num3Input #1, nameInput #1, passwordInput #1, urlx1List1.AddItem Date & " "'讀入發(fā)狀態(tài)的網(wǎng)址& " 讀入發(fā)狀態(tài)網(wǎng)址 ", 0Label2.Caption = nameList1.AddItem Date & " " & " 讀入用戶名 :" & name, 0Label3.Caption = passwordList1

25、.AddItem Date & " " & " 讀入密碼 :" & password, 0'讀入要發(fā)布的容Input #1, strx1List1.AddItem Date & " " & " 讀入要發(fā)布的狀態(tài) :" & strx1, 0Input #1, strx2List1.AddItem Date & " " & " 讀入要發(fā)布的狀態(tài) :" & strx2, 0Input #1, strx3

26、List1.AddItem Date & " " & " 讀入要發(fā)布的狀態(tài) :" & strx3, 0Input #1, urlx2' 讀入自動回帖的網(wǎng)址List1.AddItem Date & " " & " 讀入回帖網(wǎng)址 ", 0Input #1, stry1List1.AddItem Date & " " & " 讀入要回帖的容 :" & stry1, 0 Input #1, stry2List1.

27、AddItem Date & " " & " 讀入要回帖的容 :" & stry2, 0 Input #1, stry3List1.AddItem Date & " " & " 讀入要回帖的容 :" & stry3, 0Label4.Caption = strx1 & Chr(13) & strx2 & Chr(13) & strx3Close #1Exit Subext:Call MsgBox("配置文件讀取失敗，檢查配置文

28、件", vbExclamation,"警告")List1.AddItem Date & " " & " 配置文件讀取失敗 ", 0End SubPrivate Sub WebBrowser1_DownloadBegin()WebBrowser1.Silent = True '防止彈出對話框End SubPrivate Sub WebBrowser1_DownloadComplete()WebBrowser1.Silent = True '防止彈出對話框End Sub下面是窗口 2 的源碼：Pr

29、ivate Sub Command1_Click()Dim i As Integer 保存設置 Open App.Path & "ybBX1210.ini" For Output As #1Write #1, Form1.num1Write #1, Form1.num2Write #1, Form1.num3Write #1, Text1.TextWrite #1, Text2.TextWrite #1, Form1.urlx1'寫入登陸按鈕的位置'寫入發(fā)布按鈕的位置'寫入自動回帖按鈕的位置'寫入用戶名'寫入密碼'寫入發(fā)狀態(tài)網(wǎng)址Write #1, Text3.Text'寫入狀態(tài)1Write #1, Text4.Text'寫入狀態(tài)2'寫入回帖網(wǎng)址'寫入回帖容 1'寫入回帖容 2'寫入回帖容 3Write #1, Text5.Text'寫入狀態(tài)3Write #1, Text6.TextWrite #1, Text7.TextWrite #1,