%
Option Explicit
response.buffer = true
response.expires = -1500
response.ExpiresAbsolute = Now() - 1500
response.addHeader "pragma","no-cache"
response.addHeader "cache-control","private"
response.CacheControl = "no-cache"
response.charset = "ISO-8859-1"
Server.ScriptTimeout = 20
session.timeout = 20
Dim exeWarning:exeWarning = _
"Execute the queries against your database? \(Click "OK" to continue\) \n\n"&_
"This action cannot be undone by this software. \(Click "Cancel" to abort\)\n\n"&_
"If you use this software to run queries not supplied by ASPPlayground.NET, we will not provide any support to you."
%>
<%
Sub copyrightnotice
Response.Write "" & VbCrLf
end sub
Sub OnTransactionAbort
response.write ("<"&"script>" &vbcrlf&"alert(""")
if syntax = "on" then
if errored then
response.write ("[Error]\n\nTest/Preview failed. One statement produced error. Please refer to the error description.")
else
response.write ("Test/Preview successfully completed.")
end if
else
if errored then
if failsafe="on" then
response.write ("[Error]\n\nEntire Process Rolled-back because one of the SQL statements failed.")
else'if deleteoption = ""
response.write ("[Error]\n\nTransaction was forced to be aborted. This happens to some statements like CREATE TABLE, etc. while run under transaction mode.")
end if
end if
end if
response.write (""");"&vbcrlf&""&"script>")
End Sub
Sub OnTransactionCommit
response.write ("<"&"script>" &vbcrlf&"if (percentCom) alert(""")
if errored then
response.write ("[Error]\n\nOne statement failed causing the entire process to abort.\n\nHowever, SQL Statements above the failure \(if any\) have been successfully executed against your database.")
else
response.write ("SQL Statements have been successfully executed against your database!")
end if
response.write (""");"&vbcrlf&""&"script>")
End Sub
function removeVBCRLF(byVal str)
str = trim(str)
removeVBCRLF = replace(str,VBCRLF,"")
end function
sub beginProcess()
response.write ("<"&"script>document.getElementById(""tabling"").style.display=''; percentCom = document.getElementById(""percentcomplete""); perStatus = document.getElementById(""status"");"&"script>")
response.flush
end sub
sub outputProcess (percent, status)
percentage = percentage + percent
response.write ("<"&"script>percentCom.innerText = '"&percentage&"%'"&"script>")
response.flush
end sub
Sub finishedProcess ()
response.write ("<"&"script>" &vbcrlf&_
"perStatus.innerText = 'Done. It took "&timer()-nstart&" seconds to execute the SQL statements.';"&vbcrlf&_
"percentCom.innerText = ''"&vbcrlf&_
""&"script>")
response.flush
end sub
function GetHostType()
if request.serverVariables("HTTPS") = "on" then
GetHostType = "https://"
else
GetHostType = "http://"
end if
end function
function selfPage()
selfPage = lcase(GetHostType() & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("PATH_INFO"))
' selfPage = lcase(mid(Request.ServerVariables("PATH_INFO"),instrRev(Request.ServerVariables("PATH_INFO"),"/")+1))
end function
function serverPath()
serverPath = Left(Server.MapPath(Request.ServerVariables("PATH_INFO")),InstrRev(Server.MapPath(Request.ServerVariables("PATH_INFO")),"\"))
end function
function validReferer()
if objPGDUpload.form("sessID")("Value")&""<> cStr(session.sessionID) then
validReferer = false
session("body") = objPGDUpload.form("body")("Value")&""
response.write ("")
else
validReferer = true
end if
end function
sub returnAllServerFiles()
Dim objFSO, objFiles, file, filename
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set objFiles = objFSO.GetFolder(serverPath()).files
set objFSO = nothing
for each file in objFiles
filename = lcase(file.name)
if right(filename,4) = ".sql" then _
response.write ""
next
set objFiles = nothing
end sub
function iff(evaluation, trueVal, falseVal)
if evaluation then iff = trueVal else iff = falseVal
end function
function HTMLEncode(str)
str = str & ""
str = replace(str,"&","&&&")
str = replace(str,"<","<")
str = replace(str,">",">")
str = replace(str,"""",""")
str = replace(str,"'","'")
str = replace(str,"\","\")
str = replace(str,"&&&","&")
HTMLEncode = str
end function
Class PGDUpload 'Version 3.0 - Super Fast Upload Routine - Faster than any ASP File Upload and Almost as fast as
'Commercial Components - SA-FileUp or ASPUpload. Supports multiple fields upload as well as non-
'binary fields reading.
Private parentDict
Private subDict
Private count_
Private sizeLimit_
Private extLimit_
Private subOrinalDict
Private enableOrdinal_
Private Sub Class_Initialize
Set parentDict = Server.CreateObject("Scripting.Dictionary")
Set subOrinalDict = Server.CreateObject("Scripting.Dictionary")
'subOrinalDict.comparemode = vbtextcompare
parentDict.comparemode = vbtextcompare
sizeLimit_ = 0
extLimit_ = ""
count_ = -1
enableOrdinal_ = true
End Sub
Private Sub Class_Terminate
If IsObject(subDict) Then
subDict.RemoveAll
Set subDict = Nothing
End If
If IsObject(subOrinalDict) Then
subOrinalDict.RemoveAll
Set subOrinalDict = Nothing
End If
If IsObject(parentDict) Then
parentDict.RemoveAll
Set parentDict = Nothing
End If
End Sub
Public Property Let sizelimit(val)
if isNumeric(val) then sizeLimit_ = val
End Property
Public Property Let enableOrdinal(val)
enableOrdinal_ = iff(val,true,false)
End Property
Public Property Let extLimit(val)
if len(val) then extLimit_ = val
End Property
Public Property Get extLimit
extLimit = extLimit_
end Property
Public Function getForm
dim rawdata, totalBytes
totalBytes = Request.TotalBytes
if totalBytes > sizeLimit_ or totalBytes=0 then
getForm = false
exit function
else
getForm = true
end if
if getForm then
rawData = Request.BinaryRead(totalBytes)
Dim wholeBinaryDataInString, lengthOfBinary
lengthOfBinary = LenB(rawData)
Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset")
if lengthOfBinary > 0 Then
objRS.Fields.Append "uploaded", 201, lengthOfBinary 'adLongVarChar
objRS.Open
objRS.AddNew
objRS.Fields("uploaded").AppendChunk rawData
objRS.Update
wholeBinaryDataInString = objRS.Fields("uploaded")
objRS.Close
end if
Set objRS = nothing
' response.write wholeBinaryDataInString
' response.end
call getBinary(wholeBinaryDataInString)
end if
End Function
Private Sub getBinary(rawData)
dim Separator
Separator = Mid(rawData, 1, Instr(1, rawData, Chr(13))-1)
dim wholecontent, formname, filename, binary, contentType
dim firstByteOfWholeContent, lengthOfWholeContent
dim firstByteOfFileName, firstByteOfFormName, endByteOfFileName, endByteOfFormName
dim firstByteOfContentType, lengthOfContentType, endByteOfContentType
dim lengthOfFormName, lengthOfFileName, firstByteOfBinary, lengthOfBinary
dim isBinary, nonBinaryData,firstByteOfNonBinary
Dim arrAllFields, item
arrAllFields = split(rawData,Separator)
count_ = ubound(arrAllFields)-2
for item = 1 to count_+1
wholecontent = arrAllFields(item) 'mid(rawData,firstByteOfWholeContent,lengthOfWholeContent)
firstByteOfWholeContent = instr(1,wholecontent,"Content-Disposition")
lengthOfWholeContent = len(wholecontent) 'instr(firstByteOfWholeContent,rawData,Separator)-len(Separator)-2 'chop off end
firstByteOfFormName = instr(1,wholecontent,"name=")+6
endByteOfFormName = instr(firstByteOfFormName,wholecontent,chr(34))
lengthOfFormName = endByteOfFormName-firstByteOfFormName
'===================
formname = mid(wholecontent,firstByteOfFormName,lengthOfFormName)
'response.write formname&" "
'===================
isBinary = true
firstByteOfFileName = instr(endByteOfFormName,wholecontent,"filename=")+10
if firstByteOfFileName = 10 then isBinary = false
if isBinary then
endByteOfFileName = instr(firstByteOfFileName,wholecontent,chr(34))
lengthOfFileName = endByteOfFileName-firstByteOfFileName
'===================
filename = mid(wholecontent,firstByteOfFileName,lengthOfFileName)
'response.write filename&" "
'===================
firstByteOfContentType = instr(endByteOfFileName,wholecontent,"Content-Type:")+14
endByteOfContentType = instr(firstByteOfContentType,wholecontent,chr(13))
lengthOfContentType = endByteOfContentType - firstByteOfContentType
'===================
contentType = mid(wholecontent,firstByteOfContentType,lengthOfContentType)
'response.write contentType&" "
'===================
firstByteOfBinary = endByteOfContentType+4 'LF+CR+LF+1
lengthOfBinary = lengthOfWholeContent-firstByteOfBinary-1 '-1 = -2+1
'===================
binary = mid(wholecontent,firstByteOfBinary,lengthOfBinary)
if len(binary) = 0 then
isBinary = false
nonBinaryData = ""
end if
'===================
else
firstByteOfNonBinary = endByteOfFormName+5
nonBinaryData = mid(wholecontent,firstByteOfNonBinary,lengthOfWholeContent-firstByteOfNonBinary-1)
end if
Set subDict = Server.CreateObject("Scripting.Dictionary")
subDict.comparemode = vbtextcompare
if isBinary then
subDict.Add ("FileName"), filename
subDict.Add ("FileExt"), fileExt(filename)
subDict.Add ("ContentType"), contentType
subDict.Add ("Value"), "Binary: "&filename
subDict.Add ("Binary"), binary
else
subDict.Add ("Value"), nonBinaryData
end if
subDict.Add ("isBinary"), isBinary
subDict.Add ("name"), formname
parentDict.Add formname, subDict
if enableOrdinal_ then subOrinalDict.Add (item-1), formname
next
End Sub
Public Default Property Get form (formnameInput)
Dim finalFormNameOutPut
if varType(formnameInput) = vbLong and enableOrdinal_ then
if formnameInput <= count_ then finalFormNameOutPut = subOrinalDict.item(formnameInput)
else
finalFormNameOutPut = formnameInput
end if
if not parentDict.exists(finalFormNameOutPut) then
Set subDict = Server.CreateObject("Scripting.Dictionary")
subDict.Add ("isBinary"), false
subDict.Add ("name"), finalFormNameOutPut
parentDict.Add finalFormNameOutPut, subDict
end if
set form = parentDict (finalFormNameOutPut)
End Property
Public Property Get forms
forms = parentDict.items
End Property
Public Property Get Count
Count = count_
end Property
Public Function getFileName(formnameInput)
if parentDict.exists(formnameInput) then
if parentDict(formnameInput).Item("isBinary") then
Dim temp
temp = parentDict(formnameInput).Item("FileName")
getFileName = Mid(temp, 1 + InStrRev(temp, "\"))
else
getFileName = Null
end if
else
getFileName = null
end if
End Function
Public Function getFileExt(formnameInput)
if parentDict.exists(formnameInput) then
if parentDict(formnameInput).Item("isBinary") then
getFileExt = parentDict(formnameInput).Item("FileExt")
else
getFileExt = null
end if
else
getFileExt = null
end if
End Function
Private Function fileExt(byVal str)
str = ""&str
fileExt = lcase(Mid(str, InStrRev(str, ".")+1))
End Function
Public Function getContentType(formnameInput)
if parentDict.exists(formnameInput) then
if parentDict(formnameInput).Item("isBinary") then
getContentType = parentDict(formnameInput).Item("ContentType")
else
getContentType = null
end if
else
getContentType = null
end if
End Function
Public Function saveToFile(formnameInput, ByVal path)
If parentDict.Exists(formnameInput) Then
if parentDict(formnameInput).Item("isBinary") then
Dim temp
temp = parentDict(formnameInput).Item("Binary")
Dim fso, folder
path = Server.MapPath(path)
folder = left(path,instrRev(path,"\"))
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(folder) then fso.CreateFolder(folder)
Dim file, tPoint
Set file = fso.CreateTextFile(path)
file.Write temp
file.Close
Set fso = nothing
saveToFile = True
else
saveToFile = False
end if
Else
saveToFile = False
End If
End Function
End Class
%>