📄 frmlogin.vb
字号:
Imports System.Net
#Region "登陆流程"
'必须按照下面的流程:
'1.先load userlogin.aspx:获取 cookie ClientKey;并获取hidden类型input的__VIEWSTATE、ClientKey、__EVENTVALIDATION的数值
'2.然后使用cookie ClientKey 去获取验证码,并得到ASP.NET_SessionId
'3.使用这些数据和cookie去获取登陆
#End Region
''' <summary>
''' 登陆窗体
''' </summary>
''' <remarks></remarks>
Public Class frmLogin
Private __VIEWSTATE As String = ""
Private __EVENTVALIDATION As String = ""
Private ClientKey As String = ""
Private Shared _HistoryUsers As Hashtable
Private Shared _f As frmLogin
#Region "验证码"
''' <summary>
''' 登陆专用Cookie
''' </summary>
''' <remarks>这个Cookie只有在登陆的时候使用</remarks>
Private SessionCookie As CookieCollection
''' <summary>
''' 加载验证码
''' </summary>
''' <remarks>加载并显示出来,并保存Session cookie</remarks>
Private Sub LoadImg()
SessionCookie = New CookieCollection
Dim strRes As String = ""
Dim http As comm.HttpProc
'先加载页面获取__VIEWSTATE/__EVENTVALIDATION/ClientKey
http = New comm.HttpProc("http://passport.csdn.net/UserLogin.aspx")
http.strRefUrl = http.strUrl
strRes = http.Proc
If Len(strRes) > 0 Then
__VIEWSTATE = comm.RegMatch.GetInputValue("__VIEWSTATE", strRes)
ClientKey = comm.RegMatch.GetInputValue("ClientKey", strRes)
__EVENTVALIDATION = comm.RegMatch.GetInputValue("__EVENTVALIDATION", strRes)
__VIEWSTATE = System.Web.HttpUtility.UrlEncode(__VIEWSTATE)
__EVENTVALIDATION = System.Web.HttpUtility.UrlEncode(__EVENTVALIDATION)
End If
SessionCookie.Add(http.cookieGet)
'加载一个图片
http = New comm.HttpProc(comm.Comm.CSDN_COMINITY_IMG_URL)
http.cookiePost = SessionCookie
Dim httpRequest As HttpWebRequest
Dim httpRespon As HttpWebResponse
Try
httpRequest = http.CreateRequest '请求
httpRespon = httpRequest.GetResponse '响应
SessionCookie.Add(httpRespon.Cookies) 'Cookie
Me.pic.Image = Image.FromStream(httpRespon.GetResponseStream) '直接获取图片
Catch ex As Exception
MsgBox(ex.Message)
Finally
http = Nothing
httpRespon = Nothing
httpRequest = Nothing
End Try
End Sub
Private Sub llRefImg_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llRefImg.LinkClicked
'刷新验证码
LoadImg()
Me.tbCode.Text = ""
End Sub
#End Region
''' <summary>
''' 显示登陆窗体
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function ShowForm() As DialogResult
If _f Is Nothing Then
_f = New frmLogin
End If
Return _f.ShowDialog()
End Function
Private Sub frmLogin_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'加载历史用户
LoadHistoryUser()
'加载一个验证码
LoadImg()
Me.tbCode.Text = ""
End Sub
''' <summary>
''' 获取用户信息
''' </summary>
''' <param name="UserName">用户名,该参数为可选择参数,不提供就的话就获取默认用户</param>
''' <returns>用户信息</returns>
''' <remarks></remarks>
Public Shared Function DefaultUser(Optional ByVal UserName As String = "") As entity_TB_LoginUser
Dim ett As entity_TB_LoginUser = Nothing
For Each ett In HistoryUsers.Values
'如果没有提供参数
If UserName = "" Then
'取默认用户
If ett.Default Then
Exit For
End If
Else
If ett.UserName = UserName Then
Exit For
End If
End If
Next
Return ett
End Function
''' <summary>
''' 历史用户数据
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Shared ReadOnly Property HistoryUsers() As Hashtable
Get
If _HistoryUsers Is Nothing Then
loadHistoyUser()
End If
Return _HistoryUsers
End Get
End Property
''' <summary>
''' 从数据库中读历史用户数据
''' </summary>
''' <remarks></remarks>
Private Shared Function loadHistoyUser() As Hashtable
Dim StrErr As String
Dim al As ArrayList
With New Da_TB_LoginUser
al = .GetList()
StrErr = .StrError
End With
_HistoryUsers = Nothing
_HistoryUsers = New Hashtable
If Not al Is Nothing Then
For Each ett As entity_TB_LoginUser In al
_HistoryUsers.Add(ett.UserName, ett)
Next
End If
Return _HistoryUsers
End Function
''' <summary>
''' 从数据库中读所有的数据
''' </summary>
''' <remarks>从数据中读出来显示在界面,并验证这些历史用户的有效性</remarks>
Private Sub LoadHistoryUser()
If Not loadHistoyUser() Is Nothing Then
lv.Items.Clear()
For Each ett As entity_TB_LoginUser In HistoryUsers.Values
Dim lvi As ListViewItem = lv.Items.Add("")
lvi.SubItems.Add(ett.UserName)
lvi.SubItems.Add(ett.Pass)
If ett.Default Then
lvi.SubItems.Add("√")
Else
lvi.SubItems.Add("")
End If
lvi.Tag = ett
lvi.SubItems(0).Text = "验证中"
Dim cl As New CheckLogin(ett)
cl.Check()
If cl.hasLogined Then
lvi.SubItems(0).Text = "有效"
Else
lvi.SubItems(0).Text = "无效"
End If
'Dim t As New Threading.Thread(AddressOf cl.Check)
't.Start()
Next
End If
End Sub
Private Sub bLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bLogin.Click
If Me.tbuserName.Text = "" Or Me.tbPass.Text = "" Or Me.tbCode.Text = "" Then
MsgBox("请完整输入!")
Return
End If
Dim http As New CsdnLogin(tbuserName.Text, Me.tbPass.Text, Me.tbCode.Text, Me.SessionCookie, __VIEWSTATE, ClientKey, __EVENTVALIDATION)
If http.Login(True) Then
'登陆成功
'
Dim ett As entity_TB_LoginUser
ett = HistoryUsers.Item(tbuserName.Text)
If ett Is Nothing Then
ett = New entity_TB_LoginUser
End If
ett.UserName = tbuserName.Text
ett.Pass = tbPass.Text
ett.QWERTOP = http.cookieGet("QWERTOP").Value
ett.ABCDEF = http.cookieGet("ABCDEF").Value
ett.Userid = http.cookieGet("Userid").Value
If HistoryUsers.Count = 0 Then
ett.Default = True
End If
With New Da_TB_LoginUser
If .Update(ett) = 0 Then
.addNew(ett)
HistoryUsers.Add(tbuserName.Text, ett)
Else
HistoryUsers.Item(tbuserName.Text) = ett
End If
End With
LoadHistoryUser()
End If
End Sub
'
Private Sub lv_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lv.SelectedIndexChanged
If lv.SelectedItems.Count > 0 Then
Dim lvi As ListViewItem = lv.SelectedItems(0)
tbuserName.Text = lvi.SubItems(1).Text
tbPass.Text = lvi.SubItems(2).Text
End If
End Sub
'注册
Private Sub llRegNew_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llRegNew.LinkClicked
System.Diagnostics.Process.Start("http://passport.csdn.net/CSDNUserRegister.aspx?RegTerms=Accept&btnSubmit=%CD%AC+%D2%E2")
End Sub
'忘记密码
Private Sub llLosePass_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llLosePass.LinkClicked
System.Diagnostics.Process.Start("http://passport.csdn.net/QANewPassword.aspx")
End Sub
'检查所有用户的登陆
Private Sub llCheckLogin_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llCheckLogin.LinkClicked
LoadHistoryUser()
End Sub
'删除
Private Sub llDelSelected_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llDelSelected.LinkClicked
If MsgBox("确定删除?", MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then
Return
End If
If lv.SelectedItems.Count > 0 Then
Dim lvi As ListViewItem = lv.SelectedItems(0)
With New Da_TB_LoginUser
.Del(lvi.Tag)
End With
End If
LoadHistoryUser()
End Sub
'这里为默认
Private Sub llSetDefault_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llSetDefault.LinkClicked
If lv.SelectedItems.Count > 0 Then
Dim lvi As ListViewItem = lv.SelectedItems(0)
Dim ett As entity_TB_LoginUser = lvi.Tag
If Not ett.Default Then
With New Da_TB_LoginUser
ett.Default = True
.SetDef(ett)
_HistoryUsers = Nothing
LoadHistoryUser()
End With
End If
End If
End Sub
Private Sub bExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bExit.Click
Me.Close()
End Sub
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -