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

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

Related

Classic ASP with Base64 Type Hex

This code encrypted with sha256
7353cf97ed9471d8b1ca180b6277f855f27214668d40d3b0134b8c91c8bb51a8
The result when I encode with Base64
NzM1M2NmOTdlZDk0NzFkOGIxY2ExODBiNjI3N2Y4NTVmMjcyMTQ2NjhkNDBkM2IwMTM0YjhjOTFjOGJiNTFhOA==
but I want to get a result like this.
c1PPl+2UcdixyhgLYnf4VfJyFGaNQNOwE0uMkci7Uag=
https://emn178.github.io/online-tools/base64_encode.html
I can get this result on this online converter site. (You must select the hex input type)
base64 code I use:
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 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
Private Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeText
BinaryStream.CharSet = "us-ascii"
BinaryStream.Open
BinaryStream.WriteText Text
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
BinaryStream.Position = 0
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
Private Function Stream_BinaryToString(Binary)
Const adTypeText = 2
Const adTypeBinary = 1
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write Binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeText
BinaryStream.CharSet = "us-ascii"
Stream_BinaryToString = BinaryStream.ReadText
Set BinaryStream = Nothing
End Function
how can i do with classic asp
You must decode hex string first.
After getting corresponding raw value, you can convert it to Base64 string.
Function HexStringToBytes(hexString)
With CreateObject("MSXML2.DOMDocument")
.LoadXml "<node/>"
With .DocumentElement
.DataType = "bin.hex"
.Text = hexString
HexStringToBytes = .NodeTypedValue
End With
End With
End Function
Function BytesToBase64String(bytes)
With CreateObject("MSXML2.DOMDocument")
.LoadXml "<node/>"
With .DocumentElement
.DataType = "bin.base64"
.NodeTypedValue = bytes
BytesToBase64String = Replace(.Text, vbLf, "")
End With
End With
End Function
Function HexStringToBase64String(hexString)
Dim bytes, base64string
bytes = HexStringToBytes(hexString)
base64string = BytesToBase64String(bytes)
HexStringToBase64String = base64string
End Function
hexStr = "7353cf97ed9471d8b1ca180b6277f855f27214668d40d3b0134b8c91c8bb51a8"
base64str = HexStringToBase64String(hexStr)
'Response.Write(base64str) 'prints c1PPl+2UcdixyhgLYnf4VfJyFGaNQNOwE0uMkci7Uag=

How can I save Website data to file using VBScript?

In the following code, how can I save the text to a text file (text.txt for example) instead of the current MsgBox?
myURL = "http://URL.com"
Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set ohtmlFile = CreateObject("htmlfile")
oXMLHttp.Open "GET", myURL, False
oXMLHttp.send
If oXMLHttp.Status = 200 Then
ohtmlFile.Write oXMLHttp.responseText
ohtmlFile.Close
Set oTable = ohtmlFile.getElementsByTagName("table")
For Each oTab In oTable
MsgBox oTab.Innertext
Next
End If
WScript.Quit
Please, help me!
Thanks!
You can use the FileSystemObject's OpenTextFile method.
You can create the FileSystemObject at the top of your code with your other objects:
Set objFSO = CreateObject("Scripting.FileSystemObject")
And add these constants:
Const ForReading = 1, ForWriting = 2, ForAppending = 8
If you want to append everything into the same file, you can create and open the file outside of your loop:
sFileName = "c:\text.txt"
Set objFile = objFSO.OpenTextFile(sFileName, ForAppending, True)
For Each oTab In oTable
objFile.WriteLine oTab.Innertext
Next
objFile.Close
Otherwise you can create multiple files within your loop:
Dim iTableCounter
iTableCounter = 0
For Each oTab In oTable
iTableCounter = iTableCounter + 1
sFileName = "c:\table_" & iTableCounter & ".txt" ' create a dynamic file name using table name perhaps
Set objFile = objFSO.OpenTextFile(sFileName, ForWriting, True)
objFile.Write oTab.Innertext
objFile.Close
Next

In Classic ASP reading cXML Files, is it required to point your dtd link to local files?

