ADODB.Stream ReadText error - asp-classic

I am using a downloaded pure ASP script to upload files. My form contains a textarea and a file upload component. It works fine when I enter regular text but it cannot handle when I copy and paste something from word having special characters. The error I am getting is:
Provider error '80070057'
The parameter is incorrect.
/forum/freeaspupload.asp, line 309
The part of my code which throws the error is:
Private Function ConvertUtf8BytesToString(start, length)
StreamRequest.Position = 0
Dim objStream
Dim strTmp
' init stream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeBinary
objStream.Open
' write bytes into stream
StreamRequest.Position = start+1
StreamRequest.CopyTo objStream, length
objStream.Flush
' rewind stream and read text
objStream.Position = 0
objStream.Type = adTypeText
strTmp = objStream.ReadText
' close up and return
objStream.Close
Set objStream = Nothing
ConvertUtf8BytesToString = strTmp
End Function
Line 309 is the line:
strTmp = objStream.ReadText
Any idea how to fix it?

I know it's an old question but since there is no answer and I got the exact same problem and finally found a solution, I think it can be good to share it.
The problem is related to IIS version since it was working fine on IIS6 but stop to work when we moved to IIS8.5
See ReadText
By defaut ReadText parameter is -1 (adReadAll).
For some reason, this default parameter seems not working with IIS8.5. You have to put the length of the text that you want to read.
so ReadText(2000) will work fine.
Of course, you will have to figured out the maximum length or find a way to loop and read everything
By MSFT :
If NumChar is more than the number of characters left in the stream, only the characters remaining are returned. The string read is not padded to match the length specified by NumChar. If there are no characters left to read, a variant whose value is null is returned. ReadText cannot be used to read backwards.

Related

Why is a Base64 string displayed as empty in Message Box?

I have to encode some HTML source code into base64 format before form submission, and then decode it back to original code in the code behind. Here is the testing code by MsgBox:
MsgBox(HttpContext.Current.Request.Form("encodedSourceCode"))
MsgBox(Convert.ToString(HttpContext.Current.Request.Form("encodedSourceCode").GetType()))
Dim b = Convert.FromBase64String(HttpContext.Current.Request.Form("encodedSourceCode"))
Dim html = System.Text.Encoding.UTF8.GetString(b)
MsgBox(html)
And I have added an alert() for encodedSourceCode in client script.
The results turn out to be:
First MsgBox: Empty
Second MsgBox: "System.String"
Last MsgBox: Original HTML source code
And the JS alert dialog shows the base64 string, which consists of a bunch of digits and alphabets.
In short, everything is fine, except the first MsgBox, which is supposed to be base64 encoded string but turns out to be empty. Why? Is it normal?
Actually it does not matter much because even the final result (after decoding) seems to have no problem, but I'm just curious why the interim result is not shown as what it's supposed to be.
It seems that the string is simply too long without 'wrappable' characters, I suppose. MsgBox cuts out the 'last word' and shows nothing.
This may confirm it:
dim test = HttpContext.Current.Request.Form("encodedSourceCode")
MsgBox(test) ' empty
test = test.Substring(0, 20)
MsgBox(test) ' shows the first 20 characters
Testing in LinqPad, I get the limit around 43.000 characters:
MsgBox("".PadLeft(43000, "a"))
MsgBox("".PadLeft(44000, "a"))
MsgBox("".PadLeft(43000, "a") & " " & "".PadLeft(1000, "a"))
1st: shows text.
2nd: shows empty box, length = 44.000
3rd: shows text, although the total length is 44.001, but wrappable at the space.
It definitely has nothing to do with base64 strings as they are simple strings. Here the proof:
Dim myString = "Hello world, this is just an ɇxâmpŀƏ ʬith some non-ansi characters..."
Dim myEncoding As Encoding = Encoding.UTF8
MsgBox(myString)
Dim myBase64 = Convert.ToBase64String(myEncoding.GetBytes(myString))
MsgBox(myBase64)
Dim myStringAgain = myEncoding.GetString(Convert.FromBase64String(myBase64))
MsgBox(myStringAgain)
MsgBox(If(StringComparer.Ordinal.Equals(myString, myStringAgain), "same", "different"))
The line
MsgBox(Convert.ToString(HttpContext.Current.Request.Form("encodedSourceCode").GetType()))
results in "System.String" because you convert the name of the type to a string (see xxx.GetType()).

