Request.BinaryRead(Request.TotalBytes) throws error for large files - asp-classic

I have code that accepts binary data via POST and reads in an array of bytes. For files larger than 200 Kb, the operation fails. I've checked with my sysadmin (we're running IIS 7) to see if there was a limit in our configuration and he says there is none, and suspects it is a problem with the code. Does anybody here see any potential problems? Here is my code:
Public Sub Initialize
If Request.TotalBytes > 0 Then
Dim binData
binData = Request.BinaryRead(Request.TotalBytes) ' This line fails'
getData binData
End If
End Sub
Private Sub getData(rawData)
Dim separator
separator = MidB(rawData, 1, InstrB(1, rawData, ChrB(13)) - 1)
Dim lenSeparator
lenSeparator = LenB(separator)
Dim currentPos
currentPos = 1
Dim inStrByte
inStrByte = 1
Dim value, mValue
Dim tempValue
tempValue = ""
While inStrByte > 0
inStrByte = InStrB(currentPos, rawData, separator)
mValue = inStrByte - currentPos
If mValue > 1 Then
value = MidB(rawData, currentPos, mValue)
Dim begPos, endPos, midValue, nValue
Dim intDict
Set intDict = Server.CreateObject("Scripting.Dictionary")
begPos = 1 + InStrB(1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
nValue = endPos
Dim nameN
nameN = MidB(value, begPos, endPos - begPos)
Dim nameValue, isValid
isValid = True
If InStrB(1, value, stringToByte("Content-Type")) > 1 Then
begPos = 1 + InStrB(endPos + 1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
If endPos = 0 Then
endPos = begPos + 1
isValid = False
End If
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "FileName", trim(byteToString(midValue))
begPos = 14 + InStrB(endPos + 1, value, stringToByte("Content-Type:"))
endPos = InStrB(begPos, value, ChrB(13))
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "ContentType", trim(byteToString(midValue))
begPos = endPos + 4
endPos = LenB(value)
nameValue = MidB(value, begPos, ((endPos - begPos) - 1))
Else
nameValue = trim(byteToString(MidB(value, nValue + 5)))
End If
If isValid = True Then
intDict.Add "Value", nameValue
intDict.Add "Name", nameN
dict.Add byteToString(nameN), intDict
End If
End If
currentPos = lenSeparator + inStrByte
Wend
End Sub
Here is the error that appears in the logs:
Log Name: Application
Source: Active Server Pages
Date: 11/11/2010 2:15:35 PM
Event ID: 5
Task Category: None
Level: Error
Keywords: Classic
User: N/A
Computer: xxxxx.xxxxx.xxx
Description:
Error: File /path-to-file/loader.asp Line 36 Operation not Allowed. .
Event Xml:
<Event xmlns="http://schemas.microsoft.com/win/2004/08/events/event">
<System>
<Provider Name="Active Server Pages" />
<EventID Qualifiers="49152">5</EventID>
<Level>2</Level>
<Task>0</Task>
<Keywords>0x80000000000000</Keywords>
<TimeCreated SystemTime="2010-11-11T19:15:35.000Z" />
<EventRecordID>19323</EventRecordID>
<Channel>Application</Channel>
<Computer>PHSWEB524.partners.org</Computer>
<Security />
</System>
<EventData>
<Data>File /mghdev/loader.asp Line 36 Operation not Allowed. </Data>
</EventData>
</Event>

By default the limit for the entity size in a POST request is 200K, hence your error.
You can increase that limit open IIS Manager and navigate the tree to your application. Double click the "ASP" icon in the main panel. Expand the "Limits" category. Modify the "Maximum Requesting Entity Body Limit" to a larger value.
If this is for a public web-site be careful as to the limit you set, the purpose of the limit is to prevent malicious POSTs overwhelming the site.

If you read the specifications of the BinaryRead method, you will see that the parameter is actually an out parameter as well. The BinaryRead method is trying to change the value of Request.TotalBytes which it can't do. TotalBytes is read-only.
You can easily fix this by assigning TotalBytes to a variable and passing that in instead. This is what the example code shows in the MSDN documentation.
If the BinaryRead read a different amount of data, the variable will reflect the size of the read.

Two Settings are required in IIS under the "Limit Properties" section
1- Maximum Requesting Entity Body Limit (please not that it is in bytes). You have to set the value according to your maximum file size e-g- 40MB(40000000 bytes).
2)- Script Time-out . Its default value is "00:01:30: which is 90 seconds. Increase it according to the time required by your code to run. I set it to 5 minutes and it solved the problem.

Related

Issue with migration using classic ASP

Having a problem with migration of a site from one server to another, here is the error I'm getting:
Microsoft Cursor Engine error '80040e21'
Multiple-step operation generated errors. Check each status value.
/common/classes/Cart.asp, line 110
Line 110 is:
fld.Value = Request(fld.Name)
Here is the code that's causing the issue:
public function InsertOrder
set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
fld.Value = Request(fld.Name)
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)
end function
It used to use SQL2008 but the new server us running SQL2016.
Thanks for any ideas you can give.
Judging from the code causing this error, this is most likely a problem with type casting behind the scenes. Somehow the database driver fails to properly convert the data to the proper type, so you have to do that yourself.
One way which is pretty flexible, is defining key/value pairs (VBScript Dictionary can fit in this case) where the key will be the field name, and the value will be the type to which to convert the value. (String, Integer, Double, Date)
Sample code would be: (untested, but should work as-is, provided you put correct details)
Const FIELD_TYPE_STRING = 1
Const FIELD_TYPE_INTEGER = 2
Const FIELD_TYPE_DOUBLE = 3
Const FIELD_TYPE_DATE = 4
Const FIELD_TYPE_CURRENCY = 5
Function ConverFieldValue(rawValue, fieldType)
ConverFieldValue = VBNull
Select Case fieldType
Case FIELD_TYPE_STRING:
ConverFieldValue = CStr(rawValue)
Case FIELD_TYPE_INTEGER:
If rawValue<>"" Then ConverFieldValue = CLng(rawValue)
Case FIELD_TYPE_DOUBLE
If rawValue<>"" Then ConverFieldValue = CDbl(rawValue):
Case FIELD_TYPE_DATE:
If rawValue<>"" Then ConverFieldValue = CDate(rawValue)
Case FIELD_TYPE_CURRENCY:
If rawValue<>"" Then ConverFieldValue = CCur(rawValue)
End Select
End Function
Dim typeMapping
Set typeMapping = Server.CreateObject("Scripting.Dictionary")
'''***Add actual field names and types below:****
typeMapping.Add "Field1", FIELD_TYPE_STRING
typeMapping.Add "Field2", FIELD_TYPE_INTEGER
typeMapping.Add "Field3", FIELD_TYPE_DOUBLE
typeMapping.Add "Field4", FIELD_TYPE_CURRENCY
typeMapping.Add "Field5", FIELD_TYPE_DATE
'''*************************************************
Dim currentFieldType, currentFieldValue
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
currentFieldType = typeMapping(fld.Name)
currentFieldValue = ConverFieldValue(Request(fld.Name), currentFieldType)
fld.Value = currentFieldValue
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)