Unfortunately, we've inherited an old Classic ASP site and are writing new code for a round trip punch-out site. Reading in the cXML file, we're continually erroring out on the 2nd line !DOCTYPE cXML SYSTEM "http://xml.../cXML.dtd.
If we capture the location of the dtd file and change it to a local file, i.e., file:///c:/....dtd it works. Is there no way to get this to work using the http location? I'd rather not store all the dtd file versions locally.
Our Code is:
Dim olddtdvalue
Dim newdtdvalue
Dim xmlfilename
olddtdvalue = "http://xml.cxml.org/schemas/cXML/"
newdtdvalue = "file:///d:/Websites/FSIResponsive/cXML/"
xmlfilename ="PORS_" & formatdatetime(now,vblongdate) & " " & replace(formatdatetime(now,vblongtime),":","_") & ".xml"
set fs=Server.CreateObject("Scripting.FileSystemObject")
set f=fs.CreateTextFile("d:\WebSites\FSIResponsive\cXML\InFiles\" & xmlfilename,true)
f.write("remote host: " & request.ServerVariables("REMOTE_HOST") & vbcrlf & vbcrlf)
totalBytes = Request.TotalBytes
If totalBytes > 0 Then
xml = Request.BinaryRead( totalBytes )
for i = 1 to totalBytes
xmlstr = xmlstr + String(1,AscB(MidB(xml, i, 1)))
Next
f.write(xmlstr)
xml2 = xmlstr
xml2 = Replace(xml2,olddtdvalue,newdtdvalue)
End if
Set xdoc = Server.CreateObject("Microsoft.XMLDOM")
' Set xdoc = Server.CreateObject("MSXML2.DOMDocument.6.0")
xdoc.ValidateOnParse = True
xdoc.async = False
xdoc.resolveExternals = True
' response.write xml2
loadStatus = xdoc.loadXML(xml2)
As you can see, we've tried using MSXML2.DOMDocument.6.0, but that doesn't work either.
Thanks,
Alan
Update:
Here's the code I finally got working:
Dim xmlfilename
Dim URL
totalBytes = Request.TotalBytes
If totalBytes > 0 Then
xml = Request.BinaryRead( totalBytes )
for i = 1 to totalBytes
xmlstr = xmlstr + String(1,AscB(MidB(xml, i, 1)))
Next
xml2 = xmlstr
End if
Set xdoc = Server.CreateObject("MSXML2.DOMDocument.6.0")
xdoc.setProperty "ServerHTTPRequest", True
xdoc.setProperty "ProhibitDTD",False
xdoc.resolveExternals = True
xdoc.ValidateOnParse = True
xdoc.async = False
loadStatus = xdoc.LoadXML(xml2)
Alan

Do not generate file in disk, instead send mail with data in memory

I have a piece of code that works and do:
Reads a Database , reads a template (template.htm), put data in a new file based in the template (evento.htm), read that file and send an email with the content of the file generated. Code below (I cut the database part):
<%
NomeDoTemplate= "template.htm"
CaminhoDoTemplate= Server.MapPath(NomeDoTemplate)
CaminhoDoTemplateAjustado= Mid(CaminhoDoTemplate,1,InStrRev(CaminhoDoTemplate,"\"))
NomeDoArquivo= "evento.htm"
CaminhoDoArquivo= Server.MapPath(NomeDoArquivo)
Set ManipulacaoDeArquivo= Server.CreateObject("Scripting.FileSystemObject")
Set ObjetoArquivo= ManipulacaoDeArquivo.OpenTextFile(CaminhoDoTemplate, 1)
DadosDoObjetoArquivo= ObjetoArquivo.ReadAll
ObjetoArquivo.Close
DadosDoObjetoArquivo= Replace(DadosDoObjetoArquivo, "[Cliente]", Um)
Set ObjetoArquivo= ManipulacaoDeArquivo.CreateTextFile(CaminhoDoTemplateAjustado & NomeDoArquivo)
ObjetoArquivo.Write(DadosDoObjetoArquivo)
Set ObjetoArquivo= ManipulacaoDeArquivo.OpenTextFile(CaminhoDoTemplateAjustado & NomeDoArquivo, 1)
DadosDoObjetoArquivo= ObjetoArquivo.ReadAll
Dim objCDOSYSMail
Dim objCDOSYSCon
Set objCDOSYSMail = Server.CreateObject("CDO.Message")
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.server.com"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user_id"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
objCDOSYSCon.Fields.update
Set objCDOSYSMail.Configuration = objCDOSYSCon
objCDOSYSMail.From = "ABC <abc#server.com>"
objCDOSYSMail.To = "sender#gmail.com"
objCDOSYSMail.Subject = "Contato"
objCDOSYSMail.HTMLBody= DadosDoObjetoArquivo
objCDOSYSMail.Send
Set objCDOSYSMail = Nothing
Set objCDOSYSCon = Nothing
%>
I would like to make this simple, skiping the step of generating the file in the disk. I would like to:
Read a Database, reads a template, put data in memory, send the mail with that data in memory.
Thanks
If I see it correctly, all you have to do is skip the part where you save the file and re-read it... I have refactored your code, gave the variables some english names so I could see what's going on, and commented out the lines you don't need:
<%
Dim TemplateName : TemplateName = "template.htm"
Dim TemplateFullPath : TemplateFullPath = Server.MapPath(TemplateName)
Dim TemplatePath : TemplatePath = Mid(TemplateFullPath,1,InStrRev(TemplateFullPath,"\"))
Dim ArchiveName : ArchiveName = "evento.htm"
Dim ArchiveFullPath : ArchiveFullPath = Server.MapPath(ArchiveName)
Dim FSO, TemplateFile, TemplateText
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set TemplateFile = FSO.OpenTextFile(TemplateFullPath, 1)
TemplateText = TemplateFile.ReadAll()
TemplateText = Replace(TemplateText, "[Cliente]", Um)
TemplateFile.Close()
' Really simple - to do this in-memory, simply don't save and re-read the file....
' Set TemplateFile = FSO.CreateTextFile(TemplatePath & ArchiveName)
' TemplateFile.Write(TemplateText)
' Set TemplateFile = FSO.OpenTextFile(TemplatePath & ArchiveName, 1)
' TemplateText = TemplateFile.ReadAll
Set TemplateFile = Nothing
Set FSO = Nothing
Dim objCDOSYSMail, objCDOSYSCon
Set objCDOSYSMail = Server.CreateObject("CDO.Message")
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.server.com"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user_id"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
objCDOSYSCon.Fields.update
Set objCDOSYSMail.Configuration = objCDOSYSCon
objCDOSYSMail.From = "ABC <abc#server.com>"
objCDOSYSMail.To = "sender#gmail.com"
objCDOSYSMail.Subject = "Contato"
objCDOSYSMail.HTMLBody= TemplateText
objCDOSYSMail.Send
Set objCDOSYSMail.Configuration = Nothing
Set objCDOSYSMail = Nothing
Set objCDOSYSCon = Nothing
%>
Hope this helps,
Erik
you could use several techniques:
write your own stringbuilder class
use the .net system.io.stringwriter class (yes you can use this from classic asp)
use the adodb.stream object
example stringwriter:
set sw = server.createObject("system.io.stringwriter")
sw.write_12( DadosDoObjetoArquivo )
objCDOSYSMail.HTMLBody = sw.getStringBuilder().toString()
example (adodb.stream):
set stream = server.createobject("ADODB.Stream")
with stream
.Open
.WriteText DadosDoObjetoArquivo
end with
objCDOSYSMail.HTMLBody = stream.ReadText
stream.Close

Clearing multiple cookies

The code below tries to clear the cookies for all domains once a user logs out of the system. For some reason, only the last domain in the array is cleared. Why does this happen? Am I doing something wrong?
For example, if I change the size of the array to 4 and then change the for loop to only go to 3, then it only logs me out of y.xcv.com.
As a sidenote, I have this loop working on a different server that uses a slightly different function to clear the cookies.
Edit: Code updated per suggestions below. Now it fails on the "as HttpCookie" line. Do I need to include some library?
Dim aDomain(12)
Dim ESidCookie, WIdCookie, EBidCookie, TSidAccessCookie, PSidAccessCookie, SSidCookie As HttpCookie
aDomain(0) = ".x.com"
aDomain(1) = "y.x.com"
aDomain(2) = "y.x.com"
aDomain(3) = "y.xcv.com"
aDomain(4) = "x.com"
aDomain(5) = "y.z.a.com"
aDomain(6) = "y.z.a.com"
aDomain(7) = "z.a.com"
aDomain(8) = ""
aDomain(9) = "y.x.com"
aDomain(10) = "y.x.com"
aDomain(11) = "y.x.com"
for count = 0 to 11
strDomain = aDomain(count)
response.Write count & "/" & strDomain
ESidCookie = New HttpCookie("oneCookie")
ESidCookie.Domain = strDomain
ESidCookie.Path = "/"
ESidCookie = ""
ESidCookie.Expires = now() - 100
Response.Cookies.Add(ESidCookie)
WIdCookie = New HttpCookie("twoCookie")
WIdCookie.Domain = strDomain
WIdCookie.Path = "/"
WIdCookie = ""
WIdCookie.Expires = now() - 100
Response.Cookies.Add(WIdCookie)
EBidCookie = New HttpCookie("threeCookie")
EBidCookie.Domain = strDomain
EBidCookie.Path = "/"
EBidCookie = ""
EBidCookie.Expires = now() - 100
Response.Cookies.Add(EBidCookie)
TSidAccessCookie = New HttpCookie("fourCookie")
TSidAccessCookie.Path = "/"
TSidAccessCookie = "LoggedOut"
Response.Cookies.Add(TSidAccessCookie)
PSidAccessCookie = New HttpCookie("fiveCookie")
PSidAccessCookie.Domain = strDomain
PSidAccessCookie.Path = "/"
PSidAccessCookie = ""
PSidAccessCookie.Expires = now() - 100
Response.Cookies.Add(PSidAccessCookie)
SSidCookie = New HttpCookie("sixCookie")
SSidCookie.Domain = strDomain
SSidCookie.Path = "/"
SSidCookie = ""
SSidCookie.Expires = now() - 100
Response.Cookies.Add(SSidCookie)
next
Any help is appreciated. Thanks!
The Response.Cookies collection is keyed off of the cookie name so you are just changing the domain of the same cookie each time you go through your loop. That's why the last one wins.
You could try creating a new cookie object and adding that to the Response.Cookies collection in your loop instead.
If you want to clear all cookies you will should create all new ones with the same name. Here is a basic example that should get you going:
Dim newCookie As HttpCookie
For i As Integer = 0 To 10
' creating a new cookie each time
newCookie = New HttpCookie(cookieNames(i))
' expire the cookie
newCookie.Expires = DateTime.Now.AddDays(-1)
' storing the new cookie each time
Response.Cookies.Add(newCookie)
Next
It doesn't look like your creating all new cookies and adding them to the response properly.

Resources