Jump to content

MSXML2.ServerXMLHTTP [ Onreadystatechange ]


Recommended Posts

Try to implement MSXML2.ServerXMLHTTP.6.0 Onreadystatechange but failed

;~ (Method 1) Not work

Global $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
Local $oEventObject = ObjEvent($o_WHttpObj, "__Event")

With $o_WHttpObj
  .Open("GET", $o_BUrl, True)
  .Send()
  ......
EndWith


;~ (Method 2) Not work

Global $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
Local $hHandle = DllCallbackRegister("__Ready", "int", "")  ;~ 
With $o_WHttpObj
  .Open("GET", $o_BUrl, True)
  .onreadystatechange(DllCallbackGetPtr($hHandle)) ;~ Member not found.
  .Send()
EndWith

;~ (Method 3) Not work

;~ https://www.autoitscript.com/forum/topic/206615-convert-getref-function-from-vbscript-to-autoit/?do=findComment&comment=1489925
Global $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
Local $t_Ready
Local $o_Ready = __ObjectFromTag("__MyInterface_", "Ready hresult()", $t_Ready)
With $o_WHttpObj
  .Open("GET", $o_BUrl, True)
  .onreadystatechange($o_Ready()) ;~ Member not found.
  .Send()
EndWith

as @Danyfirex mention in the above thread need some casting to make it work

Local $IID_IServerXMLHTTPRequest2 = "{2E01311B-C322-4B0A-BD77-B90CFDC8DCE7}"
Local $sTagOnreadystatechange = ??
Local $OnreadystatechangeCast = ObjCreateInterface($o_WHttpObj, $IID_IServerXMLHTTPRequest2, $sTagOnreadystatechange, False)


Last Option using AdlibRegister (ok)

Global $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
AdlibRegister("__Onreadystatechange")
With $o_WHttpObj
  .Open("GET", $o_BUrl, False)
  .Send()
  ......
EndWith

Why the above three method failed? may be for my own mistake
So it will help if someone shows how to implement Onreadystatechange using above three failed methods :D

Link to comment
Share on other sites

11 hours ago, jugador said:

Why the above three method failed?

Method 1 fails because, as it says HERE, "The onreadystatechange callback function was not implemented as a COM automation event in the IXMLHTTPRequest and IServerXMLHTTPRequest components."   As you can see HERE, the IServerXMLHTTPRequest interface does not have any events defined.  Therefore, there are no events for ObjEvent() to implement.

Method 2 most likely fails because, even if the syntax for setting the .OnReadyStateChange property was correct, I'm not sure you can use DllCallBackRegister/DllCallbackGetPtr in this particular case.

I'll leave the discussion of what's wrong with Method 3 to someone else.

 

If your primary goal is to be able to identify ReadyState changes, then using ServerXMLHTTP, I would do something like the this:

#AutoIt3Wrapper_AU3Check_Parameters=-w 3 -w 4 -w 5 -w 6 -d

#include <Constants.au3>


async_serverxmlhttp_get_example()

Func async_serverxmlhttp_get_example()
    Local $oComErr = Null
    #forceref $oComErr

    Local $sURL = "https://reqbin.com/echo/get/json"

    Local $hTimer = -1

    Local $iPreviousReadyState = -1, _
          $iCurrentReadyState  = -1


    ;Set local COM error handler
    $oComErr = ObjEvent("AutoIt.Error", "com_error_handler")
    If @error Then Exit MsgBox($MB_ICONERROR + $MB_TOPMOST, "ERROR", "Failed to set COM error handler")

    ConsoleWrite(@CRLF & "ServerXMLHTTP Request: " & $sURL & @CRLF)

    With ObjCreate("MSXML2.ServerXMLHTTP")
        ;Open asynchronous GET request and send it
        .Open("GET", $sURL, True)
        .Send()

        ;Loop until ready state is complete (4) or timeout occurs (5 seconds)
        $hTimer = TimerInit()
        While $iCurrentReadyState <> 4 And TimerDiff($hTimer) < 5000
            $iCurrentReadyState = .readystate

            ;If ready state has changed, then save & display new ready state
            If $iPreviousReadyState <> $iCurrentReadyState Then
                $iPreviousReadyState = $iCurrentReadyState
                ConsoleWrite("Response Ready State:  " & get_ready_state_desc($iCurrentReadyState) & @CRLF)
            EndIf

            Sleep(10)
        WEnd
        If $iCurrentReadyState <> 4 Then Exit ConsoleWrite("Timeout occurred waiting for response" & @CRLF)

        ;Display response info
        ConsoleWrite("Response Status:       " & StringFormat("%i (%s)", .Status, .StatusText) & @CRLF)
        ConsoleWrite("Response Body:         " & .ResponseText & @CRLF)
    EndWith
EndFunc

Func get_ready_state_desc($iReadyState)
    Local $sDesc = ""

    Switch $iReadyState
        Case 0
            $sDesc = "Uninitialized"
        Case 1
            $sDesc = "Loading"
        Case 2
            $sDesc = "Loaded"
        Case 3
            $sDesc = "Interactive"
        Case 4
            $sDesc = "Complete"
        Case Else
            $sDesc = "Unrecognized"
    EndSwitch

    Return StringFormat("%s (%i)", $sDesc, $iReadyState)
EndFunc

