VB制作刷易班软件

1、用VB制作刷易班软件俞佳星首先是界面设计:这次开源的V2.1版V3.5完成之后，V3.0版很快也会开源窗口 1：窗口 2：面是窗口 1 的源码：Dim timerx As Integer' 长延时函数中使用Public strx1, strx2, strx3 As String ' 发布容状态Public stry1, stry2, stry3 As String'发布的容自动回帖Public num1, num2, num3 As Integer ' 用于锁定登陆按钮 发布按钮 自动回帖按钮Public urlx1, urlx2 As String'发

2、状态的网址 自动回帖的网址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("网络异常，或有其他错误", vbExclamation,"警告)List1.AddItem Time & " " & " 登陆错误", 0

4、End SubSub delay()'1 秒钟延时函数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() ' 发布On Error GoTo extWebBrowser1.Navigate urlx1Call delayCall delayDim i As IntegerDim a As IntegerList1.AddItem Date & " " & " 发布任务开始 ", 0 runflag = True'任务运行标志翻开For i = 1 To Text2.TextCall outputList1.AddItem Date & " " & "

6、; 成功发布 " & i & " 次", 0Call delayxNext iList1.AddItem Date & " " & " 发布任务完毕 ", 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 ' 确保发布成功List1.AddItem Date & " " & " 发布容

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、"次数过多，会被认为是恶意刷帖子", 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 & "次发帖", 0Call delayxNext irunflag = FalseList1.AddItem Date & " " & " 自动回帖任务完成 ", 0

11、End SubSub lendtip()'登录发帖网址On Error GoTo ext' WebBrowser1.Navigate "sdju.yiban/bbs/publish?area=34900"'Call delay'Call delay' WebBrowser1.Document.getelementbyid("P_title").Value = " 自动发布测试标题 "' WebBrowser1.Document.getelementbyid("P_text&qu

12、ot;) = " 自动发布测试正文 "Dim data As StringCall choose2(data)WebBrowser1.Document.getelementbyid("P_text").Value = dataCall delayWebBrowser1.Document.getElementsByTagName("INPUT")(num3).ClickExit Subext:Call MsgBox("错误代码：lendtip，请于作者联系", 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()'窗口大小函数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 秒钟延时函数'长延时函数Private Sub Timer1_Timer()Timer1.Enabled = False End SubSub delayx()timery = 10Timer2.Enabled = TrueDo While Timer2 = TrueDoEvent

22、sLoop'用于长延时函数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'读入登陆按钮的位置'读入发布按钮的位置 '读入自动回帖按钮的位置 '读入用户名'读入密码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 & " "'读入发状态的网址& " 读入发状态网址 ", 0Label2.Caption = nameList1.AddItem Date & " " & " 读入用户名 :" & name, 0Label3.Caption = passwordList1

25、.AddItem Date & " " & " 读入密码 :" & password, 0'读入要发布的容Input #1, strx1List1.AddItem Date & " " & " 读入要发布的状态 :" & strx1, 0Input #1, strx2List1.AddItem Date & " " & " 读入要发布的状态 :" & strx2, 0Input #1, strx3

26、List1.AddItem Date & " " & " 读入要发布的状态 :" & strx3, 0Input #1, urlx2' 读入自动回帖的网址List1.AddItem Date & " " & " 读入回帖网址 ", 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'写入登陆按钮的位置'写入发布按钮的位置'写入自动回帖按钮的位置'写入用户名'写入密码'写入发状态网址Write #1, Text3.Text'写入状态1Write #1, Text4.Text'写入状态2'写入回帖网址'写入回帖容 1'写入回帖容 2'写入回帖容 3Write #1, Text5.Text'写入状态3Write #1, Text6.TextWrite #1, Text7.TextWrite #1,