Consume java web services in vb6 using winsock - vb6

I am sending data to webservice but it is getting failed with out of memory. So, is there any possibility to send data in chunks to the web service. Can I use winsock to consume webservice and upload data in chunks to the java rest service api?
I have tried multiple way like sending data with single byte array but everything got failed. Now the hope is on winsock, please help.
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", sUrl, False
.setRequestHeader "Authorization", "Basic " + enc
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" &
strBoundary
.send (sPostData)
Do
DoEvents
If .WinsockState = sckClosed Then
PostRequest = False
Exit Sub
End If
.send (StreamFile)
Loop Until m_bStreamFinished = True Or g_bAbortHTTP = True
response = .Status
End With
Expecting to use winsock to upload a file to java webservice but I am not able to do

Related

SecurityProtocolType.Tls12 in VB6

I want to establish a secure connection with my server which only supports TLS 1.2 and upwards.
I am adding the following line to my VB.NET applications to enable communication with my https server:
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
However, I also still have some VB6 apps which also need to use https server.
And the above line is not available for VB6, and the code throws "Error Occurred in the Secure Channel Support". If I use it on http instead of https, it works fine.
How could I achieve the same for VB6?
Thank you!
Btw, this is my code:
Public Function GetHTTPResponse(Byval uSomeInput) As String
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 'required in order to use https!!!
Dim nReq As Net.WebRequest = Net.WebRequest.Create("https://domain.xyz/answer.php")
nReq.Method = "Post"
nReq.ContentType = "application/x-www-form-urlencoded"
Dim nReqStream As IO.Stream = nReq.GetRequestStream()
Dim nASCIIEncoding As New System.Text.ASCIIEncoding
Dim btPostData As Byte() = Nothing
btPostData = nASCIIEncoding.GetBytes("&MyPHPInput=" & uSomeInput)
nReqStream.Write(btPostData, 0, btPostData.Length)
nReqStream.Close()
Dim reader As New IO.StreamReader(nReq.GetResponse().GetResponseStream())
Dim sRet As String = reader.ReadToEnd
Return sRet
End Function
And this is the same code in VB6, but in VB6, I can't (to my knowledge) not set the Tls12 security protocol:
Public Function GetHTTPResponse(ByVal uSomeInput) As String
'How do I set Tls12 protocol here??
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "POST", "https://domain.xyz", False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded" & VBA.Chr(10) & VBA.Chr(13)
xmlhttp.Send pConvertStringToByte("https://domain.xyz/answer.php?MyPHPInput=" & uSomeInput)
GetHTTPResponse = xmlhttp.responseText
End Function
Edit:
I have followed the advice to try using WinHttp.WinHttpRequest.5.1 instead as discussed here.
It seems to work, but for some reason, the variables are not being transferred / recognized by the script, while they were recognized with my old approach using MSXML2.ServerXMLHTTP.
This is my code:
Public Function GetHTTPResponse(ByVal uSomeInput) As String
Dim xmlhttp As Object
Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
'force TLS 1.2
xmlhttp.Option(9) = 2048
xmlhttp.Option(6) = True
xmlhttp.Open "POST", "https://domain.xyz", False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded" & VBA.Chr(10) & VBA.Chr(13)
xmlhttp.Send pConvertStringToByte("https://domain.xyz/answer.php?MyPHPInput=" & uSomeInput)
GetHTTPResponse = xmlhttp.responseText
End Function
Does anybody see why my old byte array is not accepted for "WinHttp.WinHttpRequest.5.1" while it work for "MSXML2.ServerXMLHTTP"?
Try this one:
' Define uSomeInput's data type, otherwise it's passed as a Variant, which might or might not be what we intended
Public Function GetHTTPResponse(ByVal uSomeInput As String) As String
' Use early instead of late binding
Dim xmlhttp As WinHttp.WinHttpRequest
Set xmlhttp = New WinHttpRequest
' force TLS 1.2
xmlhttp.Option(9) = 2048
xmlhttp.Option(6) = True
xmlhttp.Open "POST", "https://domain.xyz", False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded" & vbNewLine
' Let the webserver know the size of the data
xmlhttp.SetRequestHeader "Content-Length", CStr(LenB(uSomeInput)) & vbNewLine
xmlhttp.Send pConvertStringToByte("https://domain.xyz/answer.php?MyPHPInput=" & uSomeInput)
' Not sure why the string to byte array conversion is necessary
' Could just try the string as well
xmlhttp.Send "https://domain.xyz/answer.php?MyPHPInput=" & uSomeInput
GetHTTPResponse = xmlhttp.ResponseText
End Function
If everything else fails and you require a VB6 solution and therefore are willing (or forced) to spend money ($ 395) on a commercial component, have a look at SocketTools. Although tempting, I suggest taking the Library over the ActiveX edition (which is just a wrapper of the former, IMHO). I've used SocketTools in VB6 with great success in the past (since its 6.x version, IIRC). I started using it, because I faced a very similar task to yours: I had to support SFTP transfer in my VB6 application.

