我的查流量源代码

 

 

 

 

 

 

 Imports System.DrawingImports Microsoft.Win32Imports System.NetImports System.IOPublic Class Form1 Dim point1(6) As Point Dim point2(6) As Point Dim px(6) As Integer Dim shuju1(6) As Double Dim yuanshi1(6) As String Dim yuanshi2(6) As String Dim chaoshi1, chaoshi2 As Integer Public mycookie As New Net.CookieContainer Public userinfo(1) As String Const loginurl As String = "http://192.168.253.212:8080/selfservice/login.jsp?userId={0}&password={1}&flag=reguser" Const mainurl As String = "http://192.168.253.212:8080/selfservice/main.jsp" '上面网址为登陆成功后显示的主页面。 Const personinfourl As String = "http://192.168.253.212:8080/selfservice/queryselfinfo/queryselfinfo.jsp" '上面的网址为个人信息页面。 Const gettimeurl As String = "http://192.168.253.212:8080/selfservice/queryarinfo/queryarinfoctrl.jsp" ' 以上为上网明细查询的数据post的地址。 Const getntdurl As String = "http://192.168.253.212:8080/selfservice/queryntdarinfo/queryntdarinfoctrl.jsp" '以上为ntd流量明细 Const outlogin As String = "http://192.168.253.212:8080/selfservice/logout.jsp" Function checkkey() As Boolean Dim aa, bb, cc As Microsoft.Win32.RegistryKey aa = Registry.CurrentUser bb = aa.OpenSubKey("software", True) cc = bb.CreateSubKey("showmb") Dim user As String = cc.GetValue("user") Dim pass As String = cc.GetValue("password") If user Is Nothing Or pass Is Nothing Then Return False Else Return True End If aa.Close() End Function Function setkey() As Boolean Try Dim aa, bb, cc As RegistryKey aa = Registry.CurrentUser bb = aa.OpenSubKey("software", True) cc = bb.CreateSubKey("showmb") cc.SetValue("user", userinfo(0)) cc.SetValue("password", userinfo(1)) cc.Close() aa.Close() Return True Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦！") End Try End Function Function getkey() As Boolean Try Dim aa, bb, cc As RegistryKey aa = Registry.CurrentUser bb = aa.OpenSubKey("software", True) cc = bb.CreateSubKey("showmb") userinfo(0) = cc.GetValue("user") userinfo(1) = cc.GetValue("password") Return True Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦") Return False End Try End Function Function delkey() As Boolean Try Dim aa, bb As RegistryKey aa = Registry.CurrentUser bb = aa.OpenSubKey("software", True) bb.DeleteSubKey("showmb") Return True Catch ex As Exception Return False End Try End Function Function login() As Boolean Dim httpwebrequest1 As HttpWebRequest = CType(WebRequest.Create(String.Format(loginurl, userinfo(0), userinfo(1))), HttpWebRequest) httpwebrequest1.CookieContainer = mycookie Try Dim httpwebresponse1 As HttpWebResponse = CType(httpwebrequest1.GetResponse, HttpWebResponse) If httpwebresponse1.ResponseUri.ToString = mainurl Then Return True Else Return False End If Catch ex As Net.WebException MsgBox(ex.Message + vbCrLf + "请检查网络状态", MsgBoxStyle.Question, "出错啦！") Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦！") End Try End Function Sub logout() Dim httpwebrequest1 As HttpWebRequest = CType(WebRequest.Create(outlogin), HttpWebRequest) httpwebrequest1.CookieContainer = mycookie Dim httpwebresponse1 As HttpWebResponse = CType(httpwebrequest1.GetResponse, HttpWebResponse) Dim a As Stream = httpwebresponse1.GetResponseStream a.Close() End Sub Function getinfo() As String() Dim httpwebrequest1 As HttpWebRequest = CType(WebRequest.Create(personinfourl), HttpWebRequest) httpwebrequest1.CookieContainer = mycookie httpwebrequest1.Timeout = 5000 Dim httpwebresponse1 As HttpWebResponse Try httpwebresponse1 = CType(httpwebrequest1.GetResponse, HttpWebResponse) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦") Dim a(1) As String Return a Exit Function End Try Dim streamread1 As New StreamReader(httpwebresponse1.GetResponseStream, System.Text.Encoding.Default) Dim htmltext As String = streamread1.ReadToEnd htmltext = htmltext.Substring(htmltext.IndexOf("真实姓名")) htmltext = htmltext.Substring(htmltext.IndexOf("class=""name"">")) Dim site As Integer = htmltext.IndexOf("</div>") Dim username As String = htmltext.Substring(13, site - 13) '用户的真实姓名 htmltext = htmltext.Substring(htmltext.IndexOf("本月剩余NTD流量")) htmltext = htmltext.Substring(htmltext.IndexOf("align=""left"">")) site = htmltext.IndexOf(" (MB)") Dim free As String = htmltext.Substring(13, site - 13) '剩余多少兆流量 htmltext = htmltext.Substring(2) htmltext = htmltext.Substring(htmltext.IndexOf("align=""left"">")) site = htmltext.IndexOf("</td>") Dim endtime As String = htmltext.Substring(13, site - 13) '到期时间 Dim info() As String = {username, free, endtime} Return info End Function Function gettime(ByVal time As String) As String Dim temp As String = String.Format("serviceName=&fromDateStart={0}&fromHourStart=&fromMinStart=&fromSecStart=&toDateStart=&toHourStart=&toMinStart=&toSecStart=&fromDateStop=&fromHourStop=&fromMinStop=&fromSecStop=&toDateStop={1}&toHourStop=&toMinStop=&toSecStop=&onlineHourStart=&onlineMinStart=&onlineSecStart=&onlineToHourStart=&onlineToMinStart=&onlineToSecStart=&fromAcctTime=&toAcctTime=&fromInBytes=&toInBytes=&fromOutBytes=&toOutBytes=&fromFee=&toFee=&numofpage=1&flag=new", time, time) Dim postbyte As Byte() = System.Text.Encoding.Default.GetBytes(temp) Dim httpwebrequest1 As HttpWebRequest = CType(WebRequest.Create(gettimeurl), HttpWebRequest) httpwebrequest1.CookieContainer = mycookie httpwebrequest1.Timeout = 10000 httpwebrequest1.Method = "POST" httpwebrequest1.ContentType = "application/x-www-form-urlencoded" httpwebrequest1.ContentLength = postbyte.Length Dim str As String Try Dim mystream As Stream = httpwebrequest1.GetRequestStream mystream.Write(postbyte, 0, postbyte.Length) Dim httpwebresponse1 As HttpWebResponse = CType(httpwebrequest1.GetResponse, HttpWebResponse) Dim streamread As New StreamReader(httpwebresponse1.GetResponseStream, System.Text.Encoding.Default) str = streamread.ReadToEnd Catch ex As Exception If ex.Message = "操作超时" And chaoshi1 < 3 Then chaoshi1 += 1 Return gettime(time) End If MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦") Return "0" End Try If str.IndexOf("时长合计") < 0 Then Return "0" str = str.Substring(str.IndexOf("时长合计")) str = str.Substring(str.IndexOf("align=""left"">")) Dim site As Integer = str.IndexOf("</td>") str = str.Substring(13, site - 13) Return str End Function Function getntd(ByVal dtime As String) As String Dim temp As String = String.Format("userIp=&ipType=0&ntdIp=&ntdIpType=0&fromDate={0}&fromHour=&fromMin=&fromSec=&toDate={1}&toHour=&toMin=&toSec=&fromForeignUpFlow=&toForeignUpFlow=&fromForeignDownFlow=&toForeignDownFlow=&fromInlandUpFlow=&toInlandUpFlow=&fromInlandDownFlow=&toInlandDownFlow=&fromCampusUpFlow=&toCampusUpFlow=&fromCampusDownFlow=&toCampusDownFlow=&fromIpfixFlowSum=&toIpfixFlowSum=&fromFee=&toFee=&numofpage=1&userId={2}&flag=new", dtime, dtime, userinfo(0)) Dim postbyte As Byte() = System.Text.Encoding.Default.GetBytes(temp) Dim httpwebrequest1 As HttpWebRequest = CType(WebRequest.Create(getntdurl), HttpWebRequest) httpwebrequest1.CookieContainer = mycookie httpwebrequest1.Timeout = 10000 httpwebrequest1.Method = "POST" httpwebrequest1.ContentType = "application/x-www-form-urlencoded" httpwebrequest1.ContentLength = postbyte.Length Dim str As String Try Dim mystream As Stream = httpwebrequest1.GetRequestStream mystream.Write(postbyte, 0, postbyte.Length) Dim httpwebresponse1 As HttpWebResponse = CType(httpwebrequest1.GetResponse, HttpWebResponse) Dim streamread As New StreamReader(httpwebresponse1.GetResponseStream, System.Text.Encoding.Default) str = streamread.ReadToEnd Catch ex As Exception If ex.Message = "操作超时" And chaoshi2 < 3 Then chaoshi2 += 1 Return getntd(dtime) End If MsgBox(ex.Message, MsgBoxStyle.Question, "出错啦") Return 0 End Try If str.IndexOf("总流量合计") < 0 Then Return 0 str = str.Substring(str.IndexOf("总流量合计")) str = str.Substring(str.IndexOf("align=""left"">")) Dim site As Integer = str.IndexOf("</td>") Dim a As String = str.Substring(13, site - 13) 'Dim b As Integer = a.IndexOf("TB") 'Dim c As Integer = a.IndexOf("GB") 'Dim d As Integer = a.IndexOf("MB") 'Dim t1 As Double = CType(Trim(a.Substring(0, b - 1)), Double) 'Dim g1 As Double = CType(Trim(a.Substring(b + 2, c - b - 2)), Double) 'Dim m1 As Double = CType(Trim(a.Substring(c + 2, d - c - 2)), Double) 'Dim num As Double = t1 * 1024 * 1024 + g1 * 1024 + m1 Return a End Function Sub showinfo(ByVal info As String()) If info.Length <> 3 Then Exit Sub End If Label1.Text = info(0) + "用户 您还剩下流量" Select Case CType(info(1), Double) Case Is > 2000 Label2.ForeColor = Color.Green Label2.Text = info(1) + " MB" Case Is > 1000 Label2.ForeColor = Color.Blue Label2.Text = info(1) + " MB" Case Is > 500 Label2.ForeColor = Color.Yellow Label2.Text = info(1) + " MB" Case Is < 500 Label2.ForeColor = Color.Red Label2.Text = info(1) + " MB" End Select Dim aa As Date = CType(info(2), Date).ToShortDateString() Dim bb As Date = Now.ToShortDateString Dim cc As TimeSpan = (aa - bb) Label3.Text = "还有 " + cc.TotalDays.ToString + " 天到期 (" + aa.Month.ToString + "/" + aa.Day.ToString + ")" End Sub Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked TextBox1.Text = "" TextBox2.Text = "" If Not delkey() Then MsgBox("出错") MsgBox("清除成功") End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click If Trim(TextBox1.Text) = "" Or Trim(TextBox2.Text) = "" Then MsgBox("用户名或密码没填") Exit Sub End If userinfo(0) = TextBox1.Text userinfo(1) = TextBox2.Text If Not setkey() Then Exit Sub End If If Not login() Then MsgBox("登陆失败", MsgBoxStyle.Question, "出错啦") Exit Sub End If showinfo(getinfo) End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim jg As Integer = PictureBox1.Width / 7 For i As Int16 = 1 To 7 px(i - 1) = jg * i - (jg / 3) * 2 Next If Not checkkey() Then Exit Sub End If If Not getkey() Then Exit Sub End If If Not login() Then Exit Sub End If showinfo(getinfo) End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click If Not Me.BackgroundWorker1.IsBusy Then Me.BackgroundWorker1.RunWorkerAsync() End If End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click If Not Me.BackgroundWorker2.IsBusy Then Me.BackgroundWorker2.RunWorkerAsync() End If End Sub Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint Dim g As Graphics = e.Graphics '---------------------------- Dim mypen1 As New Pen(Color.LawnGreen, 4) Dim myfont1 As New Font("宋体", 9, FontStyle.Regular) Dim myline As New Pen(Color.Honeydew, 1) For i As Int16 = 0 To 6 g.DrawLine(myline, px(i), 0, px(i), PictureBox1.Height) Next g.DrawLines(mypen1, point1) For i As Integer = 0 To point1.Length - 1 Dim temppoint As Point If i = 0 Then If point1(i) = temppoint And point1(i + 1) = temppoint And point1(i + 2) = temppoint And point1(i + 3) = temppoint And point1(i + 4) = temppoint And point1(i + 5) = temppoint And point1(i + 6) = temppoint Then Exit For End If If point1(i).Y > PictureBox1.Height - 10 Then g.DrawString(CType(shuju1(i), Integer).ToString + "MB", myfont1, Brushes.BlueViolet, point1(i).X, point1(i).Y - 10) Else g.DrawString(CType(shuju1(i), Integer).ToString + "MB", myfont1, Brushes.BlueViolet, point1(i)) End If Next '------------------------------------------ Dim mypen2 As New Pen(Color.LightBlue, 4) g.DrawLines(mypen2, point2) For i As Int16 = 0 To 6 If yuanshi2(i) = "" Or yuanshi2(i) = "0" Then Continue For If point2(i).Y < PictureBox1.Height - 10 Then g.DrawString(yuanshi2(i).Substring(0, yuanshi2(i).IndexOf("时") + 1), myfont1, Brushes.Brown, point2(i)) Else g.DrawString(yuanshi2(i).Substring(0, yuanshi2(i).IndexOf("时") + 1), myfont1, Brushes.Brown, point2(i).X, point2(i).Y - 10) End If Next End Sub Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork Dim mynowday As Date = CType(Now.ToShortDateString, Date) For i As Integer = -1 To -7 Step -1 chaoshi2 = 0 Dim a As String = getntd(mynowday.AddDays(i).ToShortDateString) yuanshi1(Math.Abs(i + 1)) = a If a = "0" Then Continue For Dim b As Integer = a.IndexOf("TB") Dim c As Integer = a.IndexOf("GB") Dim d As Integer = a.IndexOf("MB") Dim t1 As Double = CType(Trim(a.Substring(0, b - 1)), Double) Dim g1 As Double = CType(Trim(a.Substring(b + 2, c - b - 2)), Double) Dim m1 As Double = CType(Trim(a.Substring(c + 2, d - c - 2)), Double) Dim num As Double = t1 * 1024 * 1024 + g1 * 1024 + m1 shuju1(Math.Abs(i + 1)) = num Next Dim maxvalue As Double = 0 For Each x As Double In shuju1 If maxvalue < x Then maxvalue = x Next If maxvalue = 0 Then Exit Sub End If Dim ppy1(6) As Integer For i As Integer = 0 To ppy1.Length - 1 Dim temp As Integer = PictureBox1.Height / maxvalue * shuju1(i) If temp < 8 Then ppy1(i) = 8 Else ppy1(i) = temp End If Next For i As Int16 = 0 To 6 point1(i).X = px(i) point1(i).Y = PictureBox1.Height - ppy1(i) Next End Sub Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted PictureBox1.Refresh() End Sub Private Sub BackgroundWorker2_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker2.DoWork Dim mynowday As Date = CType(Now.ToShortDateString, Date) Dim shuju2(6) As Double For i As Integer = -1 To -7 Step -1 chaoshi1 = 0 Dim ss As String = gettime(mynowday.AddDays(i).ToShortDateString) yuanshi2(Math.Abs(i + 1)) = ss ss = ss.Replace("小时", ":") ss = ss.Replace("分", ":") ss = ss.Replace("秒", "") If ss = "0" Then Continue For End If Dim qq As Date = ss Dim mintime As Integer = qq.Hour * 60 + qq.Minute shuju2(Math.Abs(i + 1)) = mintime Next Dim maxvalue As Double = 0 For Each x As Double In shuju2 If maxvalue < x Then maxvalue = x Next If maxvalue = 0 Then Exit Sub End If Dim ppy(6) As Integer For i As Integer = 0 To ppy.Length - 1 ppy(i) = PictureBox1.Height / maxvalue * shuju2(i) Next For i As Int16 = 0 To 6 point2(i).X = px(i) point2(i).Y = PictureBox1.Height - ppy(i) Next End Sub Private Sub BackgroundWorker2_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker2.RunWorkerCompleted PictureBox1.Refresh() End Sub Private Sub 说明ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 说明ToolStripMenuItem.Click Dim myform As New Form With myform .Text = "说明" End With Dim mytextbox As New TextBox With mytextbox .Multiline = True .WordWrap = True .Dock = DockStyle.Fill .ReadOnly = True End With myform.Controls.Add(mytextbox) myform.Show() End SubEnd Class