结合FSO操作写的一个Class

刺骨的言语ヽ痛彻心扉 2022-09-18 05:51 153阅读 0赞

《**结合FSO操作写的一个Class**》  
  
尚在完善中,基本功能已具备.  
也可作为初学者的教程

![程序代码][code.gif] 程序代码

<%  
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\* CDS系统 FSO操作类 Beta1 \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*  
'调用方法: Set Obj=New FSOControl  
'所有路径必须为绝对路径,请采用Server.MapPath方法转换路径后再定义变量  
'------ FileRun ---------------------------------------  
'  
'必选参数:  
'FilePath ------ 处理文件路径  
'  
'可选参数:  
'FileAllowType ------ 处理文件允许的类型,定义方法例: gif|jpg|png|txt  
'FileNewDir ------ 文件处理后保存到的目录  
'FileNewName ------ 新文件名前缀,请不要添加后缀, 例: sample.txt 则为 sample  
'CoverPr ------ 是否覆盖已有的文件 0为否 1为是 默认为1  
'deletePr ------ 是否删除原文件 0为否 1为是 默认为1  
'---------------------------------------------------------  
  
'------ UpDir(path) 取path的父目录  
'path可为文件,也可为目录  
  
'------ GetPrefixName(path) 取文件名前缀  
'path必须为文件,可为完整路径,也可是单独文件名  
  
'------ GetFileName(path) 取文件名  
'path必须为文件,可为完整路径,也可是单独文件名  
  
'------ GetExtensionName(path) 取文件名后缀,不包含"."  
'path必须为文件,可为完整路径,也可是单独文件名  
  
'------ FileIs(path) path是否为一文件  
'如为,返回 true 否则返回 false  
'------ FolderCreat(Path)  
'------ Folderdelete(Path,FileIF)  
'------ FileCopy(Path\_From,Path\_To,CoverIF)  
'------ FileMove(Path\_From,Path\_To,CoverIF)  
'------ Filedelete(Path)  
'------ Filerename(OldName,NewName,CoverIf)  
  
Class FSOControl  
  