FileSystemObject.FolderExists returning wrong value

The following code:
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(path) Then
fso.CreateFolder(path)
End If
Is producing the following error:
Microsoft VBScript runtime error '800a003a' File already exists
If I delete the folder, so that ASP is able to create it itself, it works as expected.
It's only when I manually (or using DOS MKDIR) create it that FolderExists returns false and CreateFolder throws the above error.
What's going on here?
EDIT:
The variable path contains the string C:\Windows\Temp\email_attachments\ and FolderExists seems to be returning false for directories that have been around since before the last startup.
Hi my worked code.
file_path="C:\inetpub\wwwroot\upload\2018\4"
set fso=Server.CreateObject("Scripting.FileSystemObject")
tmpArr = Split(file_path, "\")
tmpPath = tmpArr(0)
For i = 1 To UBound(tmpArr)
If Not fso.FolderExists(Server.MapPath(tmpPath)) Then
fso.CreateFolder Server.MapPath(tmpPath)
End If
tmpPath = tmpPath & "\" & tmpArr(i)
Next

Not getting attribute from a xml file into asp

I have the following xml result from this link - https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov
<eveapi version="2">
<currentTime>2013-01-16 18:57:38</currentTime>
<result>
<rowset name="characters" key="characterID" columns="name,characterID">
<row name="BorisKarlov" characterID="315363291"/>
</rowset>
</result>
<cachedUntil>2013-02-16 18:57:38</cachedUntil>
</eveapi>
and I am trying to extract the characterID into asp. I am using the following code,
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.LoadXML("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
Set oRoot = oXML.selectSingleNode("//result")
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
Set oXML = Nothing
All i keep getting is the following error:
Microsoft VBScript runtime error '800a01a8'
Object required: 'oRoot'
.............
I can only assume that Set oRoot = oXML.selectSingleNode("//result") is not actually generating any data and therefore throwing up the error in the next line.
Can anyone please shed some light on my problem?
You have a few problems there.
loadXML() is for loading a block of XML as a string, not fetching from a remote server; for that, you need to use load()
when loading from a server, you need to tell it to use the ServerXMLHTTP component, and set async to false so that it waits until loaded before executing the rest of your script.
when I tried loading that XML, I got an encoding error; you will need to resolve that one way or another
when I loaded the XML directly from a string, it wouldn't parse because there is a script element containing non-XML content; that needs to be contained within a CDATA section
your XPath query is to //result, but you actually need it to be //result/rowset
This code should work once you resolve issues 3 and 4 above:
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.async = False
oXML.setProperty "ServerHTTPRequest", true
oXML.Load("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
If oXML.parseError.errorCode <> 0 Then
Response.Write "<p>XML parse error: " & Server.HTMLEncode(oXML.parseError.reason) & "</p>"
Else
Set oRoot = oXML.selectSingleNode("//result/rowset")
If oRoot Is Nothing Then
response.write "Nothing!"
response.end
End If
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
End If
Set oXML = Nothing
Edit: to get around the problem #3, and oddly also #4 (don't know why!), use this snippet to load the XML instead. For some reason, I think the code above isn't handling the gzip compressed stream correctly, but this code below does.
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
Set xh = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
xh.open "GET", "https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov", False
xh.send
xml = xh.responseText
oXML.LoadXML xml

How to generate MD5 using VBScript in classic ASP?

I need to generate an MD5 in my application.
I've tried google but only find PHP code for MD5. I need to connect to a client system that validates using MD5 hash but their code is in PHP, mine is in Classic ASP using VBScript.
My server is .Net supported so I cannot use the PHP script. Is there any such MD5 code for VBScript in Classic ASP?
Update 2017-02-21 - Now with added HMACSHA256 for JWTs
Update 2016-07-05 - Now with added SHA1 and SHA256
Right, for all of you who have been struggling with this (like myself) and want to know, it is possible!
The following code is split up into several functions so that you can either MD5/sha1/sha256 a string, or a file.
I borrowed the functions GetBytes and BytesToBase64 from another stackexchange, and the code within stringToUTFBytes is based on another stackexchange.
function md5hashBytes(aBytes)
Dim MD5
set MD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
MD5.Initialize()
'Note you MUST use computehash_2 to get the correct version of this method, and the bytes MUST be double wrapped in brackets to ensure they get passed in correctly.
md5hashBytes = MD5.ComputeHash_2( (aBytes) )
end function
function sha1hashBytes(aBytes)
Dim sha1
set sha1 = CreateObject("System.Security.Cryptography.SHA1Managed")
sha1.Initialize()
'Note you MUST use computehash_2 to get the correct version of this method, and the bytes MUST be double wrapped in brackets to ensure they get passed in correctly.
sha1hashBytes = sha1.ComputeHash_2( (aBytes) )
end function
function sha256hashBytes(aBytes)
Dim sha256
set sha256 = CreateObject("System.Security.Cryptography.SHA256Managed")
sha256.Initialize()
'Note you MUST use computehash_2 to get the correct version of this method, and the bytes MUST be double wrapped in brackets to ensure they get passed in correctly.
sha256hashBytes = sha256.ComputeHash_2( (aBytes) )
end function
function sha256HMACBytes(aBytes, aKey)
Dim sha256
set sha256 = CreateObject("System.Security.Cryptography.HMACSHA256")
sha256.Initialize()
sha256.key=aKey
'Note you MUST use computehash_2 to get the correct version of this method, and the bytes MUST be double wrapped in brackets to ensure they get passed in correctly.
sha256HMACBytes = sha256.ComputeHash_2( (aBytes) )
end function
function stringToUTFBytes(aString)
Dim UTF8
Set UTF8 = CreateObject("System.Text.UTF8Encoding")
stringToUTFBytes = UTF8.GetBytes_4(aString)
end function
function bytesToHex(aBytes)
dim hexStr, x
for x=1 to lenb(aBytes)
hexStr= hex(ascb(midb( (aBytes),x,1)))
if len(hexStr)=1 then hexStr="0" & hexStr
bytesToHex=bytesToHex & hexStr
next
end function
Function BytesToBase64(varBytes)
With CreateObject("MSXML2.DomDocument").CreateElement("b64")
.dataType = "bin.base64"
.nodeTypedValue = varBytes
BytesToBase64 = .Text
End With
End Function
'Special version that produces the URLEncoded variant of Base64 used in JWTs.
Function BytesToBase64UrlEncode(varBytes)
With CreateObject("MSXML2.DomDocument").CreateElement("b64")
.dataType = "bin.base64"
.nodeTypedValue = varBytes
BytesToBase64UrlEncode = replace(replace(replace(replace(replace(.Text,chr(13),""),chr(10),""),"+", "-"),"/", "_"),"=", "")
End With
End Function
Function GetBytes(sPath)
With CreateObject("Adodb.Stream")
.Type = 1 ' adTypeBinary
.Open
.LoadFromFile sPath
.Position = 0
GetBytes = .Read
.Close
End With
End Function
These can be used as follows:
BytesToBase64(md5hashBytes(stringToUTFBytes("Hello World")))
Produces: sQqNsWTgdUEFt6mb5y4/5Q==
bytesToHex(md5hashBytes(stringToUTFBytes("Hello World")))
Produces: B10A8DB164E0754105B7A99BE72E3FE5
For SHA1:
bytesToHex(sha1hashBytes(stringToUTFBytes("Hello World")))
Produces: 0A4D55A8D778E5022FAB701977C5D840BBC486D0
For SHA256:
bytesToHex(sha256hashBytes(stringToUTFBytes("Hello World")))
Produces: A591A6D40BF420404A011733CFB7B190D62C65BF0BCDA32B57B277D9AD9F146E
To get the MD5 of a file (useful for Amazon S3 MD5 checking):
BytesToBase64(md5hashBytes(GetBytes(sPath)))
Where sPath is the path to the local file.
And finally, to create a JWT:
'define the JWT header, needs to be converted to UTF bytes:
aHead=stringToUTFBytes("{""alg"":""HS256"",""typ"":""JWT""}")
'define the JWT payload, again needs to be converted to UTF Bytes.
aPayload=stringToUTFBytes("{""sub"":""1234567890"",""name"":""John Doe"",""admin"":true}")
'Your shared key.
theKey="mySuperSecret"
aSigSource=stringToUTFBytes(BytesToBase64UrlEncode(aHead) & "." & BytesToBase64UrlEncode(aPayload))
'The full JWT correctly Base 64 URL encoded.
aJWT=BytesToBase64UrlEncode(aHead) & "." & BytesToBase64UrlEncode(aPayload) & "." & BytesToBase64UrlEncode(sha256HMACBytes(aSigSource,stringToUTFBytes(theKey)))
Which will produce the following valid JWT:
eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWV9.7ofvtkn0z_pTl6WcqRTxw-4eSE3NqcEq9_3ax0YcuIQ
Here is a readable and downloadable version of MD5 as VBS script:
https://github.com/Wikinaut/md5.vbs
It's the code from http://chayoung.tistory.com/entry/VBScript-MD5 (thank you for this unique piece of code).
Thanks for all the links provided above, they were useful but this one I found really did the job if anybody ever needs it.
VBScript-MD5
I have no idea if this code even works, since I have no way of testing it. However, it seems to be what you are asking for.
http://www.bullzip.com/md5/vb/md5-vb-class.htm
Here is an interesting article by Jeff Attwood on hashes. He has some important things to say about MD5:
http://www.codinghorror.com/blog/2012/04/speed-hashing.html
First of all, thank you SgtWilko! :)
Based on your collected information, I've done one function for all (not for base64/Files).
Your code was very useful for me, but I was searching for a more PHP alike (simple) Function to deal with plain text and with a more explicit code.
Edited:
Based on the issue How to hash a UTF-8 string in Classic ASP, I come up with the ADODB.Stream solution. You can now use non-English characters.
Edited:
Parameter PlainText was changed to Target.
You can now use the HMAC versions.
Just use the Target parameter as an array.
Target(0) = PlainText
Target(1) = SharedKey
Thank you again SgtWilko ;)
Announcing the first SHA1 collision (Google Security Blog) February 23, 2017.
With this function you can hash the plain text into:
MD5, RIPEMD160, SHA1, SHA256, SHA384, SHA512, HMACMD5, HMACRIPEMD160, HMACSHA1, HMACSHA256, HMACSHA384 and HMACSHA512
If you need more you can find it in: System.Security.Cryptography Namespace
Function Hash(HashType, Target)
On Error Resume Next
Dim PlainText
If IsArray(Target) = True Then PlainText = Target(0) Else PlainText = Target End If
With CreateObject("ADODB.Stream")
.Open
.CharSet = "Windows-1252"
.WriteText PlainText
.Position = 0
.CharSet = "UTF-8"
PlainText = .ReadText
.Close
End With
Set UTF8Encoding = CreateObject("System.Text.UTF8Encoding")
Dim PlainTextToBytes, BytesToHashedBytes, HashedBytesToHex
PlainTextToBytes = UTF8Encoding.GetBytes_4(PlainText)
Select Case HashType
Case "md5": Set Cryptography = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") '< 64 (collisions found)
Case "ripemd160": Set Cryptography = CreateObject("System.Security.Cryptography.RIPEMD160Managed")
Case "sha1": Set Cryptography = CreateObject("System.Security.Cryptography.SHA1Managed") '< 80 (collision found)
Case "sha256": Set Cryptography = CreateObject("System.Security.Cryptography.SHA256Managed")
Case "sha384": Set Cryptography = CreateObject("System.Security.Cryptography.SHA384Managed")
Case "sha512": Set Cryptography = CreateObject("System.Security.Cryptography.SHA512Managed")
Case "md5HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACMD5")
Case "ripemd160HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACRIPEMD160")
Case "sha1HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACSHA1")
Case "sha256HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACSHA256")
Case "sha384HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACSHA384")
Case "sha512HMAC": Set Cryptography = CreateObject("System.Security.Cryptography.HMACSHA512")
End Select
Cryptography.Initialize()
If IsArray(Target) = True Then Cryptography.Key = UTF8Encoding.GetBytes_4(Target(1))
BytesToHashedBytes = Cryptography.ComputeHash_2((PlainTextToBytes))
For x = 1 To LenB(BytesToHashedBytes)
HashedBytesToHex = HashedBytesToHex & Right("0" & Hex(AscB(MidB(BytesToHashedBytes, x, 1))), 2)
Next
If Err.Number <> 0 Then Response.Write(Err.Description) Else Hash = LCase(HashedBytesToHex)
On Error GoTo 0
End Function
These can be used as follows:
Hash("sha512", "Hello World")
Produces:
2c74fd17edafd80e8447b0d46741ee243b7eb74dd2149a0ab1b9246fb30382f27e853d8585719e0e67cbda0daa8f51671064615d645ae27acb15bfb1447f459b
Hash("sha256", "Hello World")
Produces:
a591a6d40bf420404a011733cfb7b190d62c65bf0bcda32b57b277d9ad9f146e
Hash("md5", "muñeca")
Produces:
ea07bec1f37f4b56ebe368355d1c058f
Hash("sha512HMAC", Array("Hello World", "Shared Key"))
Produces:
28e72824c48da5a5f14b59246905d2839e7c50e271fc078b1c0a75c89b6a3998746bd8b2dc1764b19d312702cf5e15b38ce799156af28b98ce08b85e4df65b32
There is Javascript code that produces an MD5 checksum. One of them, derived from the Google closure library, is available here.
It's pretty easy to produce a Windows Script Component from the Javascript, then call that component from any COM-enabled language, including VB.
Here's a working example.