Func com_error_handler($oError)
    With $oError
        ConsoleWrite(@CRLF & "COM ERROR DETECTED!" & @CRLF)
        ConsoleWrite("  Error ScriptLine....... " & .scriptline & @CRLF)
        ConsoleWrite("  Error Number........... " & StringFormat("0x%08x (%i)", .number, .number) & @CRLF)
        ConsoleWrite("  Error WinDescription... " & StringStripWS(.windescription, $STR_STRIPTRAILING) & @CRLF)
        ConsoleWrite("  Error RetCode.......... " & StringFormat("0x%08x (%i)", .retcode, .retcode) & @CRLF)
        ConsoleWrite("  Error Description...... " & StringStripWS(.description   , $STR_STRIPTRAILING) & @CRLF)
    EndWith
    Exit
EndFunc

Console output from the script above:

>Running:(3.3.14.5):C:\Portable Apps\AutoIt3\autoit3_x64.exe "C:\Projects\Personal\AutoIt\Test\A3Temp\a3_temp.au3"    
+>Setting Hotkeys...--> Press Ctrl+Alt+Break to Restart or Ctrl+BREAK to Stop.

ServerXMLHTTP Request: https://reqbin.com/echo/get/json
Response Ready State:  Loading (1)
Response Ready State:  Complete (4)
Response Status:       200 (OK)
Response Body:         {"success":"true"}

+>15:31:17 AutoIt3.exe ended.rc:0
+>15:31:17 AutoIt3Wrapper Finished.
>Exit code: 0    Time: 0.6689

 

Edited by TheXman
Link to comment
Share on other sites

@TheXman was trying to achieve this without using AdlibRegister 

#AutoIt3Wrapper_AU3Check_Parameters=-w 3 -w 4 -w 5 -w 6 -d

#include <Constants.au3>
#include <Array.au3>

Global $o_ArrayCnt
Global $o_WHttpOb[4][2]

__Example1()
Func __Example1()
    $o_WHttpOb[0][1] = "https://www.autoitscript.com/forum/"
    $o_WHttpOb[1][1] = "https://www.google.com/"
    $o_WHttpOb[2][1] = "https://www.bing.com/"
    $o_WHttpOb[3][1] = "https://github.com/"

    $o_ArrayCnt = UBound($o_WHttpOb) - 1
    __WinhttpGet()
EndFunc

Func __WinhttpGet()
    Local $oComErr = Null
    $oComErr = ObjEvent("AutoIt.Error", com_error_handler)
    #forceref $oComErr

    AdlibRegister("__Onreadystatechange")
    For $i = 0 To UBound($o_WHttpOb) - 1
        $o_WHttpOb[$i][0] = ObjCreate("Msxml2.XMLHTTP.6.0")
        If IsObj($o_WHttpOb[$i][0]) Then
            With $o_WHttpOb[$i][0]
                .Open("GET", $o_WHttpOb[$i][1], True)
                If @error Then
                    $o_ArrayCnt -= 1
                    __CloseObject($o_WHttpOb[$i][0], "> Site(" & $o_WHttpOb[$i][1] & ") Open @error: " & Hex(@error))
                Endif

                If IsObj($o_WHttpOb[$i][0]) Then
                    .Send()
                    If @error Then
                        $o_ArrayCnt -= 1
                        __CloseObject($o_WHttpOb[$i][0], "> Site(" & $o_WHttpOb[$i][1] & ") Send @error: " & Hex(@error))
                    Endif
                Endif
            EndWith
        Endif
    Next

    If $o_ArrayCnt < 0 Then __OnExit("Failed to Open all site......")
    While 1
         ToolTip("Msxml2.XMLHTTP.6.0 [Onreadystatechange]")
        Sleep(250)
    WEnd
EndFunc

; #FUNCTION# =============================================================================
; Name...........: __Onreadystatechange()
; ========================================================================================
Func __Onreadystatechange()
    Local $iFlag = False
    Local Static $iCount = 0
    For $i = 0 To UBound($o_WHttpOb) -1
        If Not IsObj($o_WHttpOb[$i][0]) Then ContinueLoop
        If ($o_WHttpOb[$i][0].readyState <> 4) Then ContinueLoop
        If ($o_WHttpOb[$i][0].status = 200) Then
            ConsoleWrite("> ( " & $o_WHttpOb[$i][1] & " )(ResponseText....) " & @CRLF)
            ConsoleWrite($o_WHttpOb[$i][0].ResponseText & @CRLF)
        Else
            ConsoleWrite("> ( " & $o_WHttpOb[$i][1] & " )(Status....) " & @CRLF)
            ConsoleWrite($o_WHttpOb[$i][0].Status & @CRLF)
        Endif
        If $iCount = $o_ArrayCnt Then $iFlag = True
        __CloseObject($o_WHttpOb[$i][0], "> ( " & $iCount & " )( " & $o_WHttpOb[$i][1] & " ) #Download Complete#", $iFlag)
        $iCount += 1
    Next
EndFunc

; #FUNCTION# =============================================================================
; Name...........: __CloseObject()
; ========================================================================================
Func __CloseObject(ByRef $o_RObj, $x_Msg = "", $x_Flag = True)
    If IsObj($o_RObj) Then $o_RObj = 0
    ConsoleWrite($x_Msg & @CRLF)
    If $x_Flag Then __OnExit()
EndFunc   ;==>Example

; #FUNCTION# =============================================================================
; Name...........: __OnExit()
; ========================================================================================
Func __OnExit($x_Msg = "")
    ConsoleWrite("> __OnExit( " & $x_Msg &" )"& @CRLF)
    AdlibUnRegister("__Onreadystatechange")
    Exit
EndFunc   ;==>Example