Dim FSO  
  Private File\_Path,File\_AllowType,File\_NewFolder\_Path,File\_NewName,File\_CoverIf,File\_deleteIf  
  Public Property Let FilePath(StrType)  
    File\_Path=StrType  
  End Property  
  Public Property Let FileAllowType(StrType)  
    File\_AllowType=StrType  
  End Property  
  Public Property Let FileNewDir(StrType)  
    File\_NewFolder\_Path=StrType  
  End Property  
  Public Property Let FileNewName(StrType)  
    File\_NewName=StrType  
  End Property  
  Public Property Let CoverPr(LngSize)  
    If isNumeric(LngSize) then  
      File\_CoverIf=Clng(LngSize)  
    End If  
  End Property  
  Public Property Let deletePr(LngSize)  
    If isNumeric(LngSize) then  
      File\_deleteIf=Clng(LngSize)  
    End If  
  End Property  
  
  Private Sub Class\_Initialize()  
    Set FSO=createObject("Scripting.FileSystemObject")   
    File\_Path=""  
    File\_AllowType="gif|jpg|png|txt"  
    File\_NewFolder\_Path=""  
    File\_NewName=""  
    File\_CoverIf=1  
    File\_deleteIf=0  
  End Sub   
  Private Sub Class\_Terminate()  
    Err.Clear  
    Set FSO=Nothing  
  End Sub  
    
  
  Public Function UpDir(ByVal D)  
    If Len(D) = 0 then  
      UpDir=""  
    Else  
      UpDir=Left(D,InStrRev(D,"/")-1)  
    End If  
  End Function  
  Public Function GetPrefixName(ByVal D)  
    If Len(D) = 0 then  
      GetPrefixName=""  
    Else  
      FileName=GetFileName(D)  
      GetPrefixName=Left(FileName,InStrRev(FileName,".")-1)  
    End If  
  End Function  
  Public Function GetFileName(name)  
    FileName=Split(name,"/")  
    GetFileName=FileName(Ubound(FileName))  
  End Function  
  Public Function GetExtensionName(name)  
    FileName=Split(name,".")  
    GetExtensionName=FileName(Ubound(FileName))  
  End Function  
  Public Function FileIs(Path)  
    If fso.FileExists(Path) then  
      FileIs=true  
    Else  
      FileIs=false  
    End If  
  End Function  
  
  Public Function FileOpen(Path,NewFile,ReadAction,LineCount)  
    If FileIs(Path)=False then  
      If NewFile<>1 then  
        FileOpen=False  
      ElseIf FolderIs(UpDir(Path))=False then  
        FileOpen=False  
        Exit Function  
      Else  
        fso.OpenTextFile Path,1,True  
        FileOpen=""  
      End If  
      Exit Function  
    End If  
    Set FileOption=fso.GetFile(Path)  
    If FileOption.size=0 then  
      Set FileOption=Nothing  
      FileOpen=""  
      Exit Function  
    End If  
    Set FileOption=Nothing  
    Set FileText=fso.OpenTextFile(Path,1)  
    If IsNumeric(ReadAction) then  
      FileOpen=FileText.Read(ReadAction)  
    ElseIf Ucase(ReadAction)="ALL" then  
      FileOpen=FileText.ReadAll()  
    ElseIf Ucase(ReadAction)="LINE" then  
      If Not(IsNumeric(LineCount)) or LineCount=0 then  
        FileOpen=False  
        Set FileText=Nothing  
        Exit Function  
      Else  
        i=0  
        Do While Not FileText.AtEndOfStream  
          FileOpen=FileOpen&FileText.ReadLine  
          i=i+1  
          If i=LineCount then Exit Do  
        Loop  
      End If  
    End If  
    Set FileText=Nothing      
  End Function  
  
  Public Function FileWrite(Path,WriteStr,NewFile)  
    If FolderIs(UpDir(Path))=False then  
      FileWrite=False  
      Exit Function  
    ElseIf FileIs(Path)=False and NewFile<>1 then  
      FileWrite=False  
      Exit Function  
    End If  
    Set FileText=fso.OpenTextFile(Path,2,True)  
    FileText.Write WriteStr  
    Set FileText=Nothing  
    FileWrite=True  
  End Function  
  
  Public Function FolderIs(Path)  
    If fso.FolderExists(Path) then  
      FolderIs=true  
    Else  
      FolderIs=false  
    End If  
  End Function  
  Public Function FolderCreat(Path)  
    If fso.FolderExists(Path) then  
      FolderCreat="指定要创建目录已存在"  
      Exit Function  
    ElseIf Not(fso.FolderExists(UpDir(Path))) then  
      FolderCreat="指定要创建的目录路径错误"  
      Exit Function  
    End If  
    fso.createFolder(Path)  
    FolderCreat=True  
  End Function  
  Public Function Folderdelete(Path,FileIF)  
    If Not(fso.FolderExists(Path)) then  
      Folderdelete="指定要删除的目录不存在"  
      Exit Function  
    End If  
    If FileIF=1 then  
      Set FsoFile = Fso.GetFolder(Path)  
      If(FsoFile.SubFolders.count>0 or FsoFile.Files.count>0) then  
        Set FsoFile=Nothing  
        Folderdelete="只要要删除的目录下含有文件或子目录,不允许删除"  
        Exit Function  
      End If  
      Set FsoFile=Nothing  
    End If  
    Fso.deleteFolder(Path)  
    Folderdelete=True  
  End Function  
  Public Function FileCopy(Path\_From,Path\_To,CoverIF)  
    If Not(fso.FileExists(Path\_From)) then  
      FileCopy="指定要复制的文件不存在"  
      Exit Function  
    ElseIf Not(fso.FolderExists(UpDir(Path\_To))) then  
      FileCopy="指定要复制到的目录不存在"  
      Exit Function  
    End If  
    If CoverIF=0 and fso.FileExists(Path\_To) then  
      FileCopy="指定要复制到的目录下已存在相同名称文件,不允许覆盖"  
      Exit Function  
    End If  
    fso.CopyFile Path\_From,Path\_To  
    FileCopy=True  
  End Function  
  Public Function FileMove(Path\_From,Path\_To,CoverIF)  
    If Not(fso.FileExists(Path\_From)) then  
      FileMove="指定要移动的文件不存在"  
      Exit Function  
    ElseIf Not(fso.FolderExists(UpDir(Path\_To))) then  
      FileMove="指定要移动到的目录不存在"  
      Exit Function  
    End If  
    If fso.FileExists(Path\_To) then  
      If CoverIF=0 then  
        FileMove="指定要移动到的目录下已存在相同名称文件,不允许覆盖"  
        Exit Function  
      Else  
        Call Filedelete(Path\_To)  
      End If  
    End If  
    fso.MoveFile Path\_From,Path\_To  
    FileMove=True  
  End Function  
  Public Function Filedelete(Path)  
    If Not(fso.FileExists(Path)) then  
      Filedelete="指定要删除的文件不存在"  
      Exit Function  
    End If  
    Fso.deleteFile Path  
    Filedelete=True  
  End Function  
  Public Function Filerename(OldName,NewName,CoverIf)  
    NewName=NewName&"."&GetExtensionName(OldName)  
    If GetFileName(OldName)=NewName then  
      Filerename="更改前的文件与更改后的文件名称相同"  
      Exit Function  
    ElseIf Not(fso.FileExists(OldName)) then  
      Filerename="指定更改名称的文件不存在"  
      Exit Function  
    ElseIf fso.FileExists(UpDir(OldName)&"/"&NewName) then  
      If CoverIf=0 then  
        Filerename="目录下已存在与更改后的文件名称相同的文件,不允许覆盖"  
        Exit Function  
      Else  
        Call Filedelete(UpDir(OldName)&"/"&NewName)  
      End If  
    End If  
    Set FsoFile=fso.GetFile(OldName)  
    FsoFile.Name=NewName  
    Set FsoFile=Nothing  
    Filerename=True  
  End Function  
  
  Public Function FileRun()  
    If File\_NewFolder\_Path="" and File\_NewName="" then  
      FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
      Exit Function  
    ElseIf File\_Path="" or Not(fso.FileExists(File\_Path)) then  
      FileRun="要进行操作的文件不存在"  
      Exit Function  
    ElseIf Instr(File\_AllowType,GetExtensionName(File\_Path))=0 then  
      FileRun="要进行操作的文件被系统拒绝,允许的格式为: "&Replace(File\_AllowType,"|"," ")  
      Exit Function  
    End If  
      
    If File\_NewFolder\_Path="" then  
      File\_NewFolder\_Path=UpDir(File\_Path)  
    ElseIf Not(fso.FolderExists(File\_NewFolder\_Path)) then  
      FileRun="指定要移动到的目录不存在"  
      Exit Function  
    End If  
    If Right(File\_NewFolder\_Path,1)<>"/" then File\_NewFolder\_Path=File\_NewFolder\_Path&"/"  
    If File\_NewName="" then  
      File\_NewPath=File\_NewFolder\_Path&GetFileName(File\_Path)  
    Else  
      File\_NewPath=File\_NewFolder\_Path&File\_NewName&"."&GetExtensionName(File\_Path)  
    End If  
    If File\_Path=File\_NewPath then  
      FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
      Exit Function  
    ElseIf UpDir(File\_Path)<>UpDir(File\_NewPath) then  
      If File\_deleteIf=1 then  
        Call FileMove(File\_Path,File\_NewPath,File\_CoverIf)  
      Else  
        Call FileCopy(File\_Path,File\_NewPath,File\_CoverIf)  
      End If  
      FileRun=True  
    Else  
      'If File\_deleteIf=1 then  
        Call Filerename(File\_Path,GetPrefixName(File\_NewPath),File\_CoverIf)  
      'Else  
      '  Call FileCopy(File\_Path,File\_NewPath,File\_CoverIf)  
      'End If  
      FileRun=True  
    End If  
  End Function  