Classic ASP Base64, image/png -> save as image

This particular question has been asked and answered, but no matter what I try I cannot get this to work. At this point I'm somewhat ready to toss my computer out the window..
No matter what combinations i try, it still fails at:
oStream.write imagebinarydata
Here is the code with comments:
sFileName = Server.MapPath("grafer/test.png")
ByteArray = Request.Form("imageData")
ByteArray = [DATA-URI String] 'This string shows the image perfectly fine, in an image tag in the top of the page so it should be perfectly ok?
response.write ("Decoded: " & Base64Decode(ByteArray)) '<- Writes 'PNG' ?
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Set oStream = Server.CreateObject("ADODB.Stream")
oStream.type = adTypeBinary
oStream.open
imagebinarydata = Base64Decode(ByteArray)
oStream.write imagebinarydata '<- FAILS
'Error:
'ADODB.Stream error '800a0bb9'
'Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
'Use this form to overwrite a file if it already exists
oStream.savetofile sFileName, adSaveCreateOverWrite
oStream.close
set oStream = nothing
response.write("success")
Function Base64Decode(ByVal vCode)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.text = vCode
Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_BinaryToString(Binary)
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 = adTypeBinary
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.Write Binary
'Change stream type To binary
BinaryStream.Position = 0
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 get binary data from the object
Stream_BinaryToString = BinaryStream.ReadText
End Function
If you are trying to save you can use this function
function SaveToBase64 (base64String)
ImageFileName = "test.jpg"
Set Doc = Server.CreateObject("MSXML2.DomDocument")
Set nodeB64 = Doc.CreateElement("b64")
nodeB64.DataType = "bin.base64"
nodeB64.Text = Mid(base64String, InStr(base64String, ",") + 1)
dim bStream
set bStream = server.CreateObject("ADODB.stream")
bStream.type = 1
bStream.Open()
bStream.Write( nodeB64.NodeTypedValue )
bStream.SaveToFile(Server.Mappath("Images/" & ImageFileName), 2 )
bStream.close()
set bStream = nothing
end function

aspx.vb cookie value accessing and updating

I am coding an ASP application where a users data will be stored in a cookie(that expires in 24 hours) and when the program is run, it is supposed to search that cookie, and add whatever was in the cookie to the current users value, then proceed through the code.
Dim I As Integer ' iterator for cookie search
Dim foundcookie As Boolean = False ' flag if cookie found
Dim stakenow As Integer ' current stake held here
stakenow = stake.Text
Dim currentname As String
currentname = name.Text
For I = 0 To Request.Cookies.Count - 1
If Request.Cookies.Item(I).Name = currentname Then
foundcookie = True
stakenow = stakenow + Request.Cookies.Item(I).Value
currentstake.Text = currentstake.Text + stakenow.ToString
Request.Cookies.Item(I).Value = stakenow.ToString
Request.Cookies.Item(I).Expires = DateTime.Now.AddHours(24)
End If
Next
If Not foundcookie Then
Dim nameCookie As New HttpCookie(currentname)
nameCookie.Value = stakenow.ToString
nameCookie.Expires = DateTime.Now.AddHours(24)
Response.Cookies.Add(nameCookie)
currentstake.Text = currentstake.Text + stakenow.ToString
End If
This code works, the first time, it creates a cookie with a value, say 150. Then the next time the code is run and the users "stake" that they entered was 150 again, the current stake updates to 300. However the 3rd time run, if the user enters 100, we would want the users stake now to be 400, however is is only 250. I see this error is coming from the updated value not being correctly written back to the cookie, thus the addition only coming from the original value when the cookie was created, and the typed value. I have tried using request and response cookies and have had no luck. Any suggestions?
Use the HttpCookieCollection.Set Method so that the updated cookie gets back to the client:
If Request.Cookies.Item(I).Name = currentname Then
foundcookie = True
stakenow = stakenow + Request.Cookies.Item(I).Value
currentstake.Text = currentstake.Text + stakenow.ToString
Dim objCookie As HttpCookie = Request.Cookies.Item(I)
objCookie.Value = stakenow.ToString()
objCookie.Expires = DateTime.Now.AddHours(24)
HttpContext.Current.Response.Cookies.Set(objCookie)
End If

classic asp calling an api using addheader for authorization

I have a page that calls an api that in test mode has not required any authorization.
We are now moving to a live environment where a username and password will be required.
The api provider has sent the following message:
To access these services please send the requests by adding following HTTP header.
Authorization: Basic Base64Encode(“username: password”)
I'm not sure of the correct syntax and wondered if someone could help me out.
The original call (and working perfectly) is:
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.DOMDocument.3.0")
xmlobj.async = false
xmlobj.setProperty "ServerHTTPRequest", True
xmlObj.AddHeader "Authorization", "Basic", Base64Encode(username & ":" & password)
xmlobj.load(sUrl)
The above code throws an error
/api-test.asp |20|800a000d|Type_mismatch:_'Base64Encode'
Any help would be greatly appreciated.
Like I've mentioned in the comments, the syntax for the Authorization header is incorrect.
The API example doesn't expect "Base64Encode('username','password')" this is an example supplied by the API to show you how to take the string "username:password" and Base64 encode it which is what the Authorization header is expecting.
But you still need to have the Base64Encode() function definition for the code to work.
Base64Encode() and MyASC() functions are taken from Base64 encode VBS function (vb encoder algorithm), source code
Something like this should work;
<%
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.XMLHTTP.3.0")
xmlobj.Open "GET", sUrl, False
xmlobj.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & password)
xmlobj.Send
Dim xmldoc
If xmlobj.status = 200 Then
Set xmldoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
xmldoc.Load xmlobj.ResponseXML
Else
Response.Write "An error occurred!"
End If
%>

Invalid procedure call or argument: 'Mid'

