首页>ASP源码>文件数据
暂无资源
这是一个利用FSO集合对象编写的FSO文件浏览器（如果你非要说它是木马，我也不反对），在功能上仿照了“海洋顶端木马”设计，不过代码完全是重写的，没有使用如Shell.Application等容易造成杀毒软件误杀的组件。类似的工具网上有很多，本工具使用价值不是很大，但其中的很多代码自认为写的不错的。

主要功能包括：

磁盘信息查看
磁盘文件浏览
类似WindowsExplorer的操作方式
新建、删除、改名、复制、移动等基本文件操作
文本文件编辑
Stream方式文件下载
精简优化的无组件上传
文件打包/解包，一个文件夹可以完整地被打包/解包

代码片断：

1. 文件打包/解包部分

  1. ============================ 文件打包及解包过程 =============================
  2. 文件打包
  3. Sub Pack(ByVal FPath, ByVal sDbPath)
  4.     Server.ScriptTimeOut=900
  5.     Dim DbPath
  6.     If Right(sDbPath,4)=".mdb" Then
  7.         DbPath=sDbPath
  8.     Else
  9.         DbPath=sDbPath".mdb"
  10.     End If
  11.  
  12.     If oFso.FolderExists(DbPath) Then
  13.         EchoBack "不能创建数据库文件！"&Replace(DbPath,"","\")
  14.         Exit Sub
  15.     End If
  16.     If oFso.FileExists(DbPath) Then
  17.         oFso.DeleteFile DbPath
  18.     End If
  19.  
  20.     If IsFolder(FPath) Then
  21.         RootPath=GetParentFolder(FPath)
  22.         If Right(RootPath,1)<>"" Then RootPath=RootPath&""
  23.     Else
  24.         EchoBack "请输入文件夹路径！"
  25.         Exit Sub
  26.     End If
  27.  
  28.     Dim oCatalog,connStr,DataName
  29.     Set conn=Server.CreateObject("ADODB.Connection")
  30.     Set oStream=Server.CreateObject("ADODB.Stream")
  31.     Set oCatalog=Server.CreateObject("ADOX.Catalog")
  32.     Set rs=Server.CreateObject("ADODB.RecordSet")
  33.     On Error Resume Next
  34.     connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
  35.     oCatalog.Create connStr
  36.     If Err Then
  37.         EchoBack "不能创建数据库文件！"&Replace(DbPath,"","\")
  38.         Exit Sub
  39.     End If
  40.     Set oCatalog=Nothing
  41.     conn.Open connStr
  42.     conn.Execute("Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)")
  43.     oStream.Open
  44.     oStream.Type=1
  45.     rs.Open "Files",conn,3,3
  46.     DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name,".")-1)
  47.     NoPackFiles=Replace(NoPackFiles,"<$datafile>",DataName)
  48.  
  49.     FailFileList=""         打包失败的文件列表
  50.     PackFolder FPath
  51.     If FailFilelist="" Then
  52.         EchoClose "文件夹打包成功！"
  53.     Else
  54.         Response.Write "<link rel= stylesheet  type= text/css  href= ?page=css >"
  55.         Response.Write "<Script Language= JavaScript >alert( 文件夹打包完成！n以下是打包失败的文件列表： );</Script>"
  56.         Response.Write "<body>"&Replace(FailFilelist,"|","<br>")"</body>"
  57.     End If
  58.     oStream.Close
  59.     rs.Close
  60.     conn.Close
  61. End Sub
  62. 添加文件夹（递归）
  63. Sub PackFolder(FolderPath)
  64.     If Not IsFolder(FolderPath) Then Exit Sub
  65.     Dim oFolder,sFile,sFolder
  66.     Set oFolder=oFso.GetFolder(FolderPath)
  67.     For Each sFile In oFolder.Files
  68.         If InStr(NoPackFiles,"|"&sFile.Name"|")<1 Then
  69.             PackFile sFile.Path
  70.         End If
  71.     Next
  72.     Set sFile=Nothing
  73.     For Each sFolder In oFolder.SubFolders
  74.         PackFolder sFolder.Path
  75.     Next
  76.     Set sFolder=Nothing
  77. End Sub
  78. 添加文件
  79. Sub PackFile(FilePath)
  80.     Dim RelPath
  81.     RelPath=Replace(FilePath,RootPath,"")
  82.      Response.Write RelPath & "<br>"
  83.     On Error Resume Next
  84.     Err.Clear
  85.     Err=False
  86.     oStream.LoadFromFile FilePath
  87.     rs.AddNew
  88.     rs("FilePath")=RelPath
  89.     rs("FileData")=oStream.Read()
  90.     rs.Update
  91.     If Err Then
  92.          一个文件打包失败
  93.         FailFilelist=FailFilelist&FilePath"|"
  94.     End If
  95. End Sub
  96.  
  97. ===========================================================================
  98. 文件解包
  99. Sub UnPack(vFolderPath,DbPath)
  100.     Server.ScriptTimeOut=900
  101.     Dim FilePath,FolderPath,sFolderPath
  102.     FolderPath=vFolderPath
  103.     FolderPath=Trim(FolderPath)
  104.     If Mid(FolderPath,2,1)<>":" Then
  105.         EchoBack "路径格式错误，无法创建改目录！"
  106.         Exit Sub
  107.     End If
  108.  
  109.     If Right(FolderPath,1)="" Then FolderPath=Left(FolderPath,Len(FolderPath)-1)
  110.     Dim connStr
  111.     Set conn=Server.CreateObject("ADODB.Connection")
  112.     Set oStream=Server.CreateObject("ADODB.Stream")
  113.     Set rs=Server.CreateObject("ADODB.RecordSet")
  114.     connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
  115.     On Error Resume Next
  116.     Err=False
  117.     conn.Open connStr
  118.     If Err Then
  119.         EchoBack "数据库打开错误！"
  120.         Exit Sub
  121.     End If
  122.     Err=False
  123.     oStream.Open
  124.     oStream.Type=1
  125.     rs.Open "Files",conn,1,1
  126.     FailFilelist=""         清空失败文件列表
  127.     Do Until rs.EOF
  128.         Err.Clear
  129.         Err=False
  130.         FilePath=FolderPath""&rs("FilePath")
  131.         FilePath=Replace(FilePath,"\","")
  132.         sFolderPath=Left(FilePath,InStrRev(FilePath,""))
  133.         If Not oFso.FolderExists(sFolderPath) Then
  134.             CreateFolder(sFolderPath)
  135.         End If
  136.         oStream.SetEos()
  137.         oStream.Write rs("FileData")
  138.         oStream.SaveToFile FilePath,2
  139.  
  140.         If Err Then         添加失败文件项目
  141.             FailFilelist=FailFilelist&rs("FilePath").Value"|"
  142.         End If
  143.  
  144.         rs.MoveNext
  145.     Loop
  146.     rs.Close
  147.     Set rs=Nothing
  148.     conn.Close
  149.     Set conn=Nothing
  150.     Set oStream=Nothing
  151.     If FailFilelist="" Then
  152.         EchoClose "文件解包成功！"
  153.     Else
  154.         Response.Write "<link rel= stylesheet  type= text/css  href= ?page=css >"
  155.         Response.Write "<Script Language= JavaScript >alert( 文件夹打包完成！n以下是打包失败的文件列表，请检查 );</Script>"
  156.         Response.Write "<body>"&Replace(FailFilelist,"|","<br>")"</body>"
  157.     End If
  158. End Sub
  159. ===========================================================================

 

2. 文件上传部分（单一文件）：

  1. 保存上传文件
  2. Sub Saveupload(ByVal FolderName)
  3.     If Not IsFolder(FolderName) Then
  4.         EchoClose "没有指定上传的文件夹！"
  5.         Exit Sub
  6.     End If
  7.     Dim Path,IsOverWrite
  8.     Path=FolderName
  9.     If Right(Path,1)<>"" Then Path=Path&""
  10.     FileName=Replace(Request("filename"),"","")
  11.     If Len(FileName)<1 Then
  12.         EchoBack "请选择文件并输入文件名！"
  13.         Exit Sub
  14.     End If
  15.     Path=Path
  16.     If LCase(Request("overwrite"))="true" Then
  17.         IsOverWrite=True
  18.     Else
  19.         IsOverWrite=False
  20.     End If
  21.     On Error Resume Next
  22.     Call MyUpload(Path,IsOverWrite)
  23.     If Err Then
  24.         EchoBack "文件上传失败！（可能是文件已存在）"
  25.     Else
  26.         EchoClose "文件上传成功!n" & Replace(fileName, "", "\")
  27.     End If
  28. End Sub
  29. 文件上传核心代码
  30. Sub MyUpload(FilePath,IsOverWrite)
  31.     Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf
  32.     RequestSize=Request.TotalBytes
  33.     If RequestSize<1 Then Exit Sub
  34.     Set oStream=Server.CreateObject("ADODB.Stream")
  35.     Set tStream=Server.CreateObject("ADODB.Stream")
  36.     With oStream
  37.         .Type=1
  38.         .Mode=3
  39.         .Open
  40.         .Write=Request.BinaryRead(RequestSize)
  41.         .Position=0
  42.         sData=.Read
  43.         bCrLf=ChrB(13)&ChrB(10)
  44.         iSpaceEnd=InStrB(sData,bCrLf)-1
  45.         sSpace=LeftB(sData,iSpaceEnd)
  46.         iInfoStart=iSpaceEnd+3
  47.         iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1
  48.         iFileStart=iInfoEnd+5
  49.         iFileEnd=InStrB(iFileStart,sData,sSpace)-3
  50.         sData=""     清空文件数据
  51.         iFileSize=iFileEnd-iFileStart+1
  52.         tStream.Type=1
  53.         tStream.Mode=3
  54.         tStream.Open
  55.         .Position=iFileStart-1
  56.         .CopyTo tStream,iFileSize
  57.         If IsOverWrite Then
  58.             tStream.SaveToFile FilePath,2
  59.         Else
  60.             tStream.SaveToFile FilePath
  61.         End If
  62.         tStream.Close
  63.         .Close
  64.     End With
  65.     Set tStream=Nothing
  66.     Set oStream=Nothing
  67. End Sub

 
展开
附加信息
相关应用
为您推荐
相关资讯 全部