Simple encrypt/decrypt functions in Classic ASP

Are there any simple encrypt/decrypt functions in Classic ASP?
The data that needs to be encrypted and decrypted is not super sensitive. So simple functions would do.
4guysfromrolla.com: RC4 Encryption Using ASP & VBScript
See the attachments at the end of the page.
The page layout looks a bit broken to me, but all the info is there. I made it readable it by deleting the code block from the DOM via bowser development tools.
Try this:
' Encrypt and decrypt functions for classic ASP (by TFI)
'********* set a random string with random length ***********
cryptkey = "GNQ?4i0-*\CldnU+[vrF1j1PcWeJfVv4QGBurFK6}*l[H1S:oY\v#U?i,oD]f/n8oFk6NesH--^PJeCLdp+(t8SVe:ewY(wR9p-CzG<,Q/(U*.pXDiz/KvnXP`BXnkgfeycb)1A4XKAa-2G}74Z8CqZ*A0P8E[S`6RfLwW+Pc}13U}_y0bfscJ<vkA[JC;0mEEuY4Q,([U*XRR}lYTE7A(O8KiF8>W/m1D*YoAlkBK#`3A)trZsO5xv#5#MRRFkt\"
'**************************** ENCRYPT FUNCTION ******************************
'*** Note: bytes 255 and 0 are converted into the same character, in order to
'*** avoid a char 0 which would terminate the string
function encrypt(inputstr)
Dim i,x
outputstr=""
cc=0
for i=1 to len(inputstr)
x=asc(mid(inputstr,i,1))
x=x-48
if x<0 then x=x+255
x=x+asc(mid(cryptkey,cc+1,1))
if x>255 then x=x-255
outputstr=outputstr&chr(x)
cc=(cc+1) mod len(cryptkey)
next
encrypt=server.urlencode(replace(outputstr,"%","%25"))
end function
'**************************** DECRYPT FUNCTION ******************************
function decrypt(byval inputstr)
Dim i,x
inputstr=urldecode(inputstr)
outputstr=""
cc=0
for i=1 to len(inputstr)
x=asc(mid(inputstr,i,1))
x=x-asc(mid(cryptkey,cc+1,1))
if x<0 then x=x+255
x=x+48
if x>255 then x=x-255
outputstr=outputstr&chr(x)
cc=(cc+1) mod len(cryptkey)
next
decrypt=outputstr
end function
'****************************************************************************
Function URLDecode(sConvert)
Dim aSplit
Dim sOutput
Dim I
If IsNull(sConvert) Then
URLDecode = ""
Exit Function
End If
'sOutput = REPLACE(sConvert, "+", " ") ' convert all pluses to spaces
sOutput=sConvert
aSplit = Split(sOutput, "%") ' next convert %hexdigits to the character
If IsArray(aSplit) Then
sOutput = aSplit(0)
For I = 0 to UBound(aSplit) - 1
sOutput = sOutput & Chr("&H" & Left(aSplit(i + 1), 2)) & Right(aSplit(i + 1), Len(aSplit(i + 1)) - 2)
Next
End If
URLDecode = sOutput
End Function
I know is a bit late for BrokenLink, but for the record and others like me who were looking for the same.
I found this https://www.example-code.com/vbscript/crypt_aes_encrypt_file.asp.
It needs to install a chilkat ActiveX component on WindowsServer. But this inconvenient becomes convenient when looking resources and processing time.
Its very easy to use, and the given example is pretty clear. To make it your own, just change the "keyHex" variable value and voilá.

Resources