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

📄 frmmain.vb

📁 CSDN V3.0 使用VB。Net开发 可以使用该助手访问CSDN
💻 VB
📖 第 1 页 / 共 2 页
字号:
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.IO
Imports CsdnV3.comm


Public Class FrmMain

#Region "窗体加载"
    Private m As New WebServer
    Private t As New Threading.Thread(AddressOf m.Main)

    Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Me.Visible = False

        t.Start()

        ''''''''''''''''''''''''''''
        '先检查数据库文件是否存在
        If Not System.IO.File.Exists("CSDN.mdb") Then
            MsgBox("数据库文件[CSDN.mdb]丢失!")
            Me.Dispose()
        End If

        ''以begin.js作为树的入口加载导航
        LoadTreeNodes("begin.js", Me.tvMain.Nodes)

        '登陆默认用户
        CheckDefaultuser("")

        '初始化多用户切换彩单
        InitUsersMenu()

        ''布局
        initTipLayOut()

        '开始监视短消息
        Me.TimerMsg.Start()

        Me.WindowState = FormWindowState.Maximized
        ''Me.tc.TabPages.Add(New tpHome)
        ''tpTip.ShowTP(Me.U2u("http://community.csdn.net//Expert/TopicView1.asp?id=4607944"), Me.tc)

        Me.Visible = True

    End Sub
#End Region

    Sub initTipLayOut()
        If My.Settings.LayOut = "11" Then
            Me.spSec.Panel2Collapsed = True
        End If
        If My.Settings.LayOut = "111" Then
            Me.spSec.Panel2Collapsed = False
            Me.spSec.Orientation = Orientation.Vertical
        End If
        If My.Settings.LayOut = "211" Then
            Me.spSec.Panel2Collapsed = False
            Me.spSec.Orientation = Orientation.Horizontal
        End If
        If Me.spSec.Panel2Collapsed = True Then

            For Each tp As TabPage In tc2.TabPages
                tp.Parent = tc
                'If TypeOf tp Is tpBase Then
                '    Dim temp As tpBase = tp
                '    temp.Close()
                'Else
                '    tp.Dispose()
                'End If
            Next
        End If

    End Sub

#Region "初始化多用户切换彩单"
    ''' <summary>
    ''' 初始化多用户切换彩单
    ''' </summary>
    ''' <remarks>只登陆默认用户</remarks>
    Private Sub InitUsersMenu()
        tbUsersLogin.DropDown.Items.Clear()
        '动态增加“管理登陆”
        Dim tsi As ToolStripItem = tbUsersLogin.DropDown.Items.Add("管理登陆..")
        tsi.ToolTipText = "管理登陆用户"
        AddHandler tsi.Click, AddressOf Login_Click

        tbUsersLogin.DropDown.Items.Add("-")

        '动态增加用户
        For Each ett As entity_TB_LoginUser In frmLogin.HistoryUsers.Values
            tsi = tbUsersLogin.DropDown.Items.Add(ett.UserName)
            tsi.ToolTipText = "将" & ett.UserName & "设置为当前用户!"
            tsi.ImageScaling = ToolStripItemImageScaling.None
            '为默认用户显示menu icon
            If ett.Default Then
                tsi.Image = My.Resources.彩单选中2
            End If
            AddHandler tsi.Click, AddressOf ChangeUser_Click
        Next
    End Sub

#End Region

#Region "切换用户"
    ''' <summary>
    ''' 切换用户
    ''' </summary>
    ''' <param name="UserName">可选参数,不提供就表示为使用默认用户。</param>
    ''' <remarks></remarks>
    Private Sub CheckDefaultuser(Optional ByVal UserName As String = "")



        '开始检查登陆默认用户
        Dim ett As entity_TB_LoginUser = frmLogin.DefaultUser(UserName) '获取默认用户
        If Not ett Is Nothing Then '如果设置了默认用户。
            '检查是否有效

            Dim cl As New CheckLogin(ett)
            cl.Check()

            If cl.hasLogined Then
                '设置当前用户
                comm.Comm.SetDefuser(ett)

                '如果检查成功,就显示当前用户。
                Me.lLoginText.Text = "欢迎:" & ett.UserName
                Me.llLoginOperation.Text = "切换"

                '处理我设置的 感兴趣的社区
                For Each js As jsTreeNode In Me.tvMain.Nodes
                    If js.Text = "我感兴趣的社区" Then
                        js.Nodes.Clear()
                        js.HasProced = False
                        If js.childNodesFileName.Length > 0 And Not js.HasProced Then

                            Me.LoadTreeNodes(js.childNodesFileName, js.Nodes)
                            js.HasProced = True
                            js.Expand()


                        End If
                    End If
                    Exit For
                Next

            End If

        End If
        '重新监视短消息
        i = 0
    End Sub
#End Region

#Region "CSDN导航树处理函数"
    ''' <summary>
    ''' CSDN导航树处理函数
    ''' </summary>
    ''' <param name="strUrl">JS地址</param>
    ''' <param name="Nodes">节点位置</param>
    ''' <param name="SaveFile">是否保存文件</param>
    ''' <remarks></remarks>
    Private Sub LoadTreeNodes(ByVal strUrl As String, ByVal Nodes As TreeNodeCollection, Optional ByVal SaveFile As Boolean = True)
        '对应的HTTP地址
        strUrl = comm.Comm.CSDN_COMINITY_TREENODEDATA_URL + strUrl
        Dim html As String = ""
        Dim u As New Uri(strUrl)
        '计算本地文件名
        Dim fileName As String = ""
        fileName = Application.StartupPath & u.LocalPath.Replace("/", "\")

        '这里使用的gb2312编码
        Dim ec As Encoding = System.Text.Encoding.GetEncoding("GB2312")


        If File.Exists(fileName) And fileName.EndsWith(".js") Then
            '如果js存在的话直接读文件
            html = My.Computer.FileSystem.ReadAllText(fileName)
        Else
            '不存在的话就用网络上直接load
            Dim http As New HttpProc
            http.strUrl = strUrl
            http.cookiePost = comm.Comm.CL
            http.encoding = ec
            http.cookiePost = comm.Comm.CL
            http.Proc()
            html = http.ResHtml

            ''保存当前文件
            If SaveFile Then
                comm.FileStream.SaveFile(fileName, html)
            End If
        End If


        '使用正则匹配每一行
        For Each m As Match In comm.RegMatch.Matches("tree.nodes\['(?<D>[^\r]+?)'\]\040\=\040'(?<D>[^\r]+?)';\r", html)
            '对每行的结果再解析
            Dim jsNode As New jsTreeNode(m.Value)
            If jsNode.childNodesFileName.Length > 0 Then
                jsNode.SelectedImageIndex = 1
                jsNode.ImageIndex = 1
            Else
                jsNode.SelectedImageIndex = 0
                jsNode.ImageIndex = 0
            End If

            If Not jsNode.StrIndex = "0_1" Then
                Dim badd As Boolean = False

                If Not jsNode.StrIndex Is Nothing Then
                    For Each js As jsTreeNode In Nodes
                        If js.StrIndex.Split("_".ToCharArray)(1) = jsNode.StrIndex.Split("_".ToCharArray)(0) Then
                            js.Nodes.Add(jsNode)
                            badd = True
                            js.SelectedImageIndex = 1
                            js.ImageIndex = 1
                            Exit For
                        End If
                    Next
                End If


                If Not badd Then
                    Nodes.Add(jsNode)
                End If

            End If
        Next
    End Sub
#End Region

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -