A problem with MSXML is that the bonehead parts of it were optimized for use from JScript. As a result you have to simulate JScript event binding in VB6.
Form1.frm
Code:
Option Explicit
Private HTTP As MSXML2.XMLHTTP60
Private WithEvents SinkRSChange As SinkRSChange
Private Sub Form_Load()
Set HTTP = New MSXML2.XMLHTTP60
Set SinkRSChange = New SinkRSChange
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub mnuGo_Click()
With HTTP
.open "GET", "https://www.google.com/", True
.onreadystatechange = SinkRSChange
Text1.Text = "Starting async GET" & vbNewLine
.send
End With
End Sub
Private Sub SinkRSChange_onreadystatechange()
With HTTP
Text1.Text = Text1.Text & vbNewLine & "readyState = " & CStr(.readyState)
If .readyState = 4 Then
Text1.Text = Text1.Text _
& vbNewLine & vbNewLine _
& CStr(.Status) & " " & .statusText _
& vbNewLine & vbNewLine _
& .responseText
End If
End With
End Sub
SinkRSChange.cls
Code:
Option Explicit
Public Event onreadystatechange()
'Mark as default member via Tools|Procedure Attributes... dialog.
Public Sub RSChange()
RaiseEvent onreadystatechange
End Sub
A problem with MSXML is that the bonehead parts of it were optimized for use from JScript. As a result you have to simulate JScript event binding in VB6.
Form1.frm
Code:
Option Explicit
Private HTTP As MSXML2.XMLHTTP60
Private WithEvents SinkRSChange As SinkRSChange
Private Sub Form_Load()
Set HTTP = New MSXML2.XMLHTTP60
Set SinkRSChange = New SinkRSChange
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub mnuGo_Click()
With HTTP
.open "GET", "https://www.google.com/", True
.onreadystatechange = SinkRSChange
Text1.Text = "Starting async GET" & vbNewLine
.send
End With
End Sub
Private Sub SinkRSChange_onreadystatechange()
With HTTP
Text1.Text = Text1.Text & vbNewLine & "readyState = " & CStr(.readyState)
If .readyState = 4 Then
Text1.Text = Text1.Text _
& vbNewLine & vbNewLine _
& CStr(.Status) & " " & .statusText _
& vbNewLine & vbNewLine _
& .responseText
End If
End With
End Sub
SinkRSChange.cls
Code:
Option Explicit
Public Event onreadystatechange()
'Mark as default member via Tools|Procedure Attributes... dialog.
Public Sub RSChange()
RaiseEvent onreadystatechange
End Sub
could you please send me the whole project in archive like zip
because i tried your code and code error at line; WithEvents SinkRSChange As SinkRSChange, it shows user defined type not defined
and also the procedure attribute part i dont know how to do it
thanks alot
you can use winhttprequest 5.1,so you you can remove xmlhttp object
with winhttp i cant post cookies, my goal is to make a post request using cookies
only with xmlhttp i was able to obtain cookies, now i just need to post them
please help me
thank you
A problem with MSXML is that the bonehead parts of it were optimized for use from JScript. As a result you have to simulate JScript event binding in VB6.
Form1.frm
Code:
Option Explicit
Private HTTP As MSXML2.XMLHTTP60
Private WithEvents SinkRSChange As SinkRSChange
Private Sub Form_Load()
Set HTTP = New MSXML2.XMLHTTP60
Set SinkRSChange = New SinkRSChange
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub mnuGo_Click()
With HTTP
.open "GET", "https://www.google.com/", True
.onreadystatechange = SinkRSChange
Text1.Text = "Starting async GET" & vbNewLine
.send
End With
End Sub
Private Sub SinkRSChange_onreadystatechange()
With HTTP
Text1.Text = Text1.Text & vbNewLine & "readyState = " & CStr(.readyState)
If .readyState = 4 Then
Text1.Text = Text1.Text _
& vbNewLine & vbNewLine _
& CStr(.Status) & " " & .statusText _
& vbNewLine & vbNewLine _
& .responseText
End If
End With
End Sub
SinkRSChange.cls
Code:
Option Explicit
Public Event onreadystatechange()
'Mark as default member via Tools|Procedure Attributes... dialog.
Public Sub RSChange()
RaiseEvent onreadystatechange
End Sub
I have found your post while searching how to use the "OnReadyStateChange" property. However I wanted to start multiple HTTP requests asynchronously and this approach using "withevents" with a "wrapper" class doesn't allow for that. I have modified the code slightly and now it works with an array of HTTP objects and their corresponding array of "SinkRSChange" classes:
frmRSChange.frm
Code:
Option Explicit
Implements IRSSinkEvents
Private HTTP() As MSXML2.XMLHTTP60, SinkRSChange() As clsSinkRSChange, sURL() As String
Private Sub Form_Load()
Dim i As Long
ReDim HTTP(0 To 2): ReDim SinkRSChange(0 To 2): ReDim sURL(0 To 2)
sURL(0) = "https://www.microsoft.com"
sURL(1) = "https://www.apple.com"
sURL(2) = "https://www.amazon.com"
For i = LBound(HTTP) To UBound(HTTP)
Set HTTP(i) = New MSXML2.XMLHTTP60
Set SinkRSChange(i) = New clsSinkRSChange
Set SinkRSChange(i).Callback(i) = Me
Next i
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
txtRSChange.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub mnuGo_Click()
Dim i As Long
For i = LBound(HTTP) To UBound(HTTP)
With HTTP(i)
.open "GET", sURL(i), True
.OnReadyStateChange = SinkRSChange(i)
txtRSChange.Text = txtRSChange.Text & sURL(i) & " - starting async GET" & vbNewLine
.send
End With
Next i
End Sub
Private Sub IRSSinkEvents_OnReadyStateChange(Index As Long)
With HTTP(Index)
txtRSChange.Text = txtRSChange.Text & vbNewLine & sURL(Index) & " - readyState = " & .readyState
If .readyState = 4 Then
txtRSChange.Text = txtRSChange.Text & vbNewLine & vbNewLine & .Status & " " & .statusText & vbNewLine & vbNewLine & Left$(.responseText, 2000)
End If
End With
End Sub
clsSinkRSChange.cls
Code:
Option Explicit
Private m_Index As Long, m_Callback As IRSSinkEvents
Public Property Get Callback(Optional Index As Long) As IRSSinkEvents
Index = m_Index
Set Callback = m_Callback
End Property
Public Property Set Callback(Index As Long, objCallback As IRSSinkEvents)
m_Index = Index
Set m_Callback = objCallback
End Property
Public Sub ReadyStateChange()
If Not (m_Callback Is Nothing) Then m_Callback.OnReadyStateChange m_Index
End Sub
IRSSinkEvents.cls
Code:
Option Explicit
Public Sub OnReadyStateChange(Index As Long)
End Sub
Now a single "OnReadyStateChange" event can report the state of many HTTP requests!
Hey mate, thanks for that link, I like that approach as well! I guess there is more than one way to skin a cat, haha! That code seems to be using "WinHttpRequest" which exposes its own events as opposed to the simpler "XMLHTTP60" which doesn't have any events and exposes only the crummy "OnReadyStateChange" property. To be honest I am on the fence which of these two methods is better... Are there any obvious advantages/disadvantages to either of them?
Just found out how to "gut" WinHttpRequest internal HINTERNET handles so that these can be manipulated further with WinHttpSetOption API function, for instance allowing gzip decompression from response, etc.
Code:
Option Explicit
Private Const WINHTTP_OPTION_HANDLE_TYPE As Long = 9
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function WinHttpQueryOption Lib "WinHttp" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As Any, lpdwBufferLength As Long) As Long
Private Sub Form_Load()
Dim oHttp As WinHttpRequest
Dim hConnect As Long
Dim hRequest As Long
Dim hSession As Long
Dim lType As Long
Set oHttp = New WinHttpRequest
oHttp.Open "GET", "https://vbforums.com"
hConnect = Peek(ObjPtr(oHttp) + &H30)
hRequest = Peek(ObjPtr(oHttp) + &H34)
hSession = Peek(ObjPtr(oHttp) + &H38)
If WinHttpQueryOption(hConnect, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hConnect=" & Hex$(hConnect), lType
End If
If WinHttpQueryOption(hRequest, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hRequest=" & Hex$(hRequest), lType
End If
If WinHttpQueryOption(hSession, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hSession=" & Hex$(hSession), lType
End If
End Sub
Private Function Peek(ByVal lPtr As Long) As Long
Call CopyMemory(Peek, ByVal lPtr, 4)
End Function
Check out the Option flags documentation for possible useful extra settings available which are not exposed by WinHttpRequest object's Option property.
The offsets into the internal instance state -- &H30, &H34 and &H38 -- work on XP to Win11 so leaving this here for posterity. (Search these forums for "WinHttpQueryOption" or "WinHttpSetOption" keywords -- these API functions have never been mentioned here before apparently.)
Just found out how to "gut" WinHttpRequest internal HINTERNET handles so that these can be manipulated further with WinHttpSetOption API function, for instance allowing gzip decompression from response, etc.
Code:
Option Explicit
Private Const WINHTTP_OPTION_HANDLE_TYPE As Long = 9
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function WinHttpQueryOption Lib "WinHttp" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As Any, lpdwBufferLength As Long) As Long
Private Sub Form_Load()
Dim oHttp As WinHttpRequest
Dim hConnect As Long
Dim hRequest As Long
Dim hSession As Long
Dim lType As Long
Set oHttp = New WinHttpRequest
oHttp.Open "GET", "https://vbforums.com"
hConnect = Peek(ObjPtr(oHttp) + &H30)
hRequest = Peek(ObjPtr(oHttp) + &H34)
hSession = Peek(ObjPtr(oHttp) + &H38)
If WinHttpQueryOption(hConnect, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hConnect=" & Hex$(hConnect), lType
End If
If WinHttpQueryOption(hRequest, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hRequest=" & Hex$(hRequest), lType
End If
If WinHttpQueryOption(hSession, WINHTTP_OPTION_HANDLE_TYPE, lType, 4) <> 0 Then
Debug.Print "hSession=" & Hex$(hSession), lType
End If
End Sub
Private Function Peek(ByVal lPtr As Long) As Long
Call CopyMemory(Peek, ByVal lPtr, 4)
End Function
Check out the Option flags documentation for possible useful extra settings available which are not exposed by WinHttpRequest object's Option property.
The offsets into the internal instance state -- &H30, &H34 and &H38 -- work on XP to Win11 so leaving this here for posterity. (Search these forums for "WinHttpQueryOption" or "WinHttpSetOption" keywords -- these API functions have never been mentioned here before apparently.)
cheers,
</wqw>
Is there any difference between api Winhttpsetoption and winhttp.Option