程序代码：

Public Declare Function MultiByteToWideCharL Lib "kernel32.dll" Alias "MultiByteToWideChar" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Declare Function WideCharToMultiByteM Lib "kernel32" Alias "WideCharToMultiByte" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Public Declare Function MultiByteToWideCharM Lib "kernel32.dll" Alias "MultiByteToWideChar" _
(ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long 'API判断数组为空或没初始化
Public Function GetHtml(ByVal Url As String, Optional ByVal Coding = "GB2312") As String '获得网页源文件
Dim XmLHttp As WinHttpRequest, xmlBody() As Byte, xmlUrl As String
If InStr(1, Url, "http://", vbTextCompare) = 0 Then
xmlUrl = "http://" & Url
Else
xmlUrl = Url
End If
Set XmLHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With XmLHttp
.Open "GET", xmlUrl, False
.Send
If .Status = 200 Then '判断是否发送成功
xmlBody = .ResponseBody
GetHtmlAn = ""
End If
End With
If SafeArrayGetDim(xmlBody) = 0 Then Exit Function
'首先从UTF8转到UNCODE
'再从UNCODE转到ANSI

Dim sAnsi As String, retLen As Long
Dim sUTF8Buffer As String, S As String, sUnicodeBuffer() As Byte
sAnsi = StrConv(xmlBody, vbUnicode) '转换为VB6可显示的字符串
retLen = MultiByteToWideCharM(65001, 0, sAnsi, -1, vbNullString, 0) '取得转换后需要的空间大小retLen
If retLen > 0 Then
sUTF8Buffer = String$(retLen * 2, vbNullChar) '设置缓冲区大小
retLen = MultiByteToWideCharM(65001, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '开始转换
End If

retLen = WideCharToMultiByteM(0, 0, StrPtr(sUTF8Buffer), -1, vbNullString, 0, vbNullString, 0) '取得转换后需要的空间大小retLen
If retLen > 0 Then
ReDim sUnicodeBuffer(retLen * 2 - 1) ''设置缓冲区大小
retLen = WideCharToMultiByteM(0, 0, StrPtr(sUTF8Buffer), -1, sUnicodeBuffer(0), retLen * 2, vbNullString, 0) '开始转换
ReDim Preserve sUnicodeBuffer(retLen - 1)
S = StrConv(sUnicodeBuffer, vbUnicode)

End If
GetHtmlAn = S
Erase xmlBody
Set XmLHttp = Nothing
End Function
debgu.print GetHtml("http://r.")


用字节流转换的方法已经会了就是想学下用API怎么转换,可是研究了两个晚上不是转换后中文乱码,就是结果变成空的,请懂的大神指点下,已经研究好久了,都没有结果
我是参考的VC的编码转换
http://2011/05/24/2055889.html


'字节流转换编码的函数
Public Function TransCode(xmlBody() As Byte, Optional ByVal Code As String = "UTF-8") As String
Dim ObjStream As ADODB.Stream, BytesToBstr As String
If SafeArrayGetDim(xmlBody) = 0 Then Exit Function
If Len(Code) = 0 Then Code = "UTF-8"
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Type = 1 '1－二进制，2－文本
.Mode = 3 '1－读，2－写，3－读写
.Open
.Write xmlBody
.Position = 0
.Type = 2
.Charset = Code
BytesToBstr = .ReadText
.Close
End With
Erase xmlBody
Set ObjStream = Nothing
TransCode = BytesToBstr
End Function