上一篇的我找到的转换代码不太理想。任然有一些是“?”乱码,经过向多方学习最后找到两个方法。

第一种方法

设置一个按钮,一个文本框。文本框的Multiline属性设置为true
 

 
  
  1. Const URLaddr = "http://api.douban.com/book/subject/isbn/9787115157676"   '豆瓣网获取书籍信息网页地址
  2. Dim IEread As Object 
  3. Dim i&, jj&, aa$  
  4. Private Sub Command1_Click()  
  5.    Set IEread = CreateObject("WinHttp.WinHttpRequest.5.1")  
  6.    CallByName IEread, "Open", VbMethod, "GET", URLaddr, True 
  7.    CallByName IEread, "Send", VbMethod  
  8.    CallByName IEread, "WaitForResponse", VbMethod  
  9.    aa = CallByName(IEread, "ResponseText", VbMethod)  
  10.    Text1.Text = aa  
  11. End Sub 

第二种方法

需要引用Microsoft XML,v2.6

 

 
  
  1. Function GetBody(urls as string, Charset as string)  
  2.    GetBody = "" 
  3.    On Error Resume Next 
  4.    Dim Ado_Stream As ADODB.Stream  
  5.    Dim Obj_XMLHTTP As MSXML2.XMLHTTP  
  6.    Set Obj_XMLHTTP = New MSXML2.XMLHTTP  
  7.    Set Ado_Stream = New ADODB.Stream  
  8.    Obj_XMLHTTP.Open "get", urls, False 
  9.    Obj_XMLHTTP.send  
  10.    If Obj_XMLHTTP.readyState = 4 Then 
  11.    If Charset = "" Then 
  12.    GetBody = Obj_XMLHTTP.responseBody  
  13.    Else 
  14.    Ado_Stream.Type = 1  
  15.    Ado_Stream.Mode = 3  
  16.    Ado_Stream.Open  
  17.    Ado_Stream.Write Obj_XMLHTTP.responseBody  
  18.    Ado_Stream.Position = 0  
  19.    Ado_Stream.Type = 2  
  20.    Ado_Stream.Charset = Charset  
  21.    GetBody = Ado_Stream.ReadText  
  22.    Ado_Stream.Close  
  23.    End If 
  24.    End If 
  25.    Set Ado_Stream = Nothing 
  26.    Set Obj_XMLHTTP = Nothing 
  27. End Function 

 

 
  
  1. Private Sub Command1_Click()  
  2.         Dim Txml As String 
  3.         Txml = GetBody("http://api.douban.com/book/subject/isbn/9787115157676" , "UTF-8")  
  4.         Debug.Print Txml  
  5. End Sub 
  6.  
  7.  
  8.