登录 | 注册 | 购书 New!
卓越网购书 当当网购书 京东网购书
| 铃声下载 | PDF电子书下载 | DVD/CD媒体下载 | 绿色软件下载 | 最新源码 | 今天最热门 | 加入收藏 | 繁體中文 
首页 ASP源码 PHP源码 DotNET源码 JSP源码 CGI源码 FLASH源码 VB源码 VC源码 PB源码 Delphi源码 编程相关 设计方案 网页模板

FSO文件浏览器 v1.0

  • 源码作者:佚名
  • 源码大小:30.15 MB
  • 源码类别:ASP源码
  • 源码格式:完整源码
  • 发布时间:Jul 3, 2013 11:57:00 AM
  • 源码级别:
  • 下载总计:月:0 总:652

源码简介:

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

 



关键字:fso,文件,浏览器,v1.0

重要事项Attentions

  • 本站所有源码都经过我们亲自检查,杀毒,确保每个源码都能正常运行.
  • 为了保证您快速的下载,推荐使用[网际快车]或[迅雷]等专业工具下载.
  • 本站无限制人数下载!如果您发现该源码不能下载,请通知管理员.或先看看下载教程.
  • 为确保所下源码能正常使用,请使用[WinRAR v3.70]或以上版本解压本站源码.
  • 如果你下载的源码是7z,gz格式的话,请安装该类型的解压软件。
  • 站内源码包含整站及企业源码均由网上搜集,若无意中侵犯到您的权利,敬请来信联系我们.
  • 如果需要解压密码的话,解压密码就是:code.anysafer.com