⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmlogin.vb

📁 CSDN V3.0 使用VB。Net开发 可以使用该助手访问CSDN
💻 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 + -