; #FUNCTION# =============================================================================
; Name...........: com_error_handler()
; ========================================================================================
Func com_error_handler($oError)
    With $oError
        ConsoleWrite(@CRLF & "COM ERROR DETECTED!" & @CRLF)
        ConsoleWrite("  Error ScriptLine....... " & .scriptline & @CRLF)
        ConsoleWrite("  Error Number........... " & "0x" & Hex(.number) & " (" & .number & ")" & @CRLF)
        ConsoleWrite("  Error WinDescription... " & StringStripWS(.windescription, $STR_STRIPTRAILING) & @CRLF)
        ConsoleWrite("  Error RetCode.......... " & "0x" & Hex(Number(.retcode)) & " (" & Number(.retcode) & ")" & @CRLF)
        ConsoleWrite("  Error Description...... " & StringStripWS(.description   , $STR_STRIPTRAILING) & @CRLF)
    EndWith
EndFunc

 

Link to comment
Share on other sites

working Vbscript

Dim oHttpObj
Dim oUrl
oUrl = "https://www.autoitscript.com/forum/"

Set oHttpObj = CreateObject("MSXML2.ServerXMLHTTP.6.0")
If IsObject(oHttpObj) Then
	msgbox  "CreateObject(Ok)"
	
	oHttpObj.Open "GET", oUrl, True
	oHttpObj.onreadystatechange = GetRef("oHTTP_OnReadyStateChange")
	oHttpObj.Send
	
	While oHttpObj.ReadyState <> 4  
		WScript.Sleep(250)
	Wend 
	
	Set oHttpObj = Nothing
	msgbox  "Done+++"
End If

Sub oHTTP_OnReadyStateChange
    If oHttpObj.ReadyState = 4 Then
		If oHttpObj.Status = 200 Then
			msgbox  oHttpObj.responseText
		Else
			msgbox  oHttpObj.Status
		End If
	End If
End sub

 

This the working akh code

req := ComObjCreate("Msxml2.XMLHTTP")
; Open a request with async enabled.
req.open("GET", "https://www.autohotkey.com/download/1.1/version.txt", true)
; Set our callback function [requires v1.1.17+].
req.onreadystatechange := Func("Ready")
; Send the request.  Ready() will be called when it's complete.
req.send()
/*
; If you're going to wait, there's no need for onreadystatechange.
; Setting async=true and waiting like this allows the script to remain
; responsive while the download is taking place, whereas async=false
; will make the script unresponsive.
while req.readyState != 4
    sleep 100
*/
#Persistent

Ready() {
    global req
    if (req.readyState != 4)  ; Not done yet.
        return
    if (req.status == 200) ; OK.
        MsgBox % "Latest AutoHotkey version: " req.responseText
    else
        MsgBox 16,, % "Status " req.status
    ExitApp
}

attempt to convert akh to Autoit :unsure:

#include <Array.au3>
#include <Constants.au3>
#include <WinAPISys.au3>

Global $o_WHttpObj

__WinhttpRequestEg("https://www.autoitscript.com/forum/")
Func __WinhttpRequestEg($o_BUrl)
    Local $oComErr = Null
    $oComErr = ObjEvent("AutoIt.Error", com_error_handler)
    #forceref $oComErr

    $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
    If Not IsObj($o_WHttpObj) Then Return ConsoleWrite("Failed to create MSXML2.ServerXMLHTTP object")
    ConsoleWrite("< MSXML2.ServerXMLHTTP (ObjCreate) Ok" & @CRLF)

    Local $dtag_ORC = "Invoke hresult(idispatch;ptr);"
    Local $t_InvokeORC
    $o_InvokeORC = __ObjectFromTag("__MyInterface_", $dtag_ORC, $t_InvokeORC)
    If Not IsObj($o_InvokeORC) Then
        $o_WHttpObj = 0
        ConsoleWrite("__ObjectFromTag() Failed")
        Exit
    Endif
    ConsoleWrite("< __ObjectFromTag() Ok" & @CRLF)

    $o_WHttpObj.Open("GET", $o_BUrl, True)
    If @error Then
        __ONExit($o_InvokeORC, $t_InvokeORC, "MSXML2.ServerXMLHTTP(Open) Failed")
    EndIf
    ConsoleWrite("< MSXML2.ServerXMLHTTP(Open) Ok" & @CRLF)

    ;~ but __MyInterface_Invoke() not call
    $o_WHttpObj.onreadystatechange = $o_InvokeORC   ;~ <<<<<<<<<<<<<<<<
    If @error Then
        __ONExit($o_InvokeORC, $t_InvokeORC, "MSXML2.ServerXMLHTTP(onreadystatechange) Failed")
    EndIf
    ConsoleWrite("< MSXML2.ServerXMLHTTP(onreadystatechange) Ok" & @CRLF)

    $o_WHttpObj.Send()
    If @error Then
        __ONExit($o_InvokeORC, $t_InvokeORC, "MSXML2.ServerXMLHTTP(Send) Failed")
    EndIf
    ConsoleWrite("< MSXML2.ServerXMLHTTP(Send) Ok" & @CRLF)

    __ONExit($o_InvokeORC, $t_InvokeORC, "< Done ++++++")
EndFunc

Func __ONExit(Byref $o_InvokeORC, Byref $t_InvokeORC, $o_Msg = '')
    $o_InvokeORC = 0
    __DeleteObjectFromTag($t_InvokeORC)
    $o_WHttpObj = 0
    ConsoleWrite($o_Msg & @CRLF)
    Exit
EndFunc

