马上结帐：如何使用winsock 获取网页中指定内容？

hkchoose 2010-01-19 05:40:58

在网上看到很多类似的代码：

 

 Private Sub Form_Load()

          Winsock1.RemoteHost = "www.xxxx.com"

          Winsock1.RemotePort = 80

          Winsock1.Connect

  End Sub

    

  Private Sub Winsock1_Connect()

          Dim Cmd         As String

          Dim Url         As String

          Url = "http://www.xxxx.com/Base.aspx"

          Cmd = "GET     " + Url + "     HTTP/1.1" & vbCrLf & vbCrLf

          Winsock1.SendData Cmd

  End Sub

  Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

            

          Dim Text

            

            Winsock1.GetData Text, vbString

            Text1.Text = Text1.Text & Text

              

  End Sub

可效果都不好，例如http://ent.people.com.cn/GB/42075/81372/10797925.html 的文章
应该如何用winsock实现？
还有，我在另一个网页上用winsockExpert抓包中有以下内容：
HTTP/1.1 200 OK
Date: Tue, 19 Jan 2010 07:51:51 GMT
Server: Microsoft-IIS/6.0
X-Powered-By: ASP.NET
X-AspNet-Version: 2.0.50727
Cache-Control: private
Content-Type: text/plain; charset=utf-8
Content-Length: 1260

GetTodayBonusBack(["001-456","002-567","003-472","004-874","005-781"]);

应该怎么通过winsock来获取这个数据包中的GetTodayBonusBack 中的内容

简单地说，就是如何通过winsock获取网页中的指定内容。希望给出示例！~

...全文

287 10 打赏收藏转发到动态举报

写回复

用AI写文章

10 条回复

切换为时间正序

请发表友善的回复…

发表回复

hkchoose 2010-01-21

打赏
举报

最终这个问题我是在百度贴吧看到cbm666的winsock获取源代码中得到思路，所以在此感谢。liguicd 的回答我都会，因为我是我要学winsock。

神马被哪个妞占用了呢 2010-01-20

打赏
举报