End Class  
%>

转自 [![im286.gif][] 落伍者][im286.gif_]    原作者：tonycc

**其他文章：**

[用ASPJPEG组件制作图片的缩略图和加水印][ASPJPEG]

[在VC中使用 Flash 美化你的程序][VC_ Flash]

[获得WebBrowser控件中的HTML源码][WebBrowser_HTML]

[使用IE控件的一些有趣方法][IE]

[为Pocket PC上的IE创建ActiveX控件][Pocket PC_IE_ActiveX]

[ASP服务器端组件编程实例1][ASP_1]

[aspjpeg组件高级使用方法介绍][aspjpeg]

[用AspJpeg组件，按宽高比例，真正生成缩略图][AspJpeg]

[code.gif]: http://www.hxblog.net/images/code.gif
[im286.gif]: http://www.hxblog.net/images/keywords/im286.gif
[im286.gif_]: http://www.im286.com/
[ASPJPEG]: http://blog.csdn.net/suprman/archive/2007/01/05/1474628.aspx
[VC_ Flash]: http://blog.csdn.net/suprman/archive/2007/01/04/1473607.aspx
[WebBrowser_HTML]: http://blog.csdn.net/suprman/archive/2007/01/04/1473579.aspx
[IE]: http://blog.csdn.net/suprman/archive/2007/01/04/1473582.aspx
[Pocket PC_IE_ActiveX]: http://blog.csdn.net/suprman/archive/2007/01/04/1473575.aspx
[ASP_1]: http://blog.csdn.net/suprman/archive/2006/10/23/1346201.aspx
[aspjpeg]: http://blog.csdn.net/suprman/archive/2007/01/05/1474632.aspx
[AspJpeg]: http://blog.csdn.net/suprman/archive/2007/01/15/1483521.aspx