• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    FSO操作文件系统

    实现功能:
    文件(夹)目录列表 提供了查阅目录下面的文件和文件夹
    文件 写,创,删 提供了编辑,删除文件(文件夹)的操作
    创建文件夹/文件 针对创建文件夹(文件)而设置.
    上传文件 您可以模拟FTP上传,文件大小,类型不受限制. 

    有兴趣的自己体验,出现任何问题我均不承担任何后果,在此说,我没多少时间上网,经常也顾不过来,是看到最近经常有人问这方面的问题,就发上来,希望有所帮助。

    upfso.asp //控制上传的文件

    复制代码 代码如下:

    !--#include file="upload.asp" -->
    %'On Error Resume Next%>
    STYLE type="text/css"> @import url("admin.css");/STYLE>
    %
    Server.ScriptTimeOut = 999
    'up_filetype="RAR,ZIP,SWF,JPG,PNG,GIF,DOC,TXT,CHM,PDF,ACE,JPG,MP3,WMA,WMV,bmp"
        IF Request.QueryString("yes")="upload" Then
        path=Trim(request("path"))
        'response.write(path"---")
        'response.End 
            Dim FSO,FSOIsOK,F_FileName,mode
            F_FileName=Trim(request("nn"))
            mode =killint(Trim(request("mode")),0,0,2)
            FSOIsOK=1
            Set FSO=Server.CreateObject("Scripting.FileSystemObject")
            If Err>0 Then
                Err.Clear
                FSOIsOK=0
            End If
            Dim D_Name,F_Name
            If FSOIsOK=1 Then
                        If InStr(1,path,":\")=0 Then 
                        path=Replace(Lcase(path),"\","/")
                        path = server.mappath(path)
                        path=Replace(path"/","//","/")
                        Else
                        path=Replace(Lcase(path),"/","\")
                        path=Replace(path"\","\\","\")
                        End If 
                    if not fso.folderexists(path) Then
                    response.write "a href=""javascript:history.back()"">font color='#000080'>基本路径查找失败,返回/font>/a>"

                    response.End 
                    End If
            End If
            Set FSO=Nothing
            Dim FileUP
            Set FileUP=New Upload_File
            FileUP.GetDate(-1)
            Dim  F_FileType, F_File
            Set F_File=FileUP.File("File")
                If Len(F_FileName)2 Then     F_FileName = F_File.FileName
                If Len(F_FileName)2 Then 
                response.write("a href='javascript:history.go(-1);'>font color='#000080'>空文件,请返回/font>/a>")
                response.End
                End If 
            'F_FileType = Ucase(F_File.FileExt)
            'IF F_File.FileSize > 90000 Then
            '    Response.Write("a href='javascript:history.go(-1);'>大小超过限制/a>")
            'exit sub
            IF IsvalidFileName(F_FileName) = False Then
                Response.Write("a href='javascript:history.go(-1);'>font color='#000080'>名称有误/font>/a>")
            Else
                Dim FileIsExists
                Set FSO=Server.CreateObject("Scripting.FileSystemObject")
                    FileIsExists=FSO.FileExists(pathF_FileName)
                If FileIsExists=True  And  mode>1 Then 
                fso.deletefile(pathF_FileName)
                Response.Write("font color='#000080'>文件已经存在,已经被删除/b>/a>;")
                F_File.SaveToFile pathF_FileName
                Response.Write("a href='upfso.asp?action=fsopath="path"'>b>font color='#000080'>点击这里继续上传:"pathF_FileName"/font>/b>/a>")
                ElseIf FileIsExists=True  And  mode=1 Then
                Response.Write("font color='#000080'>文件已经存在,您选择了不覆盖/font>/b>")
                Else
                F_File.SaveToFile pathF_FileName
                Response.Write("a href='upfso.asp?action=fsopath="path"'>b>font color='#000080'>点击这里继续上传:"pathF_FileName"/font>/b>/a>")
                End If 
            End IF
            Set F_File=Nothing
            Set FileUP=Nothing
        Else
                Dim path,nn,mmode
                nn=Trim(request("nn"))
                mmode=Trim(request("mode"))
                path=Replace(request("path"),"//","/")
                If path="" Then path="../newup/"
            Response.Write("form enctype=""multipart/form-data"" method=""post"" action=""upfso.asp?yes=uploadpath="path"nn="nn"mode="mmode""" class=""admin_fso_up"" onsubmit=""CheckForm()""  name='form'>label>选择:input name=""File"" type=""File""  size=""20""/>/label>label> input type=""Submit"" name=""Submit"" class=""submit"" value="" 上传 "" />/label>/form>")
        End IF

    '效验名称
    Function IsvalidFileName(File_Name)
        IsvalidFileName = False
        Dim re,reStr
        Set re=new RegExp
        re.IgnoreCase =True
        re.Global=True
        re.Pattern="[^_\.a-zA-Z\d]"
        reStr=re.Replace(File_Name,"")
        If File_Name = reStr Then IsvalidFileName=True
        Set re=Nothing
    End Function

    %>

    upload.asp // 上传类
    复制代码 代码如下:

    %
    Dim oUpFileStream

    Class Upload_File

        Dim Form,File,Err

        Private Sub Class_Initialize
            Err=-1
        End Sub

        Private Sub Class_Terminate 
            'Clear Variables  Objects
            If Err  0 Then
                oUpFileStream.Close
                Form.RemoveAll
                File.RemoveAll
                Set Form=Nothing
                Set File=Nothing
                Set oUpFileStream =Nothing
            End If
        End Sub

        Public Sub GetDate(RetSize)
            'Define Variables
            Dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
            Dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
            Dim iFindStart,iFindEnd
            Dim iFormStart,iFormEnd,sFormName

            If Request.TotalBytes  1 Then
                Err=1
                Exit Sub
            End If
            If RetSize > 0 Then 
                If Request.TotalBytes > RetSize Then
                    Err=2
                    Exit Sub
                End If
            End If
            Set Form = Server.CreateObject("Scripting.Dictionary")
            Form.CompareMode = 1
            Set File = Server.CreateObject("Scripting.Dictionary")
            File.CompareMode = 1
            Set tStream = Server.CreateObject("Adodb.Stream")
            Set oUpFileStream = Server.CreateObject("Adodb.Stream")
            oUpFileStream.Type = 1
            oUpFileStream.Mode = 3
            oUpFileStream.Open 
            oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)
            oUpFileStream.Position=0
            RequestBinDate = oUpFileStream.Read 
            iFormEnd = oUpFileStream.Size
            bCrLf = chrB(13)  chrB(10)
            'Get Seperators
            sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
            iStart = LenB (sStart)
            iFormStart = iStart+2
            'Split Items
            Do
                iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf  bCrLf)+3
                tStream.Type = 1
                tStream.Mode = 3
                tStream.Open
                oUpFileStream.Position = iFormStart
                oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
                tStream.Position = 0
                tStream.Type = 2
                tStream.Charset = "UTF-8"
                sInfo = tStream.ReadText 
                'Get form item name
                iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1
                iFindStart = InStr(22,sInfo,"name=""",1)+6
                iFindEnd = InStr(iFindStart,sInfo,"""",1)
                sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
                'If it's a file
                If InStr (45,sInfo,"filename=""",1) > 0 Then
                    Set oFileInfo= new FileInfo
                    'Get File attributes
                    iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
                    iFindEnd = InStr(iFindStart,sInfo,"""",1)
                    sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
                    oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
                    oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\"))
                    oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
                    iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
                    iFindEnd = InStr(iFindStart,sInfo,vbCr)
                    oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
                    oFileInfo.FileStart = iInfoEnd
                    oFileInfo.FileSize = iFormStart -iInfoEnd -2
                    oFileInfo.FormName = sFormName
                    file.add sFormName,oFileInfo
                Else
                    'If it's form item
                    tStream.Close
                    tStream.Type = 1
                    tStream.Mode = 3
                    tStream.Open
                    oUpFileStream.Position = iInfoEnd 
                    oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
                    tStream.Position = 0
                    tStream.Type = 2
                    tStream.Charset = "UTF-8"
                    sFormvalue = tStream.ReadText 
                    If Form.Exists (sFormName) Then
                        Form (sFormName) = Form (sFormName)  ", "  sFormValue
                    Else
                        Form.Add sFormName,sFormvalue
                    End If
                End If
                tStream.Close
                iFormStart = iFormStart+iStart+2
                'Exit at end of file
            Loop Until (iFormStart+2) = iFormEnd 
            RequestBinDate=""
            Set tStream = Nothing
        End Sub

    End Class

        'Get File Info
    Class FileInfo
        Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt

        Private Sub Class_Initialize 
            FileName = ""
            FilePath = ""
            FileSize = 0
            FileStart= 0
            FormName = ""
            FileType = ""
            FileExt = ""
        End Sub

        'Save File Method
        Public Function SaveToFile(FullPath)
            Dim oFileStream,ErrorChar,i
            On Error Resume Next
            Set oFileStream=CreateObject("Adodb.Stream")
            oFileStream.Type=1
            oFileStream.Mode=3
            oFileStream.Open
            oUpFileStream.position=FileStart
            oUpFileStream.copyto oFileStream,FileSize
            oFileStream.SaveToFile FullPath,2
            oFileStream.Close
            Set oFileStream=Nothing
        End Function

        'Get File Content
        Public Function GetDate
            oUpFileStream.Position =FileStart
            GetDate=oUpFileStream.Read(FileSize)
        End Function
    End Class
    %>

    核心函数
    复制代码 代码如下:

    Dim theInstalledObjects(17)
        theInstalledObjects(0) = "MSWC.AdRotator"
        theInstalledObjects(1) = "MSWC.BrowserType"
        theInstalledObjects(2) = "MSWC.NextLink"
        theInstalledObjects(3) = "MSWC.Tools"
        theInstalledObjects(4) = "MSWC.Status"
        theInstalledObjects(5) = "MSWC.Counters"
        theInstalledObjects(6) = "IISSample.ContentRotator"
        theInstalledObjects(7) = "IISSample.PageCounter"
        theInstalledObjects(8) = "MSWC.PermissionChecker"
        theInstalledObjects(9) = "Scripting.FileSystemObject"
        theInstalledObjects(10) = "adodb.connection"
        theInstalledObjects(11) = "SoftArtisans.FileUp"
        theInstalledObjects(12) = "SoftArtisans.FileManager"
        theInstalledObjects(13) = "JMail.SMTPMail"
        theInstalledObjects(14) = "CDONTS.NewMail"
        theInstalledObjects(15) = "Persits.MailSender"
        theInstalledObjects(16) = "LyfUpload.UploadFile"
        theInstalledObjects(17) = "Persits.Upload.1"
    Dim fso
    If  IsObjInstalled(theInstalledObjects(9)) Then 
    Set fso =Server.CreateObject("Scripting.FileSystemObject")
    End If 
    Function IsObjInstalled(strClassString)
     On Error Resume Next
     IsObjInstalled = False
     Err = 0
     Dim xTestObj
     Set xTestObj = Server.CreateObject(strClassString)
     If 0 = Err Then IsObjInstalled = True
     Set xTestObj = Nothing
     Err = 0
    End Function
    '检查组件版本
    Public Function getver(Classstr)
     On Error Resume Next
     Dim xTestObj
     Set xTestObj = Server.CreateObject(Classstr)
     If Err Then
      getver=""
     else 
       getver=xTestObj.version
     end if
     Set xTestObj = Nothing
    End Function
    '效验名称
    Function IsvalidFileName(File_Name)
     IsvalidFileName = False
     Dim re,reStr
     Set re=new RegExp
     re.IgnoreCase =True
     re.Global=True
     re.Pattern="[^_\.a-zA-Z\d]"
     reStr=re.Replace(File_Name,"")
     If File_Name = reStr Then IsvalidFileName=True
     Set re=Nothing
    End Function
    '文件写入
    Function writeto(xmlfloder,xmlfile,content,mode)
    writeto=false
    If Not IsObjInstalled(theInstalledObjects(9)) Then Exit Function 
    mode=killint(mode,0,0,2)
    xmlfloder=server.mappath(xmlfloder)
    Set fso =Server.CreateObject("Scripting.FileSystemObject")
     if not fso.folderexists(xmlfloder) Then
     fso.createfolder(xmlfloder)
     End If
    xmlfile=replace(xmlfloder"\","\\","\")xmlfile
    ' response.write(warn_red(xmlfile))
    Dim fsoxml
    If fso.fileexists(xmlfile) And mode=1 Then '存在不写
     Exit Function 
    elseIf fso.fileexists(xmlfile) And mode=2 Then '重写
     Set fsoxml=fso.opentextfile(xmlfile,2)
     fsoxml.writeline(content)
     fsoxml.close
     writeto=true
    ElseIf fso.fileexists(xmlfile) And mode=8 Then '追加
     Set fsoxml=fso.opentextfile(xmlfile,8)
     fsoxml.writeline(content)
     fsoxml.close
     writeto=true
    ElseIf fso.fileexists(xmlfile) Then 
     Set fsoxml=fso.opentextfile(xmlfile,2)'重写
     fsoxml.writeline(content)
     fsoxml.close
     writeto=true
    Else
     Set fsoxml=fso.createtextfile(xmlfile)'创建
     fsoxml.writeline(content)
     fsoxml.close
     writeto=true
    End If 
    End Function
    '删除文件
    Function delaspfile(x)
    On Error Resume Next 
     delaspfile=False 
     If Not fileexitornot(x) Then 
     Exit Function 
     Else
     fso.deletefile server.mappath(x)
     delaspfile=True  
     End if 
    End Function
    '文件存在
    Function fileexitornot(file)
    On Error Resume Next 
    Dim f_re_file
    f_re_file=true 
    If not fso.fileexists(server.MapPath(file)) Then f_re_file=False 
    If err>0 Then f_re_file=False  
    fileexitornot=f_re_file
    End Function

    '错误抑制,打印错误
    Function show_err(err)
    On Error Resume Next 
    If err.Number > 0 Then 
    Response.Clear 
    Dim err_mess
    err_mess="b>发生错误:/b>br/>错误 Number: " err.Number"br/>错误信息:"err.Description"br/>出错文件:"err.Source"br/>出错行:"err.Line"(不被支持)br/>" err
    response.write(err_mess)
    End if
    End Function 
    '警告:
    Function warn_red(mess)
    warn_red="font color=red>b>跟踪:"mess"/b>/font>br/>"
    End Function 


    'FSO文件目录
    Function showallfile(path)
    'On Error Resume Next
    path=Replace(path,"//","/")
    set fso =  CreateObject("Scripting.FileSystemObject")
    Dim uploadPath,uploadfolder,objSubFolders,allfiles,fileitem,objSubFolder,
    sFileName
     If InStr(1,path,":\")=0 Then 
     path=Replace(path,"\","/")
     uploadPath = server.mappath(path)
     Else
     path=Replace(path,"/","\")
     uploadPath=path
     End If 
    response.write(warn_red(uploadPath))
    if not fso.folderexists(uploadPath) Then
    response.write warn_red("路径查找失败")
    Exit Function 
    End If 
    Set uploadfolder = fso.GetFolder(uploadPath)
    If uploadfolder.isrootfolder Then 
    response.write("b>根目录/b>br/>")
    Else
    response.write("b>font color=""#00008b"">父目录:/font>a href=""default.asp?action=fsothis=toppath="uploadfolder.parentfolder""">
    "uploadfolder.parentfolder" /a>/b>br/>") 

    End If 
    response.write("b>目录大小:"int(uploadfolder.size/1024)" KB/b>br/>") 
    set objSubFolders=uploadfolder.Subfolders
    Dim fso_mes
    fso_mes="ol>"
    for each objSubFolder in objSubFolders
    fso_mes=fso_mes "li>b>a href=""default.asp?action=fsothis=toppath="path"/"objSubFolder.name""">font color=blue>"  objSubFolder.name  "/font>/a>/b>/li>"
    next
    set allfiles = uploadfolder.Files
    for each fileitem in allfiles
     fso_mes=fso_mes "li>a href=""default.asp?action=fsothis=filepath="path"/"fileitem.Name""">"  fileitem.Name  "/a>/li>"
    Next
    fso_mes=fso_mes"/ol>"
    response.write(fso_mes)
    response.write deltext(uploadPath,1)
    End Function

     

    '文件属性
    Function filepro(name)
    name=Replace(name,"//","/")
    Dim whichfile
    If InStr(1,name,":\")=0 Then 
    name=Replace(name,"\","/")
    whichfile = server.mappath(name)
    Else
    name=Replace(name,"/","\")
    whichfile=name
    End If 
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.fileexists(whichfile) Then 
     response.write(warn_red("文件不存在或者无访问权限"))
     Exit Function 
    End If 
    Dim f2,s_mess
    Set f2 = fso.GetFile(whichfile)
    s_mess = "div class=""admin_post_form"">b>font color=""#00008b"">父目录:/font>a href=""default.asp?action=fsothis=toppath="f2.parentfolder""">"f2.parentfolder
    "/a>/b>br/>"
    s_mess = s_mess  "文件名称:"  f2.name  "br>"
    s_mess = s_mess  "文件短路径名:"  f2.shortPath  "br>"
    s_mess = s_mess  "文件物理地址:"  f2.Path  "br>"
    s_mess = s_mess  "文件属性:"  f2.Attributes  "br>"
    s_mess = s_mess  "文件大小: "  f2.size  "br>"
    s_mess = s_mess  "文件类型: "  f2.type  "br>"
    s_mess = s_mess  "文件创建时间: "  f2.DateCreated  "br>"
    s_mess = s_mess  "最近访问时间: "  f2.DateLastAccessed  "br>"
    s_mess = s_mess  "最近修改时间: "  f2.DateLastModified"br/>/div>"
    response.write(s_mess)
    If killint(Trim(request("type")),0,0,2)>0 Then 
    showtext(whichfile)
    End If 
    response.write deltext(whichfile,0)
    End Function 
    '
    SUB showtext(files)
     dim iStr,adosText,strasp
     set adosText=Server.CreateObject("ADODB.Stream")
     adosText.mode=3
     adosText.type=2
     adosText.charset="gb2312"
     'adosText.charset="big5"
     adosText.open
     If InStr(1,files,":\")=0 Then 
     files=Replace(files,"\","/")
     files = server.mappath(files)
     Else
     files=Replace(files,"/","\")
     files=files
     End If 
     adosText.loadFromFile (files)
     strasp=adosText.ReadText()
     adosText.close
     set adosText=nothing%>
    form method="post" class="admin_post_form" action="default.asp?action=fsothis=editmode=1">
     textarea id="txt" name="txt" rows="15" cols="60">%=Server.HTMLEncode(strasp)%>/textarea>
    label> input name="path" type="hidden" value="%=Trim(request("path"))%>"/>input type="submit" name="okedit" class="submit" value="确定编辑"> /label>
    /form>
    %End Sub
    Function deltext(file,mode)
    Dim deltext_mess
    deltext_mess="div class=""deltext"">"
    Select Case killint(mode,0,0,2)
    Case 0:
    deltext_mess=deltext_mess"文件操作:a href=""default.asp?action=fsothis=filepath="file""">属性/a>a  onclick=""{if(confirm('警告,非文本请不要读取,否则文件无法读取了,你坚持点击确定么?劝你点击取消')){return true;} return false;}"" href=""default.asp?action=fsothis=filepath="file"type=1"">font color=red>b>编辑/b>/font>/a>a href=""default.asp?action=fsothis=movepath="file""">移动/a>a href=""default.asp?action=fsothis=copypath="file"mode=0"">复制/a>a href=""default.asp?action=fsothis=renamepath="file"mode=0"">重命名/a>a  onclick=""{if(confirm('警告,删除操作不能恢复,小心使用!!!')){return true;} return false;}"" href=""default.asp?action=fsothis=delpath="file"mode=0"">font color=red>b>删除/b>/font>/a>"

    Case 1:
    deltext_mess=deltext_mess"文件夹操作:a href=""default.asp?action=fsothis=toppath="file""">列表/a>a href=""default.asp?action=fsothis=addpath="file"ff=1"">创建目录/a>a href=""default.asp?action=fsothis=addpath="file""">手建文件/a>a href=""default.asp?action=fsothis=uppath="file""">上传文件/a>a href=""default.asp?action=fsothis=movepath="file"mode=1"">移动/a>a href=""default.asp?action=fsothis=copypath="file"mode=1"">复制/a>a href=""default.asp?action=fsothis=renamepath="file"mode=1"">重命名/a>a  onclick=""{if(confirm('警告,删除操作不能恢复,以上列表的文件全部被删除,你坚持点击确定么?劝你点击取消')){return true;} return false;}"" href=""default.asp?action=fsothis=delpath="file"mode=1"">font color=red>b>删除/b>/font>/a>"

    End Select
    deltext_mess=deltext_mess"/div>"
    deltext=deltext_mess
    End Function

    上一篇:用ASP和SQL实现基于Web的事件日历
    下一篇:asp中用数据库生成不重复的流水号
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    FSO操作文件系统 FSO,操作,文件,系统,FSO,操作,