Using variables with setRequestHeader, why won't they work?

Edit: Problem is solved. For some reason the Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
I'm trying to send JSON to a remote server in order to get back a JSON response (Basically I send them data, they perform calculations based on my data and send back different data). However instead of getting data back the server tells me the request failed authentication.
The Authentication involves sending a base64 encoded string, username, and password combined. These values can change so I'm using variables to pass the information on. This does not work, however if I enter the fully encoded value as a string it does work.
Function GetAPdataPost(sSendHTML, sURL)
dim apHTTP
dim sHTTPResponse
dim API_KEY
dim API_PWD
dim auth
API_KEY = "fred"
API_PWD = "barney"
auth = Base64Encode(API_KEY & ":" & API_PWD)
Set apHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
apHTTP.Open "POST", sURL, false
apHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
apHTTP.setRequestHeader "Authorization","Basic ZnJlZDpiYXJuZXk=" '<-- works
apHTTP.setRequestHeader "Authorization", "Basic " & auth '<-- doesn't work
apHTTP.setRequestHeader "Content-Length", len(sSendHTML)
apHTTP.setRequestHeader "Accept", "*/*"
apHTTP.setRequestHeader "Account-Number", "00000004"
apHTTP.setRequestHeader "Cache-Control", "no-cache"
apHTTP.setRequestHeader "Connection", "close"
On Error Resume Next
apHTTP.send sSendHTML
sHTTPResponse = apHTTP.responseText
If Err.Number = 0 Then
GetAPdataPost = sHTTPResponse
Else
GetAPdataPost = "Something went wrong: " & Err.Number
End If
On Error Goto 0
Set apHTTP = Nothing
End Function
Using the first line result in a proper response form the server, a valid JSON string with all the required data. The second line results in a JSON string saying "The request failed authentication".
So aside from typing out the Base64 encoded string how do I get a variable to be recognised as a valid string?
I should just note that I have tried surrounding auth with double quotes ("") and Chr(34) to no avail.
Edit: Base64 Encode function.
Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.nodeTypedValue =Stream_StringToBinary(sText)
Base64Encode = oNode.text
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.CharSet = "us-ascii"
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
The Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
Always remember to look at the raw data, not just the displayed data (i.e. not like me)

How can a ServerXMLHTTP GET request hang?

I have a VBS that makes a large number of GET requests using a ServerXMLHTTP object:
SET xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.setTimeouts 5000, 5000, 10000, 120000 'ms - resolve, connect, send, receive
...
' Now do the following for lots of different GetURLs:
xmlhttp.open "GET", GetURL, false
xmlhttp.setRequestHeader "Content-type","text/xml"
xmlhttp.setRequestHeader "Accept","text/csv"
xmlhttp.send "{}"
WScript.Echo "Readystate = " & xmlhttp.readyState & " at " & Now()
IF xmlhttp.readyState <> 4 THEN
xmlhttp.waitForResponse 1
END IF
WScript.Echo "Readystate = " & xmlhttp.readyState & " at " & Now()
I've found cases where the script never gets past xmlhttp.send unless I run it asynchronously (i.e., using xmlhttp.open "GET", GetURL, true).
My understanding is that it should time-out, per the setTimeouts, and move ahead even when run synchronously. So what could be going on? (Based on reading so far it sounds like "a lot," but documentation on this is murky at best...)

Post data with https does not get processed at Server side