Func __MyInterface_QueryInterface($pSelf, $pRIID, $pObj)
    ConsoleWrite('> __MyInterface_QueryInterface()' & @CRLF)
    DllStructSetData(DllStructCreate("ptr", $pObj), 1, $pSelf)
    Return 0 ; $S_OK
EndFunc

Func __MyInterface_AddRef($pSelf)
    ConsoleWrite('> __MyInterface_AddRef()' & @CRLF)
    Return 1
EndFunc

Func __MyInterface_Release($pSelf)
    ConsoleWrite('> __MyInterface_Release()' & @CRLF)
    Return 1
EndFunc

Volatile Func __MyInterface_Invoke($pSelf, $p_ORC, $pCallbackArgs)
    #forceref $pSelf, $p_ORC, $pCallbackArgs
    ConsoleWrite('> __MyInterface_Invoke()' & @CRLF)
    Return 0 ; $S_OK
EndFunc

; #FUNCTION# =============================================================================
; Name...........: __ObjectFromTag
; ========================================================================================
Func __ObjectFromTag( $sFunctionPrefix, $tagInterface, ByRef $tInterface, $bObject = True, $bPrint = False, $bIsUnknown = True, $sIID = "{00000000-0000-0000-C000-000000000046}" ) ; Last param is IID_IUnknown by default
    Local $sInterface = $tagInterface ; Copy interface description
    Local $tagIUnknown = _ ; IUnknown interface description
        "QueryInterface hresult(ptr;ptr*);" & _
        "AddRef dword();" & _
        "Release dword();"
    If $bIsUnknown Then $tagInterface = $tagIUnknown & $tagInterface ; Adding IUnknown methods
    Local $aMethods = StringSplit( StringTrimRight( StringReplace( StringRegExpReplace( $tagInterface, "\h*(\w+)\h*(\w+\*?)\h*(\(\h*(.*?)\h*\))\h*(;|;*\z)", "$1\|$2\|$4" & @LF ), ";" & @LF, @LF ), 1 ), @LF, 3 )
    Local $iMethods = UBound( $aMethods ), $aSplit, $aSplit2, $iSplit2, $sParams, $sParams2, $oParams = ObjCreate( "Scripting.Dictionary" ), $oParams2 = ObjCreate( "Scripting.Dictionary" ), $hCallback, $iPar, $s, $t
    $tInterface = DllStructCreate( "int RefCount;int Size;ptr Object;ptr Methods[" & $iMethods & "];int_ptr Callbacks[" & $iMethods & "];ulong_ptr Slots[16]" ) ; 16 pointer sized elements more to create space for possible private props
    If @error Then Return SetError( 1, 0, 0 )
    For $i = 0 To $iMethods - 1
        $aSplit = StringSplit( $aMethods[$i], "|", 2 )
        $aSplit[0] = $sFunctionPrefix & $aSplit[0] ; Method name
        If $aSplit[1] = "hresult" Then $aSplit[1] = "long" ; Return type
        $sParams = $aSplit[2] ? "ptr;" & StringReplace( StringReplace( StringReplace( StringReplace( $aSplit[2], "object", "idispatch" ), "bstr", "ptr" ), "variant", "ptr" ), "hresult", "long" ) : "ptr" ; Params
        If $bPrint Then
            $iPar = StringInStr( $sParams, ";", 2 )
            If $iPar Then
                $sParams2 = StringRight( $sParams, StringLen( $sParams ) - $iPar )
                If StringInStr( $aSplit[0], "_QueryInterface", 2 ) Then
                    $s = ", $pRIID, $pObj"
                Else
                    $oParams.RemoveAll()
                    $oParams2.RemoveAll()
                    $aSplit2 = StringSplit( $sParams2, ";", 2 )
                    $iSplit2 = UBound( $aSplit2 )
                    For $j = 0 To $iSplit2 - 1
                        $aSplit2[$j] = StringRegExpReplace( $aSplit2[$j], "\*$", "" )
                        $oParams( $aSplit2[$j] ) += 1
                    Next
                    $s = ""
                    For $j = 0 To $iSplit2 - 1
                        $s &= ", $" & $aSplit2[$j]
                        If $oParams.Item( $aSplit2[$j] ) > 1 Then
                            $oParams2( $aSplit2[$j] ) += 1
                            $s &= $oParams2( $aSplit2[$j] )
                        EndIf
                    Next
                EndIf
            EndIf
            $t = $iPar ? "Ret: " & $aSplit[1] & "  " & "Par: " & $sParams2 : "Ret: " & $aSplit[1]
            ConsoleWrite( "Func " & $aSplit[0] & ( $iPar ? "( $pSelf" & $s & " ) ; " : "( $pSelf ) ; " ) & $t & @CRLF )
            ConsoleWrite( "  ConsoleWrite( """ & $aSplit[0] & "()"" & @CRLF & @CRLF )" & @CRLF )
            ConsoleWrite( "  Return " & ( ( StringInStr( $aSplit[0], "_AddRef", 2 ) Or StringInStr( $aSplit[0], "_Release", 2 ) ) ? "1 ; For AddRef/Release" : "0 ; S_OK = 0x00000000" ) & @CRLF )
            ConsoleWrite( "  #forceref" & ( $iPar ? " $pSelf" & $s : " $pSelf" ) & @CRLF & "EndFunc" & @CRLF )
        EndIf
        $hCallback = DllCallbackRegister( $aSplit[0], $aSplit[1], $sParams )
        If $bPrint Then ConsoleWrite( "@error = " & @error & @CRLF & @CRLF )
        DllStructSetData( $tInterface, "Methods", DllCallbackGetPtr( $hCallback ), $i + 1 ) ; Save callback pointer
        DllStructSetData( $tInterface, "Callbacks", $hCallback, $i + 1 ) ; Save callback handle
    Next
    DllStructSetData( $tInterface, "RefCount", 1 ) ; Initial ref count is 1
    DllStructSetData( $tInterface, "Size", $iMethods ) ; Number of interface methods
    DllStructSetData( $tInterface, "Object", DllStructGetPtr( $tInterface, "Methods" ) ) ; Interface method pointers
    Return $bObject ? ObjCreateInterface( DllStructGetPtr( $tInterface, "Object" ), $sIID, $sInterface, $bIsUnknown ) : DllStructGetPtr( $tInterface, "Object" )
