<% 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&"") 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&"") 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"");") response.flush end sub sub outputProcess (percent, status) percentage = percentage + percent response.write ("<"&"script>percentCom.innerText = '"&percentage&"%'") 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&_ "") 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 %>