[原创]发一个06年写的“FSO文件浏览器”

最新推荐文章于 2024-04-19 10:18:52 发布

Justin 86

最新推荐文章于 2024-04-19 10:18:52 发布

阅读量3.2k

点赞数

分类专栏： Web开发文章标签：浏览器 stylesheet javascript 数据库 path 杀毒软件

本文链接：https://blog.csdn.net/rssn_net/article/details/3405362

版权

Web开发专栏收录该内容

2 篇文章 0 订阅

订阅专栏

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

主要功能包括：

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

下载地址1： http://download.csdn.net/source/818771
下载地址2： http://down.chinaz.com/soft/24456.htm

代码片断：

1. 文件打包/解包部分

 
 '============================ 文件打包及解包过程 ============================= 
'文件打包 
Sub Pack(ByVal FPath, ByVal sDbPath)
    Server.ScriptTimeOut=900
    Dim DbPath
    If Right(sDbPath,4)=".mdb" Then
        DbPath=sDbPath
    Else
        DbPath=sDbPath".mdb"
    End If
    If oFso.FolderExists(DbPath) Then
        EchoBack "不能创建数据库文件！"&Replace(DbPath,"/","//")
        Exit Sub
    End If
    If oFso.FileExists(DbPath) Then
        oFso.DeleteFile DbPath
    End If
    If IsFolder(FPath) Then
        RootPath=GetParentFolder(FPath)
        If Right(RootPath,1)<>"/" Then RootPath=RootPath&"/"
    Else
        EchoBack "请输入文件夹路径！"
        Exit Sub
    End If
    Dim oCatalog,connStr,DataName
    Set conn=Server.CreateObject("ADODB.Connection")
    Set oStream=Server.CreateObject("ADODB.Stream")
    Set oCatalog=Server.CreateObject("ADOX.Catalog")
    Set rs=Server.CreateObject("ADODB.RecordSet")
    On Error Resume Next
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
    oCatalog.Create connStr
    If Err Then
        EchoBack "不能创建数据库文件！"&Replace(DbPath,"/","//")
        Exit Sub
    End If
    Set oCatalog=Nothing
    conn.Open connStr
    conn.Execute("Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)")
    oStream.Open
    oStream.Type=1
    rs.Open "Files",conn,3,3
    DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name,".")-1)
    NoPackFiles=Replace(NoPackFiles,"<$datafile>",DataName)
    FailFileList=""        '打包失败的文件列表 
    PackFolder FPath
    If FailFilelist="" Then
        EchoClose "文件夹打包成功！"
    Else
        Response.Write "<link rel='stylesheet' type='text/css' href='?page=css'>"
        Response.Write "<Script Language='JavaScript'>alert('文件夹打包完成！/n以下是打包失败的文件列表：');</Script>"
        Response.Write "<body>"&Replace(FailFilelist,"|","<br>")"</body>"
    End If
    oStream.Close
    rs.Close
    conn.Close
End Sub
'添加文件夹（递归） 
Sub PackFolder(FolderPath)
    If Not IsFolder(FolderPath) Then Exit Sub
    Dim oFolder,sFile,sFolder
    Set oFolder=oFso.GetFolder(FolderPath)
    For Each sFile In oFolder.Files
        If InStr(NoPackFiles,"|"&sFile.Name"|")<1 Then
            PackFile sFile.Path
        End If
    Next
    Set sFile=Nothing
    For Each sFolder In oFolder.SubFolders
        PackFolder sFolder.Path
    Next
    Set sFolder=Nothing
End Sub
'添加文件 
Sub PackFile(FilePath)
    Dim RelPath
    RelPath=Replace(FilePath,RootPath,"")
    'Response.Write RelPath & "<br>" 
    On Error Resume Next
    Err.Clear
    Err=False
    oStream.LoadFromFile FilePath
    rs.AddNew
    rs("FilePath")=RelPath
    rs("FileData")=oStream.Read()
    rs.Update
    If Err Then
        '一个文件打包失败 
        FailFilelist=FailFilelist&FilePath"|"
    End If