EndFunc           ; Pointer that's wrapped into object                                                              ; Pointer ( = $pSelf )

; #FUNCTION# =============================================================================
; Name...........: __DeleteObjectFromTag
; ========================================================================================
Func __DeleteObjectFromTag( ByRef $tInterface )
    For $i = 1 To DllStructGetData( $tInterface, "Size" )
        DllCallbackFree( DllStructGetData( $tInterface, "Callbacks", $i ) )
    Next
    $tInterface = 0
EndFunc

; #FUNCTION# =============================================================================
; Name...........: com_error_handler
; ========================================================================================
Func com_error_handler($oError)
    With $oError
        ConsoleWrite(@CRLF & "COM ERROR DETECTED!" & @CRLF)
        ConsoleWrite("  Error ScriptLine....... " & .scriptline & @CRLF)
        ConsoleWrite("  Error Number........... " & "0x" & Hex(.number) & " (" & .number & ")" & @CRLF)
        ConsoleWrite("  Error WinDescription... " & StringStripWS(.windescription, $STR_STRIPTRAILING) & @CRLF)
        ConsoleWrite("  Error RetCode.......... " & "0x" & Hex(Number(.retcode)) & " (" & Number(.retcode) & ")" & @CRLF)
        ConsoleWrite("  Error Description...... " & StringStripWS(.description   , $STR_STRIPTRAILING) & @CRLF)
    EndWith
EndFunc

Console Output:

< MSXML2.ServerXMLHTTP (ObjCreate) Ok
> __MyInterface_QueryInterface()
> __MyInterface_Release()
< __ObjectFromTag() Ok
< MSXML2.ServerXMLHTTP(Open) Ok
< MSXML2.ServerXMLHTTP(onreadystatechange) Ok
< MSXML2.ServerXMLHTTP(Send) Ok
< Done ++++++

No error on running but __MyInterface_Invoke() not call why?

@Danyfirex  what am I doing wrong.

Edited by jugador
Link to comment
Share on other sites

Hello, I don't have enough time now to check this deeply, but You can handle it in this ugly way.

_Test()

Func _Test()
    Global $oHTTP = ObjCreate("Msxml2.ServerXMLHTTP")

    Global $tMyObject
    Global $oMyObject = __ObjectFromTag("__MyInterface_", "OnReadyStateChange hresult(object)", $tMyObject)

    Local $oScript = ObjCreate("ScriptControl")
    With $oScript
        .Language = "VBScript"
        .AddCode('Public Function CallBack:oAutoIt.OnReadyStateChange(oRequest):End Function')
        .AddObject('oAutoIt', $oMyObject)
        .AddObject('oRequest', $oHTTP)
    EndWith


    With $oHTTP
        .Open("GET", "https://www.autohotkey.com/download/1.1/version.txt", True)
        .onreadystatechange = $oScript.Eval('GetRef("CallBack")')
        .Send()
    EndWith

    ConsoleWrite("$oHTTP.readyState: " & $oHTTP.readyState & @CRLF)

    While $oHTTP.ReadyState <> 4
        Sleep(100)
    WEnd
    Exit
EndFunc   ;==>_Test


Func __MyInterface_QueryInterface($pSelf, $pRIID, $pObj)
    Local $tStruct = DllStructCreate("ptr", $pObj)
    DllStructSetData($tStruct, 1, $pSelf)
    Return 0 ; $S_OK
EndFunc   ;==>__MyInterface_QueryInterface

Func __MyInterface_AddRef($pSelf)
    Return 1
EndFunc   ;==>__MyInterface_AddRef

Func __MyInterface_Release($pSelf)
    Return 1
EndFunc   ;==>__MyInterface_Release

Func __MyInterface_OnReadyStateChange($pSelf, $oRequest)
    If Not IsObj($oRequest) Then Return ConsoleWrite("Error $oRequest" & @CRLF)
    If $oRequest.ReadyState <> 4 Then Return 0
    If $oRequest.Status = 200 Then
        MsgBox(0, "", "Latest AutoHotkey version: " & $oRequest.responseText)
    Else
        Exit MsgBox(0, "Error", "Status: " & $oRequest.Status)
    EndIf
    Return 0 ; $S_OK
EndFunc   ;==>__MyInterface_OnReadyStateChange