I am having a VBScript which gets invoked from a 3rd party application, the script gets the data from the 3rd party application and opens the URL in an IE browser by passing the data in POST format. The script works fine when I use http as the protocol but the moment I use https, the server side code (request.getParameter("param1")) complains that it is not able to find the parameter in the request object. The script is called by passing the URL and the data. e.g. run.vbs https://xyz.com?param1=1234. Following is the vbscript for your kind perusal. Can you please let me know what I am missing when I am using https as the protocol. Any help is highly appreciated. Many thanks.
If WScript.Arguments.Count = 1 Then
uri = WScript.Arguments.Item(0)
'WScript.Echo "Arguments " & uri
Set WshNetwork = WScript.CreateObject("WScript.Network")
'WScript.Echo "Current User Name: " & WshNetwork.UserName
filename="C:\Documents and Settings\"+WshNetwork.UserName+"\Application Data\XYZ\Profiles\default\Settings.xml"
'WScript.Echo "Current User fileName: " & filename
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename)
strQuery = "Agent"
Set colItem = xmlDoc.getElementsByTagname(strQuery)
For Each objItem in colItem
Agentid = objItem.getAttribute("Login")
'MsgBox "AgentId = " + AgentID
Next
'uri = uri+"^&agentid="+Agentid
uri = uri+"&agentid="+Agentid
pos = InStr(uri,"?")
extracteduri = Mid(uri,1,pos-1)
params = Mid(uri, pos+1)
postdata = Str2Bytes(params,"us-ascii")
header = "Content-Type: application/x-www-form-urlencoded"
Set IE = CreateObject("InternetExplorer.Application")
'IE.Navigate "about:blank"
'IE.AddressBar = True
'IE.ToolBar = True
'IE.StatusBar = True
IE.Visible = True
'WScript.Sleep 2000
Set shl = WScript.CreateObject("WScript.Shell")
shl.SendKeys "% X"
IE.Navigate extracteduri, Nothing, Nothing, postdata, header
Wscript.Quit
Else
Wscript.Echo "Usage: RunURL.vbs <URL to invoke>"
Wscript.Quit
End If
Function Str2Bytes(Text, CharSet)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
If Len(CharSet) > 0 Then
BinaryStream.CharSet = CharSet
Else
BinaryStream.CharSet = "us-ascii"
End If
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Str2Bytes = BinaryStream.Read
End Function
I am now using the below function to get the response from the server using https as the protocol and POST as the format but still the server is not able to see the parameter
Set req = CreateObject("MSXML2.ServerXMLHTTP")
'Set the below option to get rid of the "Certificate authority is invalid or
'incorrect, error code - 80072F0D" error
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
encodedParams = Escape(params)
WScript.Echo "encodedParams: " & encodedParams
req.send encodedParams
WScript.Echo "req.responseText: " & req.responseText
Below are the encoded parameters
uui%3DU1%3D123456%26agentid%3D123456
The server still complains that the parameter is missing from the request object.
I am using the same script (XMLHTTP request) but I am encrypting the parameters using the Str2Bytes function (declared above)
Set req = CreateObject("MSXML2.ServerXMLHTTP")
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
req.send postdata
WScript.Echo "req.responseText: " & req.responseText
I'd recommend using an XMLHTTPRequest instead of the Internet Explorer COM object. See here for an example. Note that you must encode special characters in the post data.
However, if you want to open the URL in IE anyway, you'd probably better stick with your original approach. In that case I'd check the server for more information about why the server side thinks it cannot find the parameter. Does the request even have a parameter named "param1"?

"Run-time Error, data for this operation is not usable yet" message from my VB6 program

Private Sub Command1_Click()
Dim dom As New DOMDocument
Dim http As New XMLHTTP
Dim strRet As String
If Not dom.Load("c:\\CH.xml") Then MsgBox "文件不存在"
http.Open "Post", "http://172.31.132.173/u8eai/import.asp", True '指定服务器ASP
http.send dom.xml '把xml数据发送服务器端
strRet = http.responseText 'strRet:返回的xml格式的回执信息
MsgBox strRet
End Sub
The error message, in Chinese:
实时错误
完成该操作所需的数据还不可使用.
translated by google(To English):
Real-time error
The data needed to complete the operation can not be used also
("实时错误 完成该操作所需的数据还不可使用" means "Run-time Error, data for this operation is not usable yet.")
The problem is you're issuing the HTTP request as asynchronous
http.Open "Post", "http://172.31.132.173/u8eai/import.asp", True
which means the send method will return immediately even before the server responses.
http.send dom.xml
but before the server responses you're asking the responseText value already. Of course this will cause the runtime error.
strRet = http.responseText
One workaround is to issue a synchronous request, i.e. change the 3rd parameter of http.open to False. A better method is set a handler of http's to handle the readyStateChange event (consult the doc for detail).

Resources