vbscript/vb6 中实现异步请求

'測試的需要，查了不少資料，有兩种方法，綜合如下

'
Dim strUrl: strUrl="http://localhost:7001/in/issueQry.do"
Dim strDat: strDat="uniQueryCode=1670790000005&action=status"
Dim xmlhttp

Call ajaxme(strUrl)


function ajaxme(url)
    Set xmlhttp=Nothing
    On Error Resume Next
    Set xmlhttp = new XMLHttpRequest  'FF
    if (xmlhttp.overrideMimeType)  then
        'xmlhttp.overrideMimeType("text/xml")
    end if
    Err.clear
    On Error Goto 0
    
    if(xmlhttp Is Nothing) then '// IE
        Set xmlhttp = CreateObject("Msxml2.XMLHTTP")
        if err.number<>0 then
            Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
        end if
    end if
    if (xmlhttp Is Nothing) then
        call msgbox("Giving up, Cannot create an XMLHTTP instance.")
        exit function
    end if
    
    '用對象是一種方法
    Dim obj
    'set obj=new oCls
    'xmlhttp.onreadystatechange = obj
    
    '用getRef()是另一種方法
    xmlhttp.onreadystatechange = GetRef("xmlhttp_onreadystatechange")
    
    'Call xmlhttp.open("POST", url & "?" & strDat, true)
    Call xmlhttp.open("POST", url, true)
    Call xmlhttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
    Call xmlhttp.send(strDat)
    
    Call msgbox("Wait for response.")
end function

function xmlhttp_onreadystatechange ()
    if (xmlhttp.readyState=4) then   ' 4   = "complete"
        if (xmlhttp.status=200) then ' 200 = OK
            call msgbox(xmlhttp.responseText)
        else
            call msgbox(xmlhttp.status & ":" & xmlhttp.statusText & "/"+xmlhttp.responseText)
        end if
    end if
end function



Class oCls
    '關鍵是default
    Public default Function Foo()
        Call xmlhttp_onreadystatechange
    End Function
    
    Private Sub Class_Initialize()
        'Do nothing
    End Sub
    
    Private Sub Class_Terminate()
        'Do nothing
    End Sub
End class

'测试需要，查了不少资料，有两种方法，综合一下如下

'
Dim strUrl: strUrl="http://localhost:7001/in/issueQry.do"
Dim strDat: strDat="uniQueryCode=1670790000005&action=status"
Dim xmlhttp

Call ajaxme(strUrl)

function ajaxme(url)
Set xmlhttp=Nothing
On Error Resume Next
Set xmlhttp = new XMLHttpRequest 'FF
if (xmlhttp.overrideMimeType) then
'xmlhttp.overrideMimeType("text/xml")
end if
Err.clear
On Error Goto 0

if(xmlhttp Is Nothing) then '// IE
Set xmlhttp = CreateObject("Msxml2.XMLHTTP")
if err.number<>0 then
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
end if
end if
if (xmlhttp Is Nothing) then
call msgbox("Giving up, Cannot create an XMLHTTP instance.")
exit function
end if

'用对象是一种方法

Dim obj
'set obj=new oCls
'xmlhttp.onreadystatechange = obj

'用GetRef()是另一种方法

xmlhttp.onreadystatechange = GetRef("xmlhttp_onreadystatechange")

'Call xmlhttp.open("POST", url & "?" & strDat, true)
Call xmlhttp.open("POST", url, true)
Call xmlhttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call xmlhttp.send(strDat)

Call msgbox("Wait for response.")
end function

function xmlhttp_onreadystatechange ()
if (xmlhttp.readyState=4) then ' 4 = "complete"
if (xmlhttp.status=200) then ' 200 = OK
call msgbox(xmlhttp.responseText)
else
call msgbox(xmlhttp.status & ":" & xmlhttp.statusText & "/"+xmlhttp.responseText)
end if
end if
end function

 

Class oCls
Public default Function Foo() '关键是default
Call xmlhttp_onreadystatechange
End Function

Private Sub Class_Initialize()
'Do nothing
End Sub

Private Sub Class_Terminate()
'Do nothing
End Sub
End class