Func __ObjectFromTag($sFunctionPrefix, $tagInterface, ByRef $tInterface, $bIsUnknown = Default, $sIID = "{00000000-0000-0000-C000-000000000046}") ; last param is IID_IUnknown by default
    If $bIsUnknown = Default Then $bIsUnknown = True
    Local $sInterface = $tagInterface ; copy interface description
    Local $tagIUnknown = "QueryInterface hresult(ptr;ptr*);" & _
            "AddRef dword();" & _
            "Release dword();"
    ; Adding IUnknown methods
    If $bIsUnknown Then $tagInterface = $tagIUnknown & $tagInterface
    ; Below line is really simple even though it looks super complex. It's just written weird to fit in one line, not to steal your attention
    Local $aMethods = StringSplit(StringTrimRight(StringReplace(StringRegExpReplace(StringRegExpReplace($tagInterface, "\w+\*", "ptr"), "\h*(\w+)\h*(\w+\*?)\h*(\((.*?)\))\h*(;|;*\z)", "$1\|$2;$4" & @LF), ";" & @LF, @LF), 1), @LF, 3)
    Local $iUbound = UBound($aMethods)
    Local $sMethod, $aSplit, $sNamePart, $aTagPart, $sTagPart, $sRet, $sParams, $hCallback
    ; Allocation
    $tInterface = DllStructCreate("int RefCount;int Size;ptr Object;ptr Methods[" & $iUbound & "];int_ptr Callbacks[" & $iUbound & "];ulong_ptr Slots[16]") ; 16 pointer sized elements more to create space for possible private props
    If @error Then Return SetError(1, 0, 0)
    For $i = 0 To $iUbound - 1
        $aSplit = StringSplit($aMethods[$i], "|", 2)
        If UBound($aSplit) <> 2 Then ReDim $aSplit[2]
        $sNamePart = $aSplit[0]
        ; Replace COM types by matching dllcallback types
        $sTagPart = StringReplace(StringReplace(StringReplace(StringReplace($aSplit[1], "object", "idispatch"), "hresult", "long"), "bstr", "ptr"), "variant", "ptr")
        $sMethod = $sFunctionPrefix & $sNamePart
        $aTagPart = StringSplit($sTagPart, ";", 2)
        $sRet = $aTagPart[0]
        $sParams = StringReplace($sTagPart, $sRet, "", 1)
        $sParams = "ptr" & $sParams
        $hCallback = DllCallbackRegister($sMethod, $sRet, $sParams)
        DllStructSetData($tInterface, "Methods", DllCallbackGetPtr($hCallback), $i + 1) ; save callback pointer
        DllStructSetData($tInterface, "Callbacks", $hCallback, $i + 1) ; save callback handle
    Next
    DllStructSetData($tInterface, "RefCount", 1) ; initial ref count is 1
    DllStructSetData($tInterface, "Size", $iUbound) ; number of interface methods
    DllStructSetData($tInterface, "Object", DllStructGetPtr($tInterface, "Methods")) ; Interface method pointers
    Return ObjCreateInterface(DllStructGetPtr($tInterface, "Object"), $sIID, $sInterface, $bIsUnknown) ; pointer that's wrapped into object
EndFunc   ;==>__ObjectFromTag

Func __DeleteObjectFromTag(ByRef $tInterface)
    For $i = 1 To DllStructGetData($tInterface, "Size")
        DllCallbackFree(DllStructGetData($tInterface, "Callbacks", $i))
    Next
    $tInterface = 0
EndFunc   ;==>__DeleteObjectFromTag

Saludos

Link to comment
Share on other sites

@Danyfirex  Thanks It worked :)


VBScript  =>  GetRef() methoreturn Object
Autohotkey  =>  Func() methoreturn Object
Autoit  =>  ObjectFromTag() method return Object but not worked

so why Autoit failed to call __MyInterface_Invoke in my code.
or there no method in Autoit to convert function into object.

on google search found this....
Using IXMLHTTPRequest onreadystatechange from C++
http://www.ookii.org/Blog/using_ixmlhttprequestonreadystatechange_from_c

Edited by jugador
Link to comment
Share on other sites

  • 3 weeks later...

after reading @Bilgus and @trancexx post 
https://www.autoitscript.com/forum/topic/187334-using-net-libary-with-autoit-possible/?do=findComment&comment=1348690

working code :P

#include <Array.au3>
#include <Constants.au3>

Global $o_WHttpObj

__WinhttpRequestEg("https://www.autoitscript.com/forum/")
Func __WinhttpRequestEg($o_BUrl)
    Local $obj_ptr = Null
    Local $t_OnReady
    Local $o_OnReady
    Local $sIID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

    Local Const $tagIDispatch = _
        "GetTypeInfoCount hresult(dword*);" & _
        "GetTypeInfo hresult(dword;dword;ptr*);" & _
        "GetIDsOfNames hresult(struct*;struct*;dword;dword;struct*);" & _
        "Invoke hresult(uint;struct*;dword;word;struct*;struct*;ptr;uint*);"

    Local Const $tag_OnReady = $tagIDispatch & _
        "Ready hresult();"

    Local $oComErr = Null
    $oComErr = ObjEvent("AutoIt.Error", com_error_handler)
    #forceref $oComErr

    $o_OnReady = __ObjectFromTag("OnReadyStateChange_", $tag_OnReady, $t_OnReady)
    If @error Then Return ConsoleWrite("__ObjectFromTag() Failed")
    ConsoleWrite("< __ObjectFromTag($o_OnReady) Ok" & @CRLF)


    $o_WHttpObj = ObjCreate("MSXML2.ServerXMLHTTP.6.0")
    If Not IsObj($o_WHttpObj) Then __ONExit($o_OnReady, $t_OnReady, $obj_ptr,"Failed to create MSXML2.ServerXMLHTTP object")
    ConsoleWrite("< ObjCreate(MSXML2.ServerXMLHTTP.6.0) Ok" & @CRLF)

    $o_WHttpObj.Open("GET", $o_BUrl, True)
    If @error Then __ONExit($o_OnReady, $t_OnReady, $obj_ptr, "MSXML2.ServerXMLHTTP(Open) Failed")
    ConsoleWrite("< MSXML2.ServerXMLHTTP(Open) Ok" & @CRLF)

    $obj_ptr = ObjCreateInterface($o_OnReady(), $sIID_IDispatch)
    If @error Then __ONExit($o_OnReady, $t_OnReady, $obj_ptr, "Convert Ptr To IDispatch Failed")
    ConsoleWrite("< Convert Ptr To IDispatch Failed() Ok" & @CRLF)

    $o_WHttpObj.onreadystatechange = $obj_ptr
    If @error Then __ONExit($o_OnReady, $t_OnReady, $obj_ptr, "MSXML2.ServerXMLHTTP(onreadystatechange) Failed")
    ConsoleWrite("< MSXML2.ServerXMLHTTP(onreadystatechange) Ok" & @CRLF)

    $o_WHttpObj.Send()
    If @error Then __ONExit($o_OnReady, $t_OnReady, $obj_ptr, "MSXML2.ServerXMLHTTP(Send) Failed")
    ConsoleWrite("< MSXML2.ServerXMLHTTP(Send) Ok" & @CRLF)

    While $o_WHttpObj.ReadyState <> 4
        ConsoleWrite("$oHTTP.readyState: " & $o_WHttpObj.readyState & @CRLF)
        Sleep(100)
    WEnd

    __ONExit($o_OnReady, $t_OnReady, $obj_ptr, "< Done ++++++")