I have a function (see below) and it works perfectly. I recently moved my code to another server and i did not change anything in it. It fails to run on new server.
Microsoft VBScript runtime error '800a0005'
Invalid procedure call or argument: 'Mid'
/calculate.asp, line 416
When i checked the line 416, i got this:
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
and this is the complete function:
<%
Function xyz()
Dim o3: Set o3 = Server.CreateObject("MSXML2.ServerXMLHTTP")
Dim o_date3: o_date3 = split(EndingDate, ".")
Dim s_date3
If (Len(o_date3(2)) = 4) Then
s_date3 = o_date3(2)
Else
s_date3 = "20" & o_date3(2)
End If
If (Len(o_date3(1)) = 2) Then
s_date3 = s_date3 & o_date3(1)
Else
s_date3 = s_date3 & "0" & o_date3(1)
End If
If (Len(o_date3(0)) = 2) Then
s_date3 = s_date3 & o_date3(0)
Else
s_date3 = s_date3 & "0" & o_date3(0)
End If
Dim s3: s3 = "<soapenv:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:urn=""urn:AntTransferWSIntf-IAntTransferWS""><soapenv:Header/><soapenv:Body><urn:EURCurrency soapenv:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/""><DateStr xsi:type=""xsd:string"">" + s_date3 + "</DateStr></urn:EURCurrency></soapenv:Body></soapenv:Envelope>"
o3.Open "POST", serviceUrl, False
o3.setRequestHeader "Content-Type", "text/xml"
o3.setRequestHeader "Connection", "close"
o3.setRequestHeader "SOAPAction", " "
o3.send s3
Dim hataVarMiBasla3: hataVarMiBasla3 = (InStr(1, o3.responseText, "<faultstring>", vbTextCompare)) + 13
If (hataVarMiBasla3 > 13) Then
Dim hataVarMiBitir3: hataVarMiBitir3 = (InStr(1, o3.responseText, "</faultstring>", vbTextCompare)) - hataVarMiBasla3
Dim hata3: hata3 = Mid(o3.responseText, hataVarMiBasla3, hataVarMiBitir3)
KurGetir = hata3
Else
Dim Basla3: Basla3 = (InStr(1, o3.responseText, """xsd:double"">", vbTextCompare)) + 13
Dim Bitir3: Bitir3 = (InStr(1, o3.responseText, "</return>", vbTextCompare)) - Basla3
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
xyz = CDbl(Replace(result3, ".", mstrComma))
End If
Set o3 = Nothing
End Function
%>
Why am i receiving this error?
Mid struct from MSDN
Mid(string, start[, length])
Not official reference but according to my experience, you get that error if
start is less than or equal to zero.
length is less than zero (if it is not missed in the Mid call)
Have a look at the error line and related ones.
Dim Basla3: Basla3 = (InStr(1, o3.responseText, """xsd:double"">", vbTextCompare)) + 13
Dim Bitir3: Bitir3 = (InStr(1, o3.responseText, "</return>", vbTextCompare)) - Basla3
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
Lets suppose o3.responseText is empty because your code does not check whether the response is empty.
Basla3 can not be less than 13 according to InStr() + 13, so it's not the problem.
However it seems like Bitir3 can be less then zero according to InStr() - Basla3 (Basla3 evaluated as 13).
Continuing with the assumption, (InStr(1, o3.responseText, "</return>", vbTextCompare)) evaluated as 0, then with - Basla3 it will be evaluated as -13. Tada! rule 2 violated, length cannot be less than zero.
The problem with your code is, there is no check response length nor response status.
If the response is empty, consider the following:
Your new server may have connectivity problems unlike the old one.
The API which you have is authorized for the old server's IP address only.
In a nutshell, you should optimize the code and be sure that there is an xml response.
At least use something like that:
o3.Send
If o3.readyState = 4 And o3.status = 200 Then
If Len(o3.responseText) > 0 Then
'response is ready to parse
Else
'response status is ok but empty
End If
Else
'request failed
End If
BTW, due to your request is a soap call, I'd highly recommend done the job by parsing xml response using DomDocument etc.
Replacing decimal points, using Mid & InStr pair to check node existence are just trouble and bad practice also.
If I were to take a guess.
VBScript gives strange errors when your "MID" function has to deal with special characters, or what it thinks are non-string values.
So, o3.responseText probably contains text that it doesn't like.

Resources