-

Visual Studio 2010

Visual Studio是微软公司推出的开发环境,是最流行的Windows平台应用程序开发环境。
Visual Studio 2010 安装
中文汉化版

Visual Studio 2010 教程
创建项目和使用技巧

创建项目 保存项目 Me.Text = "给窗口标题赋值" 异步操作案例 界面居中显示
' 设置窗口居中显示
Me.StartPosition = FormStartPosition.CenterScreen

异步操作
异步操作加异步停止
下载vb里异步操作源码>>

Public Class Form1
    Delegate Sub wt(ByVal action As String, ByVal msg As String)
    Dim t As Threading.Thread '定义线程类  
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "给窗口标题赋值"
    End Sub


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        t = New Threading.Thread(AddressOf handleCaiYiBu) '让线程类指向子程序  
        t.Start(100000) '启动线程      
    End Sub

    Sub handleCaiYiBu(ByVal nForCount)
        Dim i
        For i = 1 To nForCount
            Me.Invoke(New wt(AddressOf callYiBuEcho), "动作", "循环=" & i)
        Next
    End Sub

    '异步回显提示
    Sub callYiBuEcho(ByVal action, ByVal msg)
        Label1.Text = action & "=" & msg
    End Sub
End Class
第二种,加了个停止
Public Class Form1
    Delegate Sub wt(ByVal action As String, ByVal msg As String)
    Dim t As Threading.Thread '定义线程类  
    Dim shouldStop As Boolean = False '添加停止标志

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "给窗口标题赋值"
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        shouldStop = False '重置停止标志
        Button1.Enabled = False '禁用开始按钮
        Button2.Enabled = True '启用停止按钮

        t = New Threading.Thread(AddressOf handleCaiYiBu) '让线程类指向子程序  
        t.Start(100000) '启动线程      
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If t IsNot Nothing AndAlso t.IsAlive Then
            shouldStop = True '设置停止标志
            t.Join(1000) '等待线程结束

            Button1.Enabled = True '重新启用开始按钮
            Button2.Enabled = False '禁用停止按钮

            Label1.Text = "已停止"
        End If
    End Sub

    Sub handleCaiYiBu(ByVal nForCount)
        Dim i
        For i = 1 To nForCount
            If shouldStop Then
                Exit For '检查停止标志
            End If
            Me.Invoke(New wt(AddressOf callYiBuEcho), "动作", "循环=" & i)
            Threading.Thread.Sleep(100) '添加小延迟使效果更明显
        Next

        '循环结束后重置按钮状态
        Me.Invoke(Sub()
                      Button1.Enabled = True
                      Button2.Enabled = False
                  End Sub)
    End Sub

    '异步回显提示
    Sub callYiBuEcho(ByVal action, ByVal msg)
        Label1.Text = action & "=" & msg
    End Sub
     
