首页 开发教程 正文
我要发布

FSO文件浏览器

开发教程
2025-12-06 0 300

这是一个利用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

 


下载源码

收藏 (0) 打赏

感谢您的支持，我会继续努力的!

打开微信/支付宝扫一扫，即可进行扫码打赏哦，分享从这里开始，精彩与您同在
点赞 (0)

申明：本文由第三方发布，内容仅代表作者观点，与本网站无关。对本文以及其中全部或者部分内容的真实性、完整性、及时性本站不作任何保证或承诺，请读者仅作参考，并请自行核实相关内容。本网发布或转载文章出于传递更多信息之目的，并不意味着赞同其观点或证实其描述，也不代表本网对其真实性负责。

左子网 开发教程 FSO文件浏览器 https://www.zuozi.net/5645.html

ASP数据库字串批量替换工
上一篇： ASP数据库字串批量替换工
Asp Access 查询分析器
下一篇： Asp Access 查询分析器
常见问题

发货方式是什么？

  • 1、自动：拍下后，点击（下载）链接即可下载；2、手动：拍下后，联系卖家发放即可或者联系官方找开发者发货。
查看详情

交易周期是多久呢？

  • 1、源码默认交易周期：手动发货商品为1-3天，并且用户付款金额将会进入平台担保直到交易完成或者3-7天即可发放，如遇纠纷无限期延长收款金额直至纠纷解决或者退款！；
查看详情

能退款么？

  • 1、描述：源码描述(含标题)与实际源码不一致的（例：货不对板）； 2、演示：有演示站时，与实际源码小于95%一致的（但描述中有”不保证完全一样、有变化的可能性”类似显著声明的除外）； 3、发货：不发货可无理由退款； 4、安装：免费提供安装服务的源码但卖家不履行的； 5、收费：价格虚标，额外收取其他费用的（但描述中有显著声明或双方交易前有商定的除外）； 6、其他：如质量方面的硬性常规问题BUG等。 注：经核实符合上述任一，均支持退款，但卖家予以积极解决问题则除外。
查看详情

注意事项

  • 1、左子会对双方交易的过程及交易商品的快照进行永久存档，以确保交易的真实、有效、安全！ 2、左子无法对如“永久包更新”、“永久技术支持”等类似交易之后的商家承诺做担保，请买家自行鉴别； 3、在源码同时有网站演示与图片演示，且站演与图演不一致时，默认按图演作为纠纷评判依据（特别声明或有商定除外）； 4、在没有”无任何正当退款依据”的前提下，商品写有”一旦售出，概不支持退款”等类似的声明，视为无效声明； 5、在未拍下前，双方在QQ上所商定的交易内容，亦可成为纠纷评判依据（商定与描述冲突时，商定为准）； 6、因聊天记录可作为纠纷评判依据，故双方联系时，只与对方在左子上所留的QQ、手机号沟通，以防对方不承认自我承诺。 7、虽然交易产生纠纷的几率很小，但一定要保留如聊天记录、手机短信等这样的重要信息，以防产生纠纷时便于左子介入快速处理。
查看详情

相关文章

猜你喜欢
发表评论
暂无评论
官方客服团队

为您解决烦忧 - 24小时在线 专业服务

联系官方团队 在线提交工单
TA的动态
左子网

分享最新WordPress教程共同学习，共同进步，共同成长！

QQ交流群
左子网

QQ交流群

您的支持，是我们最大的动力！ https://qm.qq.com/q/iR7Nj0TrOg
热门文章
热门标签
随机推荐
热门评论
终身VIP会员限时钜惠
首页 源码 菜单 案例 我的