EndFunc

; #FUNCTION# =============================================================================
; Name...........: __ONExit
; ========================================================================================
Func __ONExit(Byref $o_OnReady, Byref $t_OnReady, Byref $obj_ptr, $o_Msg = '')
    $o_WHttpObj = 0
    $obj_ptr = 0
    $o_OnReady = 0
    __DeleteObjectFromTag($t_OnReady)
    ConsoleWrite($o_Msg & @CRLF)
    Exit
EndFunc

Func OnReadyStateChange_QueryInterface($pSelf, $pRIID, $pObj)
    ConsoleWrite('> OnReadyStateChange_QueryInterface()' & @CRLF)
    DllStructSetData(DllStructCreate("ptr", $pObj), 1, $pSelf)
    OnReadyStateChange_AddRef($pSelf)
    Return 0 ; $S_OK
EndFunc

Func OnReadyStateChange_AddRef($pSelf)
    ConsoleWrite('> OnReadyStateChange_AddRef()' & @CRLF)
    Return 1
EndFunc

Func OnReadyStateChange_Release($pSelf)
    ConsoleWrite('> OnReadyStateChange_Release()' & @CRLF)
    Return 1
EndFunc

Func OnReadyStateChange_GetTypeInfoCount( $pSelf, $dword ) ; Ret: long  Par: dword*
  ConsoleWrite( "> OnReadyStateChange_GetTypeInfoCount()" & @CRLF)
  Return 0 ; S_OK = 0x00000000
  #forceref $pSelf, $dword
EndFunc

Func OnReadyStateChange_GetTypeInfo( $pSelf, $dword1, $dword2, $ptr ) ; Ret: long  Par: dword;dword;ptr*
  ConsoleWrite( "> OnReadyStateChange_GetTypeInfo()" & @CRLF)
  Return 0 ; S_OK = 0x00000000
  #forceref $pSelf, $dword1, $dword2, $ptr
EndFunc

Func OnReadyStateChange_GetIDsOfNames( $pSelf, $struct1, $struct2, $dword1, $dword2, $struct3 ) ; Ret: long  Par: struct*;struct*;dword;dword;struct*
  ConsoleWrite( "> OnReadyStateChange_GetIDsOfNames()" & @CRLF)
  Return 0 ; S_OK = 0x00000000
  #forceref $pSelf, $struct1, $struct2, $dword1, $dword2, $struct3
EndFunc

Func OnReadyStateChange_Invoke( $pSelf, $uint1, $struct1, $dword, $word, $struct2, $struct3, $ptr, $uint2 ) ; Ret: long  Par: uint;struct*;dword;word;struct*;struct*;ptr;uint*
  ConsoleWrite( "> OnReadyStateChange_Invoke()" & @CRLF)
  OnReadyStateChange_Ready($pSelf)      ; <<<<<<<<<<<<<<<
  Return 0 ; S_OK = 0x00000000
  #forceref $pSelf, $uint1, $struct1, $dword, $word, $struct2, $struct3, $ptr, $uint2
EndFunc

Volatile Func OnReadyStateChange_Ready($pSelf)
    ConsoleWrite('> OnReadyStateChange_Ready()' & @CRLF)
        If $o_WHttpObj.ReadyState = 4 Then
            If $o_WHttpObj.Status = 200 Then
                ConsoleWrite('responseText' & @CRLF & $o_WHttpObj.responseText & @CRLF)
            Else
                ConsoleWrite('Status' & @CRLF & $o_WHttpObj.Status & @CRLF)
            EndIf
        EndIf
    Return 0 ; $S_OK
EndFunc