End Sub
'=========================================================================== 
'文件解包 
Sub UnPack(vFolderPath,DbPath)
    Server.ScriptTimeOut=900
    Dim FilePath,FolderPath,sFolderPath
    FolderPath=vFolderPath
    FolderPath=Trim(FolderPath)
    If Mid(FolderPath,2,1)<>":" Then
        EchoBack "路径格式错误，无法创建改目录！"
        Exit Sub
    End If
    If Right(FolderPath,1)="/" Then FolderPath=Left(FolderPath,Len(FolderPath)-1)
    Dim connStr
    Set conn=Server.CreateObject("ADODB.Connection")
    Set oStream=Server.CreateObject("ADODB.Stream")
    Set rs=Server.CreateObject("ADODB.RecordSet")
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
    On Error Resume Next
    Err=False
    conn.Open connStr
    If Err Then
        EchoBack "数据库打开错误！"
        Exit Sub
    End If
    Err=False
    oStream.Open
    oStream.Type=1
    rs.Open "Files",conn,1,1
    FailFilelist=""        '清空失败文件列表 
    Do Until rs.EOF
        Err.Clear
        Err=False
        FilePath=FolderPath"/"&rs("FilePath")
        FilePath=Replace(FilePath,"//","/")
        sFolderPath=Left(FilePath,InStrRev(FilePath,"/"))
        If Not oFso.FolderExists(sFolderPath) Then
            CreateFolder(sFolderPath)
        End If
        oStream.SetEos()
        oStream.Write rs("FileData")
        oStream.SaveToFile FilePath,2
        If Err Then        '添加失败文件项目 
            FailFilelist=FailFilelist&rs("FilePath").Value"|"
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs=Nothing
    conn.Close
    Set conn=Nothing
    Set oStream=Nothing
    If FailFilelist="" Then
        EchoClose "文件解包成功！"
    Else
        Response.Write "<link rel='stylesheet' type='text/css' href='?page=css'>"
        Response.Write "<Script Language='JavaScript'>alert('文件夹打包完成！/n以下是打包失败的文件列表，请检查');</Script>"
        Response.Write "<body>"&Replace(FailFilelist,"|","<br>")"</body>"
    End If
End Sub
'=========================================================================== 
 

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

 
 '保存上传文件 
Sub Saveupload(ByVal FolderName)
    If Not IsFolder(FolderName) Then
        EchoClose "没有指定上传的文件夹！"
        Exit Sub
    End If
    Dim Path,IsOverWrite
    Path=FolderName
    If Right(Path,1)<>"/" Then Path=Path&"/"
    FileName=Replace(Request("filename"),"/","")
    If Len(FileName)<1 Then
        EchoBack "请选择文件并输入文件名！"
        Exit Sub
    End If
    Path=Path
    If LCase(Request("overwrite"))="true" Then
        IsOverWrite=True
    Else
        IsOverWrite=False
    End If
    On Error Resume Next
    Call MyUpload(Path,IsOverWrite)
    If Err Then
        EchoBack "文件上传失败！（可能是文件已存在）"
    Else
        EchoClose "文件上传成功!/n" & Replace(fileName, "/", "//")
    End If
End Sub
'文件上传核心代码 
Sub MyUpload(FilePath,IsOverWrite)
    Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf
    RequestSize=Request.TotalBytes
    If RequestSize<1 Then Exit Sub
    Set oStream=Server.CreateObject("ADODB.Stream")
    Set tStream=Server.CreateObject("ADODB.Stream")
    With oStream
        .Type=1
        .Mode=3
        .Open
        .Write=Request.BinaryRead(RequestSize)
        .Position=0
        sData=.Read
        bCrLf=ChrB(13)&ChrB(10)
        iSpaceEnd=InStrB(sData,bCrLf)-1
        sSpace=LeftB(sData,iSpaceEnd)
        iInfoStart=iSpaceEnd+3
        iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1
        iFileStart=iInfoEnd+5
        iFileEnd=InStrB(iFileStart,sData,sSpace)-3
        sData=""    '清空文件数据 
        iFileSize=iFileEnd-iFileStart+1
        tStream.Type=1
        tStream.Mode=3
        tStream.Open
        .Position=iFileStart-1
        .CopyTo tStream,iFileSize
        If IsOverWrite Then
            tStream.SaveToFile FilePath,2
        Else
            tStream.SaveToFile FilePath
        End If
        tStream.Close
        .Close
    End With
    Set tStream=Nothing
    Set oStream=Nothing
End Sub 
 

Justin 86

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
1
评论
[原创]发一个06年写的“FSO文件浏览器”

这是一个利用FSO集合对象编写的FSO文件浏览器（如果你非要说它是木马，我也不反对），在功能上仿照了“海洋顶端木马”设计，不过代码完全是重写的，没有使用如Shell.Application等容易造成杀毒软件误杀的组件。类似的工具网上有很多，本工具使用价值不是很大，但其中的很多代码自认为写的不错的。主要功能包括：磁盘信息查看磁盘文件浏览类似WindowsExplorer的
复制链接

扫一扫