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

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

Related

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

Response.Redirect error

I have form page that collects data. The user clicks SUBMIT, which goes to a "post page. At the end of this page is the redirect code I am using.
response.redirect( "test.asp?ChecklistID=" + ChecklistID )
For some reason, the result is this.
/test.asp?ChecklistID=4784,%204784
Why is this returning in TWO ID's? I only have ONE record in the 'results' table. And it is '4784'.
Adding the code
<%
'Option Explicit
Dim SQLStmt, sql, RS, ChecklistID, Location, ChecklistDate, Driveup,
ConnectString, conn, objconn
Dim weeds, parking_lot, sidewalk, windows, exterior_trash, door_clean
Dim mats_clean, Notes_page1
Location = Request("Location")
ChecklistDate = Request("ChecklistDate")
Driveup = Request("Driveup")
ChecklistID = Request("ChecklistID")
weeds = Request("weeds")
parking_lot = Request("parking_lot")
sidewalk = Request("sidewalk")
windows = Request("windows")
exterior_trash = Request("exterior_trash")
door_clean = Request("door_clean")
mats_clean = Request("mats_clean")
Notes_page1 = Request("Notes_page1")
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
Server.MapPath("../xyz/mydatabase.mdb")
Set conn = Server.CreateObject("ADODB.Connection")
conn.open ConnectString
SQLStmt = "SELECT * FROM Results WHERE ChecklistID =" & ChecklistID & " ; "
Set RS = Server.CreateObject("ADODB.Recordset")
RS.open "Results", conn, 3, 3
RS.Update
RS("ChecklistDate") = ChecklistDate
RS("Driveup") = Driveup
RS("weeds") = weeds
RS("parking_lot") = parking_lot
RS("sidewalk") = sidewalk
RS("windows") = windows
RS("exterior_trash") = exterior_trash
RS("door_clean") = door_clean
RS("mats_clean") = mats_clean
RS("Notes_page1") = Notes_page1
RS.Update
RS.close
set RS = nothing
conn.close
set conn = nothing
response.redirect( "test.asp?ChecklistID=" + ChecklistID )
%>
The browser might be retaining some history with response.redirect. Try using Server.Transfer. Or, if it's the same page, you might not have to re-add the query string.
Solved
I had the same hidden field in there twice causing the issue.

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

I need help parameterizing some VBScript code in an .asp file

Here is a snippet of what I'm working on. Please let me know if I need to post more:
<% # LANGUAGE = VBScript ENABLESESSIONSTATE = False %>
<!--#include file="Connections/ConnectionString.asp" -->
<!--#include file="SqlCheckInclude.asp" -->
<%
Dim LoginTest
LoginTest = ""
If Request.QueryString("Action") = "Login" Then
Dim IsUserNameLocked
Set IsUserNameLocked = Server.CreateObject("ADODB.Recordset")
IsUserNameLocked.ActiveConnection = ConnectionString
sProUserName = Request.Form("ProUserName")
sanitizedProUserName = "'" & Replace(sProUserName, "'", "''") & "'"
Response.Write(sanitizedProUserName)
Response.End()
IsUserNameLocked.Source = "SELECT IL_Date, IL_Timer, IL_NumOfTimes, ProUserName FROM PROFILE WHERE ProUserName =" & sanitizedProUserName
IsUserNameLocked.CursorType = 2
IsUserNameLocked.CursorLocation = 3
IsUserNameLocked.LockType = 3
IsUserNameLocked.Open
if not IsUserNameLocked.eof then
intNumOfIncorrectLogin = IsUserNameLocked("IL_NumOfTimes")
InCorrectLoginDate = IsUserNameLocked("IL_Date")
InCorrectLoginTime = IsUserNameLocked("IL_Timer")
end if
IsUserNameLocked.close
set IsUserNameLocked = nothing
end if
%>
I attempted to convert it to:
If Request.QueryString("Action") = "Login" Then
Dim IsUserNameLocked
Set IsUserNameLocked = Server.CreateObject("ADODB.Recordset")
IsUserNameLocked.ActiveConnection = ConnectionString
strSql = "SELECT IL_Date, IL_Timer, IL_NumOfTimes, ProUserName FROM PROFILE WHERE ProUserName = ?"
strSearch = Request.Form("ProUserName")
set objCommand = Server.CreateObject("ADODB.Command")
objCommand.ActiveConnection = ConnectionString
objCommand.CommandText = strSql
objCommand.Parameters(0).value = strSearch
IsUserNameLocked.results = objCommand.Execute()
IsUserNameLocked.CursorType = 2
IsUserNameLocked.CursorLocation = 3
IsUserNameLocked.LockType = 3
IsUserNameLocked.Open
end if
But this did not work. I have been searching online for the past few hours attempting to find a method that properly works, but I'm getting no functioning results. If someone could please help with an implementation that properly parameterizes and protects against SQL injection, I would be extremely grateful.
According to the docs, you need to .Append a parameter to a Command's parameter collection. Evidence:
>> Set oCmd = CreateObject("ADODB.Command")
>> WScript.Echo "# parameters", oCmd.Parameters.Count
>> oCmd.Parameters(0).Value = "no such thing"
>>
# parameters 0
Error Number: 3265
Error Description: Item cannot be found in the collection corresponding to the requested name or ordinal.
Do you use a global On Error Resume Next?

VBscript search sAMAccountName from CN

I've written this script which pulls the sAMAccountName of the specified user from the AD via VBscript, but it seems to only work within my own OU group. Is this due to a permissions restriction within my company? Or is this due to something i'm not seeing in the code?
Dim result
result = getsAMAccountName("Some Name")
msgbox result
Function getsAMAccountName(name)
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strsAM, objUser
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
msgbox strDNSDomain
strBase = "<LDAP://" & strDNSDomain & ">"
'be sure passed var usersel is referenced properly
strFilter = "(cn=" & name & ")"
strAttributes = "distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
strsAM = adoRecordset.Fields("distinguishedName").Value
Set objUser = GetObject("LDAP://" & strsAM)
getsAMAccountName = objUser.sAMAccountName
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
End Function
Does it work when you specify the OU in your GetObject call?
GetObject("LDAP://OU=YourOU,DC=YourDomain,DC=com")
From this question Querying Active Directory using VBScript
Ended up being permissions, be sure to include/specify a processID and PW when moving LDAP pulls to asp classic... and avoid asp classic
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
With adoConnection
.Properties("User ID") = ' Process ID goes
.Properties("Password") = 'password
.Properties("encrypt password") = True
End With
adoConnection.Open "Active Directory Provider"
Set adoCommand = CreateObject("ADODB.Command")
Set adoCommand.ActiveConnection = adoConnection

Resources