End Class
第三种,网络请求
Public Class test001
    Delegate Sub wt(ByVal msg As String)
    Delegate Sub wt2(ByVal content, ByVal sType)
    Dim t As Threading.Thread '定义线程类  
    Dim action = ""                   '异步动作 
    Dim httpUrl = ""                   '网址
    Dim webContent = ""                   '网页内容

    '加载
    Private Sub test001_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub


    '点击
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call yibu("http://xiyueta.com/")
    End Sub
    '异步操作
    Sub yibu(ByVal url)
        httpUrl = url
        t = New Threading.Thread(AddressOf yibuAction) '让线程类指向子程序
        t.Start() '启动线程
    End Sub

    '操作异步动作
    Sub yibuAction()
        If action = "初始化" Then
            Me.Invoke(New wt(AddressOf waibuSub1), "初始化")
        Else
            webContent = getHttpUrl(httpUrl, "utf-8")
            Me.Invoke(New wt(AddressOf waibuSub1), "其它" & webContent)

        End If
    End Sub
    '异步完成  ********************************************
    Private Sub waibuSub1(ByVal msg) 
        If msg <> "" Then
            txtMsg.Text += msg & vbCrLf
        End If
    End Sub


    '判断是否为空
    Function isNul(ByVal s)
        On Error Resume Next : If Err.Number <> 0 Then Err.Clear()
        isNul = False
        Select Case VarType(s)
            Case vbEmpty, vbNull
                isNul = True : Exit Function
            Case vbString
                If s = "" Then isNul = True : Exit Function
            Case vbObject
                Select Case TypeName(s)
                    Case "Nothing", "Empty"
                        isNul = True : Exit Function
                    Case "Recordset"
                        If s.State = 0 Then isNul = True : Exit Function
                        If s.BOF And s.EOF Then isNul = True : Exit Function
                    Case "Dictionary"
                        If s.Count = 0 Then isNul = True : Exit Function
                End Select
            Case vbArray, 8194, 8204, 8209
                If UBound(s) = -1 Then isNul = True : Exit Function
        End Select
        On Error GoTo 0
    End Function
    '处理字符编码 20150723
    Function handleStrCharSet(ByRef sSetChar As String)
        If sSetChar = "1" Or UCase(sSetChar) = "GB2312" Or sSetChar = "" Then
            sSetChar = "GB2312"
        ElseIf sSetChar = "0" Or UCase(sSetChar) = "UTF-8" Then
            sSetChar = "UTF-8"
        ElseIf sSetChar = "2" Or UCase(sSetChar) = "UNICODE" Then
            sSetChar = "UNICODE"
        End If
        handleStrCharSet = sSetChar
    End Function
    '正则表达式获得字符长度 中文二个字符
    Function strLength(ByRef str As String)
        Dim rep, lens, i
        lens = 0
        rep = CreateObject("VBscript.RegExp")
        rep.global = True
        rep.ignoreCase = True
        rep.pattern = "[\u4E00-\u9FA5\uF900-\uFA2D]"
        For Each i In rep.Execute(str)
            lens = lens + 1
        Next
        rep = Nothing
        lens = lens + Len(str)
        strLength = lens
    End Function

    '获得采集内容 (辅助)
    Function getHttpUrl(ByRef httpurl As String, ByRef sCharSet As String)
        getHttpUrl = handleGetHttpPage(httpurl, sCharSet)(0)
    End Function
    Function bytesToBstr(ByRef byteArr() As Byte, ByRef cset As String)
        Dim objStream
        If isNul(byteArr) Then Exit Function '为空则退出
        objStream = CreateObject("ADODB.Stream")
        objStream.Type = 1
        objStream.Mode = 3
        objStream.Open()
        Call objStream.Write(byteArr)
        objStream.position = 0
        objStream.Type = 2
        objStream.Charset = cset
        bytesToBstr = objStream.readText
        objStream.Close()
        objStream = Nothing
    End Function
    '处理获得采集内容 
    Function handleGetHttpPage(ByVal httpurl As String, ByVal sCharSet As String)
        On Error Resume Next
        Dim startTime, nStatus, nTime, content, sSplType, webFileSize
        startTime = Now()
        sSplType = "|-*ypia=|"
        sCharSet = handleStrCharSet(sCharSet)
        If isNul(httpurl) = True Or Len(httpurl) < 7 Or httpurl = "$False$" Then
            handleGetHttpPage = Split("" & sSplType & -1 & sSplType & nTime & sSplType & webFileSize, sSplType)
            Exit Function
        End If

        Dim http
        http = CreateObject("MSXML2.XMLHTTP")
        Call http.Open("GET", httpurl, False)
        http.send()
        If http.readyState <> 4 Then
            http = Nothing
            handleGetHttpPage = Split("" & sSplType & http.readyState & sSplType & nTime & sSplType & webFileSize, sSplType)
            Exit Function
        End If

        content = bytesToBstr(http.responseBody, sCharSet)
        nStatus = http.Status
        nTime = DateDiff("s", startTime, Now())
        webFileSize = strLength(content)

        handleGetHttpPage = Split(content & sSplType & nStatus & sSplType & nTime & sSplType & webFileSize, sSplType)

        http = Nothing
    End Function
End Class
Newtonsoft.Json.dll安装
Newtonsoft.Json.dll是一个在.NET开发中广泛使用的库,专门用于处理JSON(JavaScript Object Notation)数据。
网址:https://github.com/JamesNK/Newtonsoft.Json/releases/tag/13.0.3

VS10里使用xiyueta.js
在 vs10 里调用 xiyueta.js库,使用 asp.xiyueta.min.js 文件
下载vb里运行xiyuetajs源码>>

加载Microsoft Script Control 1.0

Imports MSScriptControl
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim sc
        sc = CreateObject("ScriptControl")
        sc.language = "Jscript" '设置语言为javascript
        sc.Timeout = -1
        sc.AddCode(getFText("asp.xiyueta.min.js"))
        sc.AddCode(getFText("1.js"))

        Dim txtHtml = "<div>aaa</div><div>bbb</div><div>ccc</div>"


        '两种调用方法
        'Sc.Run("mytestfun", html)
        Dim s = sc.Eval(" xiyueta.load('" & txtHtml & "');;xiyueta('div').text()")
        MsgBox(s)
        s = sc.Eval("xiyueta('div:eq(0)').text()")
        MsgBox(s)

        Call sc.Run("load", txtHtml)

    End Sub


    '读文件内容 (2013,9,27
    Function getFText(ByVal filePath As String)
        Dim fso, fText, openFile
        getFText = ""   '它默认返回的就是空, 这个是多此一举 (2013,9,30)
        filePath = Application.StartupPath() & "/" & filePath
        '获得完整路径
        fso = CreateObject("Scripting.FileSystemObject")
        If fso.fileExists(filePath) = True Then
            fText = fso.openTextFile(filePath, 1)
            '加强 读空文件出错
            openFile = fso.getFile(filePath)
            If openFile.Size = 0 Then getFText = "" : Exit Function '文件为空则退出
            openFile = Nothing
            getFText = fText.readAll
            fText = Nothing
        End If
        fso = Nothing
    End Function


End Class
案例

加载Microsoft Script Control 1.0