我的最爱 博客

获取上证指数VB6源码：

在股票分析中，计算点数压力支撑位置，常常会用到昨收、今开、今收、最高价、最低价的价格进行计算，本文介绍如何通过WEB接口，免费得到它们。

在VB6里，建立一个form、一个command、4个textbox。

把下面的代码复制进去，然后测试一下（点击command1），是否成功了呢？

Private objstream As ADODB.Stream '引用Microsoft ActiveX Data Objects 2.8 Library
Private retrieval As New XMLHTTP '引用Microsoft XML 6.0
Private Sub Command1_Click() '获取btn
Dim xiaoshu As Integer '声明全局小数位数
xiaoshu = 2 '定义全局小数位数
Set objstream = New ADODB.Stream
Dim stockdata
    stockdata = StringWithoutBrackets(GetPage("http://hq.sinajs.cn/list=sh000001")) '新浪链接
Dim stockdata2
    stockdata2 = Split(stockdata, ",") '使用SPLIT函数分隔stockdata
MsgBox "上证指数   " & stockdata2(30) & "," & stockdata2(31) & vbCrLf & "开盘价格:" & FormatNumber(stockdata2(1), xiaoshu, vbTrue, vbFalse, vbFalse) & vbCrLf & vbCrLf & "当前价格:" & FormatNumber(stockdata2(3), xiaoshu, vbTrue, vbFalse, vbFalse) & vbCrLf & vbCrLf & "最高价:" & FormatNumber(stockdata2(4), xiaoshu, vbTrue, vbFalse, vbFalse) & vbCrLf & vbCrLf & "最低价:" & FormatNumber(stockdata2(5), xiaoshu, vbTrue, vbFalse, vbFalse)
Text1.Text = FormatNumber(stockdata2(1), xiaoshu, vbTrue, vbFalse, vbFalse)
Text3.Text = FormatNumber(stockdata2(4), xiaoshu, vbTrue, vbFalse, vbFalse)
Text4.Text = FormatNumber(stockdata2(5), xiaoshu, vbTrue, vbFalse, vbFalse)
Text2.Text = FormatNumber(stockdata2(3), xiaoshu, vbTrue, vbFalse, vbFalse)
End Sub

Private Function GetPage(Url)
    On Error Resume Next
    Set retrieval = New MSXML2.XMLHTTP
    retrieval.Open "GET", Url, False
    If Err <> 0 Then
        MsgBox "错误！"
    End If
    retrieval.send
    If Err.Number <> 0 Then       '未找到服务器！
        GetPage = "连接服务器失败"
    Else
        GetPage = BytesToBstr(retrieval.responseBody)      '成功获取网页源码！
    End If
End Function

Function StringWithoutBrackets(ByVal s As String) As String '去除HTML标记
With CreateObject("VBSCRIPT.REGEXP")
    .Global = True
    .Pattern = "[<][^>]*[>]"
    StringWithoutBrackets = .Replace(s, "")
    '.Pattern = "[chr(34)]"
    'StringWithoutBrackets = .Replace(s, "")
End With
End Function

Private Function BytesToBstr(body)  '用于处理编程转换
    On Error Resume Next
    objstream.Type = 1
    objstream.Mode = 3
    objstream.Open
    objstream.Write body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = "GB2312"
    BytesToBstr = objstream.ReadText
    objstream.Close
End Function