; #FUNCTION# =============================================================================
; Name...........: __ObjectFromTag
; ========================================================================================
Func __ObjectFromTag($sFunctionPrefix, $tagInterface, ByRef $tInterface, $fPrint = False, $bIsUnknown = Default, $sIID = "{00000000-0000-0000-C000-000000000046}") ; last param is IID_IUnknown by default
    If $bIsUnknown = Default Then $bIsUnknown = True
    Local $sInterface = $tagInterface ; copy interface description
    Local $tagIUnknown = "QueryInterface hresult(ptr;ptr*);" & _
            "AddRef dword();" & _
            "Release dword();"
    ; Adding IUnknown methods
    If $bIsUnknown Then $tagInterface = $tagIUnknown & $tagInterface
    ; Below line is really simple even though it looks super complex. It's just written weird to fit in one line, not to steal your attention
    Local $aMethods = StringSplit(StringReplace(StringReplace(StringReplace(StringReplace(StringTrimRight(StringReplace(StringRegExpReplace(StringRegExpReplace($tagInterface, "\w+\*", "ptr"), "\h*(\w+)\h*(\w+\*?)\h*(\((.*?)\))\h*(;|;*\z)", "$1\|$2;$4" & @LF), ";" & @LF, @LF), 1), "object", "idispatch"), "hresult", "long"), "bstr", "ptr"), "variant", "ptr"), @LF, 3)
    Local $iUbound = UBound($aMethods)
    Local $sMethod, $aSplit, $sNamePart, $aTagPart, $sTagPart, $sRet, $sParams, $hCallback
    ; Allocation
    $tInterface = DllStructCreate("int RefCount;int Size;ptr Object;ptr Methods[" & $iUbound & "];int_ptr Callbacks[" & $iUbound & "];ulong_ptr Slots[16]") ; 16 pointer sized elements more to create space for possible private props
    If @error Then Return SetError(1, 0, 0)
    For $i = 0 To $iUbound - 1
        $aSplit = StringSplit($aMethods[$i], "|", 2)
        If UBound($aSplit) <> 2 Then ReDim $aSplit[2]
        $sNamePart = $aSplit[0]
        $sTagPart = $aSplit[1]
        $sMethod = $sFunctionPrefix & $sNamePart
        If $fPrint Then
            Local $iPar = StringInStr($sTagPart, ";", 2), $t
            If $iPar Then
                $t = "Ret: " & StringLeft($sTagPart, $iPar - 1) & "  " & _
                        "Par: " & StringRight($sTagPart, StringLen($sTagPart) - $iPar)
            Else
                $t = "Ret: " & $sTagPart
            EndIf
            Local $s = "Func " & $sMethod & _
                    "( $pSelf ) ; " & $t & @CRLF & _
                    "EndFunc" & @CRLF
            ConsoleWrite($s)
        EndIf
        $aTagPart = StringSplit($sTagPart, ";", 2)
        $sRet = $aTagPart[0]
        $sParams = StringReplace($sTagPart, $sRet, "", 1)
        $sParams = "ptr" & $sParams
        $hCallback = DllCallbackRegister($sMethod, $sRet, $sParams)
        If @error Then
            ConsoleWrite('! ' & @error & ' ' & $sMethod & @CRLF & @CRLF)
        EndIf

        DllStructSetData($tInterface, "Methods", DllCallbackGetPtr($hCallback), $i + 1) ; save callback pointer
        DllStructSetData($tInterface, "Callbacks", $hCallback, $i + 1) ; save callback handle
    Next
    DllStructSetData($tInterface, "RefCount", 1) ; initial ref count is 1
    DllStructSetData($tInterface, "Size", $iUbound) ; number of interface methods
    DllStructSetData($tInterface, "Object", DllStructGetPtr($tInterface, "Methods")) ; Interface method pointers
    Return ObjCreateInterface(DllStructGetPtr($tInterface, "Object"), $sIID, $sInterface, $bIsUnknown) ; pointer that's wrapped into object
EndFunc   ;==>ObjectFromTag

; #FUNCTION# =============================================================================
; Name...........: __DeleteObjectFromTag
; ========================================================================================
Func __DeleteObjectFromTag( ByRef $tInterface )
    For $i = 1 To DllStructGetData( $tInterface, "Size" )
        DllCallbackFree( DllStructGetData( $tInterface, "Callbacks", $i ) )
    Next
    $tInterface = 0
EndFunc

; #FUNCTION# =============================================================================
; Name...........: com_error_handler
; ========================================================================================
Func com_error_handler($oError)
    With $oError
        ConsoleWrite(@CRLF & "COM ERROR DETECTED!" & @CRLF)
        ConsoleWrite("  Error ScriptLine....... " & .scriptline & @CRLF)
        ConsoleWrite("  Error Number........... " & "0x" & Hex(.number) & " (" & .number & ")" & @CRLF)
        ConsoleWrite("  Error WinDescription... " & StringStripWS(.windescription, $STR_STRIPTRAILING) & @CRLF)
        ConsoleWrite("  Error RetCode.......... " & "0x" & Hex(Number(.retcode)) & " (" & Number(.retcode) & ")" & @CRLF)
        ConsoleWrite("  Error Description...... " & StringStripWS(.description   , $STR_STRIPTRAILING) & @CRLF)
    EndWith
EndFunc

 

@Danyfirex 

1)  It's the right way to do it?
    calling OnReadyStateChange_Ready() from OnReadyStateChange_Invoke()

2)  And any suggestion to change Global $o_WHttpObj to Local
    or in other word how I pass $o_WHttpObj to OnReadyStateChange_Ready()

Edited by jugador
Link to comment
Share on other sites

1. It's right, You could even remove "Ready hresult();" and handle it  in invoke.

 

2. Maybe You could create a property in the object where you can store the Http object statically. No sure if it's possible it's just a mind.

 

Saludos

Link to comment
Share on other sites

  • 1 year later...

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...