结合FSO操作写的一个Class

《结合FSO操作写的一个Class》

尚在完善中,基本功能已具备.
也可作为初学者的教程

程序代码

<%
'***************************** 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
%>  

转自 落伍者    原作者：tonycc

<script type="text/javascript">google_ad_client = "pub-2416224910262877";google_ad_width = 728;google_ad_height = 90;google_ad_format = "728x90_as";google_ad_channel = "";google_color_border = "FFFFFF";google_color_bg = "FFFFFF";google_color_link = "0000FF";google_color_text = "000000";google_color_url = "008000";</script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

其他文章：

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

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

获得WebBrowser控件中的HTML源码 

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

为Pocket PC上的IE创建ActiveX控件

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

aspjpeg组件高级使用方法介绍

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