'二进制转UTF8
Private Declare Function MultiByteToWideChar Lib "kernel32" (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
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function UTF8_Decode(bUTF8() As Byte) As String '二进制解析为UTF8
Dim lRet As Long
Dim lLen As Long
Dim lBufferSize As Long
Dim sBuffer As String
Dim bBuffer() As Byte
lLen = UBound(bUTF8) + 1
If lLen = 0 Then Exit Function
lBufferSize = lLen * 2
sBuffer = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(65001, 0, VarPtr(bUTF8(0)), lLen, StrPtr(sBuffer), lBufferSize)
If lRet <> 0 Then
sBuffer = Mid(sBuffer, 1, lRet)
End If
UTF8_Decode = sBuffer
End Function
这个是抄了其他人的一个函数，直接把二进制转为utf8编码。

神马被哪个妞占用了呢 2010-01-20

打赏
举报

Private Sub WinsockTcpQQ_DataArrival(ByVal bytesTotal As Long)
Dim myfile() As Byte
WinsockTcpQQ.GetData myfile, vbArray + vbByte, bytesTotal
HtmlText = HtmlText & UTF8_Decode(myfile)
End Sub
注意，htmltext是全局变量。

神马被哪个妞占用了呢 2010-01-20

打赏
举报

WinsockTcpQQ.SendData "GET /weather/101250102.shtml HTTP/1.1" & vbCrLf & _
"Accept-Language: GB2312" & vbCrLf & _
"Host: www.weather.com.cn" & vbCrLf & _
"Connection: Keep-Alive" & vbCrLf & _
"Cookie: vjuids=17f107e08.12646c122eb.0.bf0f1d0ddcaae; vjlast=1263907447." & vbCrLf & _
"1263918984.13; BIGipServerwww_pool=45679677.20480.0000" & vbCrLf & vbCrLf

这是从中国气象网上获取宁乡天气的get包。期间去掉了gzip压缩，直接可收回数据。但是需要用二进制接收并且需要转码，否则汉字会乱码。

希望对你有帮助。

cbm6666 2010-01-19

打赏
举报

使用Winsock是可以下载源文件但你要的
GetTodayBonusBack(["001-456","002-567","003-472","004-874","005-781"]);

被转链接到其它网址或..........

　　从1月4日开始在内地上映，《阿凡达》一票难求的火爆场面持续了很长一段时间。 　　昨日，一则“《阿凡达》将紧急停映”的消息在网上疯传，还有网友将之与国产大片《孔子》即将上映联系在一起。 　　就此，本报记者向有关方面寻求求证。事实是，包括长沙在内的内地不少影院已经接到“内部通知”：从《孔子》上映时间(1月22日)开始，《阿凡达》2D(普通版)将统一下档，只保留该片的普通3D版、IMAX版。 　　2D版下档 　　3D版、IMAX版会继续放映 　　爆料昨日上午，一则“《阿凡达》将紧急停映”的消息在网上疯传，网友纷纷转帖江苏无锡大世界影城出示的“紧急通知”，该通知称：“接中影公司及院线通知，影片《阿凡达》(所有版本)将于1月23日起全国紧急停映！敬请谅解！!已购买23日、24日票的观众，请于22日前至影城售票处办理退票！”消息一出，有网友将之与国产大片《孔子》即将上映联系在一起。 　　求证 　　影城：片方要求2D版停映 　　从长沙的情况来看，除万达国际影城外，包括中影今典、王府井在内的其他影城尚未接到通知。长沙万达国际影城副总经理周毅表示，通知是17日晚由影院内部系统传达的，下达通知的不是影片在内地的发行方，而是片方。 　　随后，记者尝试联系发行方中影公司新闻发言人翁立，但其手机一直处于关机状态。与中影共同发行《阿凡达》的华夏电影发行有限公司负责人萨先生表示：“据我所知是没有正式通知，至少华夏这边没有下达这种通知，中影那边怎样不太清楚，但也不至于要为了《孔子》而下掉《阿凡达》，不存在‘让道’一说，尤其是在今年本来就已经很挤的贺岁档期间。” 　　说法：既是“让道”也是“还人情” 　　尽管通知的出台比较蹊跷，但《阿凡达》2D版下档一事并非虚构，全国各地的主要影城都已开始做调整工作。由于《阿凡达》2D版下档的日期正好与《孔子》的上映期重合，一位圈内知情人士透露，《阿凡达》2D版下档的目的非常明显，就是给《孔子》让道，只不过官方不方便出面，只好由《阿凡达》片方来操作，“之前《阿凡达》为《十月围城》的票房增值推迟了内地上映日期，然后《孔子》为《阿凡达》推迟上映，这样一来，说是‘还人情’也可以，说是‘让道’也有道理。总之，不论《孔子》之前上的是什么影片，它来了就得‘让道’。”对此，《孔子》片方明确表示不对此事做任何回应。 　　安排 　　《阿凡达》：想看还得提前买票 　　因为“《阿凡达》将停映”的传闻，昨晚长沙几大影院再次出现购票高峰。据了解，《阿凡达》的普通3D版、IMAX版将继续放映至今年3月初，长沙影迷不用担心看不到《阿凡达》。“普通3D版影片的档期一直就比2D版的长，因为国内的3D银幕较少，片源也少，且近期也没有新的3D片上映，加上《阿凡达》现在的票房很高，即便2D版的票房减弱也不会造成太大的影响。”中影今典放电影院总经理杨学非说。也就是说，即使《孔子》来了，长沙三大影院至少8个影厅还会继续放映《阿凡达》(中影今典3个3D厅、王府井2个3D厅、万达2个3D厅1个IMAX厅)。 　　这也意味着，想看《阿凡达》还得提前买票，尤其是IMAX版。长

liguicd 2010-01-19

打赏
举报

1.WebBrowser控件



dim s as string

s=WebBrowser.Document.body.innerHTML或者innerText

2.Inet控件



dim s as string

s=Inet.OpenURL("http://www.86lg.com"）

3.XMLHttp对象



Private Sub Command1_Click()



    Dim Http As Object, URL As String, WebCode As String

    Set Http = CreateObject("Microsoft.XMLHTTP") '调用XMLHTTP对象

    URL = "http://www.86lg.com" '赋予变量URL值

    Http.open "get", URL, False '定义打开URL方式

    Http.send  '发送数据

    WebCode = TRAN(Http.responsebody) '变量zhi等于网页内容



End Sub



Function TRAN(vIn) As String



    Dim strReturn As String, ThisCharCode As String, NextCharCode As String

    Dim i As Long

    strReturn = ""

    For i = 1 To LenB(vIn)

        ThisCharCode = AscB(MidB(vIn, i, 1))

        If ThisCharCode < &H80 Then

            strReturn = strReturn & Chr(ThisCharCode)

        Else

            NextCharCode = AscB(MidB(vIn, i + 1, 1))

            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))

            i = i + 1

        End If

    Next

    TRAN = strReturn

    

End Function