VB制作刷易班软件.docx

用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 发状态的网址自动回帖的网址Dim runflag As Boolean 任务运行标志Private Sub Command1_Click() 登陆On Error GoTo ext Dim vDoc, vTag Set vDoc = WebBrowser1.Document WebBrowser1.Document.getelementbyid(username).Value = Label2.Caption WebBrowser1.Document.getelementbyid(password).Value = Label3.Caption Call delay 延时1秒 WebBrowser1.Document.getElementsByTagName(a)(num1).Click List1.AddItem Time & & 登陆成功, 0 Exit Subext: Call MsgBox(网络链接异常，或有其他错误, vbExclamation, 警告) List1.AddItem Time & & 登陆错误, 0End SubSub delay() 1秒钟延时函数 Timer1.Enabled = True Do While Timer1.Enabled = True DoEvents LoopEnd SubPrivate Sub Command2_Click() 后退 WebBrowser1.GoBackEnd SubPrivate Sub Command3_Click() 前进 WebBrowser1.GoForwardEnd SubPrivate Sub Command4_Click() 刷新 WebBrowser1.RefreshEnd SubPrivate Sub Command5_Click() 发布On Error GoTo ext WebBrowser1.Navigate urlx1 Call delay Call delay Dim i As Integer Dim a As Integer List1.AddItem Date & & 发布任务开始, 0 runflag = True 任务运行标志打开 For i = 1 To Text2.Text Call output List1.AddItem Date & & 成功发布 & i & 次, 0 Call delayx Next i List1.AddItem Date & & 发布任务结束, 0 runflag = False 任务运行标志关闭 Exit Subext: Call MsgBox(你可能尚未登录，或有其他错误, vbExclamation, 警告) runflag = FalseEnd SubSub output() Dim data As String Call choose(data) WebBrowser1.Document.getelementbyid(msgTxt).Value = data WebBrowser1.Document.getElementsByTagName(INPUT)(num2).Click Call delay 延时1秒 WebBrowser1.Document.getElementsByTagName(INPUT)(num2).Click 确保发布成功 List1.AddItem Date & & 发布内容: & data, 0End SubSub choose(ByRef data As String) Dim i As Integer i = Int(Rnd * 2) + 1 Select Case i Case 1 data = strx1 Case 2 data = strx2 Case 3 data = strx3 End SelectEnd SubPrivate Sub Command6_Click() Form2.ShowEnd SubPrivate Sub Command7_Click() 自动回帖 If Text2.Text 25 Then Call MsgBox(次数过多，会被认为是恶意刷帖子, vbExclamation, 警告) Exit Sub End If If Text1.Text 30 Then Call MsgBox(时间间隔太短，会被认为是恶意刷帖, vbExclamation, 警告) Exit Sub End If Call autolendtipEnd SubSub autolendtip() WebBrowser1.Navigate urlx2 Call delay Call delay Dim i As Integer List1.AddItem Date & & 自动回帖任务开始, 0 runflag = True 任务运行标志打开 For i = 1 To Text2.Text Call lendtip List1.AddItem Date & & 第 & i & 次发帖, 0 Call delayx Next i runflag = False List1.AddItem Date & & 自动回帖任务完成, 0End SubSub lendtip() 登录发帖网址On Error GoTo ext WebBrowser1.Navigate /bbs/publish?area=34900 Call delay Call delay WebBrowser1.Document.getelementbyid(P_title).Value = 自动发布测试（标题） WebBrowser1.Document.getelementbyid(P_text) = 自动发布测试（正文） Dim data As String Call choose2(data) WebBrowser1.Document.getelementbyid(P_text).Value = data Call delay WebBrowser1.Document.getElementsByTagName(INPUT)(num3).Click Exit Subext: Call MsgBox(错误代码：lendtip，请于作者联系, vbExclamation, 警告) List1.AddItem Time & & 回帖错误, 0End SubSub choose2(ByRef data As String) Dim i As Integer i = Int(Rnd * 2) + 1 Select Case i Case 1 data = stry1 Case 2 data = stry2 Case 3 data = stry3 End SelectEnd SubPrivate Sub Command8_Click() WebBrowser1.Document.getElementsByTagName(a)(11).ClickEnd SubPrivate Sub Form_Load() Label2.Caption = 用户名 Label3.Caption = 密码 Label4.Caption = 说点什么吧 Call formchange1 Call fileinput WebBrowser1.Navigate urlx1 Timer1.Enabled = False Timer2.Enabled = False timerx = 0 Text1.Text = 5 Text2.Text = 100 runflag = False 任务运行标志默认关闭 End SubSub formchange1() 窗口大小函数 WebBrowser1.Height = Me.Height - 800 WebBrowser1.Width = Me.Width - 4000 Command1.Left = Me.Width - Command1.Width - 1000 Command2.Width = (Me.Width - WebBrowser1.Width) / 3 - 300 Command3.Width = (Me.Width - WebBrowser1.Width) / 3 - 300 Command4.Width = (Me.Width - WebBrowser1.Width) / 3 - 300 Command2.Left = WebBrowser1.Left + WebBrowser1.Width + 100 Command3.Left = Command2.Left + Command2.Width + 100 Command4.Left = Command3.Left + Command3.Width + 100 Label1.Left = Me.Width - Label1.Width - 500 Label1.Top = Me.Height - 1000 Label2.Left = Me.Width - Label2.Width - 550 Label3.Left = Me.Width - Label3.Width - 550 Label5.Left = Label2.Left - Label5.Width Label6.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 - 300 Command6.Left = Command1.Left - Command6.Width - 100 Text1.Left = Command5.Left - Text1.Width - 100 Text2.Left = Command5.Left - Text2.Width - 100 Label7.Left = Text1.Left - Label7.Width Label8.Left = Text2.Left - Label8.Width List1.Left = Me.Width - List1.Width - 300 List1.Height = Label1.Top - List1.TopEnd SubPrivate Sub Form_Resize() 改变窗口大小 If WindowState 1 Then Call formchange1 End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer) 退出前程序 If runflag = True Then msg = 任务正在运行中，确认关闭？ response = MsgBox(msg, vbQuestion + vbYesNo, 退出) Select Case response Case vbYes End Case vbNo Cancel = -1 End Select End IfEnd SubPrivate Sub Text1_Click() If runflag = True Then Call MsgBox(任务正在运行中，请勿更改配置, vbExclamation, 警告) WebBrowser1.SetFocus Else Text1.Text = End IfEnd SubPrivate Sub Text2_Click() If runflag = True Then Call MsgBox(任务正在运行中，请勿更改配置, vbExclamation, 警告) WebBrowser1.SetFocus Else Text2.Text = End IfEnd SubPrivate Sub Text3_Click() Text3.Text = End SubPrivate Sub Timer1_Timer() 用于1秒钟延时函数 Timer1.Enabled = FalseEnd SubSub delayx() 长延时函数 timery = 10 Timer2.Enabled = True Do While Timer2 = True DoEvents LoopEnd SubPrivate Sub Timer2_Timer() 用于长延时函数 timerx = timerx + 1 If timerx = Text1.Text Then timerx = 0 Timer2.Enabled = False End IfEnd SubPrivate Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean) 判断可否后退，前进 If (Command = CSC_NAVIGATEBACK) Then Command2.Enabled = Enable End If If (Command = CSC_NAVIGATEFORWARD) Then Command3.Enabled = Enable End IfEnd SubSub fileinput()On Error GoTo ext Dim name, password As String Dim i As Integer Open App.Path & ybBX1210.ini For Input As #1 Input #1, num1 读入登陆按钮的位置 Input #1, num2 读入发布按钮的位置 Input #1, num3 读入自动回帖按钮的位置 Input #1, name 读入用户名 Input #1, password 读入密码 Input #1, urlx1 读入发状态的网址 List1.AddItem Date & & 读入发状态网址, 0 Label2.Caption = name List1.AddItem Date & & 读入用户名: & name, 0 Label3.Caption = password List1.AddItem Date & & 读入密码: & password, 0 读入要发布的内容 Input #1, strx1 List1.AddItem Date & & 读入要发布的状态: & strx1, 0 Input #1, strx2 List1.AddItem Date & & 读入要发布的状态: & strx2, 0 Input #1, strx3 List1.AddItem Date & & 读入要发布的状态: & strx3, 0 Input #1, urlx2 读入自动回帖的网址 List1.AddItem Date & & 读入回帖网址, 0 Input #1, stry1 List1.AddItem Date & & 读入要回帖的内容: & stry1, 0 Input #1, stry2 List1.AddItem Date & & 读入要回帖的内容: & stry2, 0 Input #1, stry3 List1.AddItem Date & & 读入要回帖的内容: & stry3, 0 Label4.Caption = strx1 & Chr(13) & strx2 & Chr(13) & strx3 Close #1 Exit Subext: Call MsgBox(配置文件读取失败，检查配置文件, vbExclamation, 警告) List1.AddItem Date & & 配置文件读取失败, 0End SubPrivate Sub WebBrowser1_DownloadBegin() WebBrowser1.Silent = True 避免弹出对话框End SubPrivate Sub WebBrowser1_DownloadComplete() WebBrowser1.Silent = True 避免弹出对话框End Sub下面是窗口2的源码：Private Sub Command1_Click() Dim i As Integer -保存设置- Open App.Path & ybBX1210.ini For Output As #1 Write #1, Form1.num1 写入登陆按钮的位置 Write #1, Form1.num2 写入发布按钮的位置 Write #1, Form1.num3 写入自动回帖按钮的位置 Write #1, Text1.Text 写入用户名 Write #1, Text2.Text 写入密码 Write #1, Form1.urlx1 写入发状态网址 Write #1, Text3.Text 写入状态1 Write #1, Text4.Text 写入状态2 Write #1, Text5.Text 写入状态3 Write #1, Text6.Text 写入回帖网址 Write #1, Text7.Text 写入回帖内容1 Write #1, Text8.Text 写入回帖内容2 Write #1, Text9.Text 写入回帖内容3 Close #1 -设置更新- Form1.Label2.Caption = Text1.Text Form1.Label3.Caption = Text2.Text Form1.strx1 = Text3.Te