Asp文件操作[删除、移动、转换、上传等]

<%

'//

'// Name:CFile.asp

'// Author:Q&f

'// Email:dengyu1230359@sina.com

'// Discription:ASP文件类

'//

Class CFile

Dim mFs    ' 声明 Scripting.FileSystemObject 对象

Dim mDir   ' 声明 Scripting.Dictionary 对象

 

'//

'// 类初始化

'//

Private Sub Class_Initialize()

 

    ' 创建文件系统对象    

    Set mFs = Server.CreateObject("Scripting.FileSystemObject")

    ' 创建目录对象   

    Set mDir = Server.CreateObject("Scripting.Dictionary")

        

End Sub

 

'//

'// 类释放

'//

Private Sub Class_Terminate()

        

         ' 释放对象

         Set mDir = Nothing

         Set mFs = Nothing

        

End Sub

 

'//

'// 获得文件绝对路径名

'// 例如： GetAbsolutePathName("C:/Images/TempFile.jpg")

'// 返回： "C:/Images/TempFile.jpg"

'//

Public Function GetAbsolutePathName(strPath)

        

         GetAbsolutePathName = mFs.GetAbsolutePathName(strPath)

        

End Function

 

'//

'// 获得文件基本名称

'// 例如： GetBaseName("C:/Images/TempFile.jpg")

'// 返回： "TempFile"

'//

Public Function GetBaseName(strPath)

        

         GetBaseName = mFs.GetBaseName(strPath)

        

End Function

 

'//

'// 获得驱动器名称

'// 例如： GetDriveName("C:/Images/TempFile.jpg")

'// 返回： "C:"

'//

Public Function GetDriveName(strPath)

        

         GetDriveName = mFs.GetDriveName(strPath)

        

End Function

 

 

'//

'// 获得文件扩展名

'// 例如： GetExtensionName("C:/Images/TempFile.jpg")

'// 返回： "jpg"

'//

Public Function GetExtensionName(strPath)

        

         GetExtensionName = mFs.GetExtensionName(strPath)

        

End Function

 

'//

'// 获得文件名

'// 例如： GetFileName("C:/Images/TempFile.jpg")

'// 返回： "TempFile.jpg"

'//

Public Function GetFileName(strPath)

        

         GetFileName = mFs.GetFileName(strPath)

        

End Function

 

'//

'// 获得父文件夹名

'// 例如： GetParentFolderName("C:/Images/TempFile.jpg")

'// 返回： "C:/Images"

'//

Public Function GetParentFolderName(strPath)

        

         GetParentFolderName = mFs.GetParentFolderName(strPath)

        

End Function

 

'//

'// 获得随机文件名

'// 例如： GetRndFileName("jpg")

'// 返回： "48213220069452.jpg"

'//

Public Function GetRndFileName(strExtName)

         Dim iRnd

        

         Randomize

         iRnd = Int(900 * Rnd) + 100

         GetRndFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & iRnd & "." & strExtName

 

End Function

 

'//

'// 指定驱动器是否存在

'// 例如： DriveExists("D:/")

'// 返回： "True"

'//

Public Function DriveExists(strDriveName)

 

         DriveExists = mFs.DriveExists(strDriveName)

        

End Function

 

'//

'// 复制文件

'// 例如： CopyFile("C:/Images/TempFile.jpg","D:/TempFile.jpg",True)

'// 返回：无

'//

Public Sub CopyFile(surFileName,dstFileName,blnOverWriteFiles)

 

         mFs.CopyFile surFileName,dstFileName,blnOverWriteFiles

        

End Sub

 

'//

'// 移动文件

'// 例如： MoveFile("C:/Images/TempFile.jpg","D:/TempFile.jpg")

'// 返回：无

'//

Public Sub MoveFile(surFileName,dstFileName)

 

         mFs.MoveFile surFileName,dstFileName

        

End Sub

 

'//

'// 删除文件

'// 例如： DeleteFile "C:/Images/TempFile.jpg",True ' 强迫删除

'//

Public Sub DeleteFile(strFileName,blnForce)

        

         mFs.DeleteFile strFileName,blnForce

        

End Sub

 

'//

'// 将 WORD 文档转换成 HTML 文件

'//

Public Sub DocToHtmlFile(surFileName,dstFileName)

    On Error Resume Next

    Dim oApp 'oApp As Word.Application

    Dim oDoc 'oDoc As Word.Document

   

    Set oApp = CreateObject("Word.Application")

    Set oDoc = oApp.Documents.Open(surFileName)

    oDoc.SaveAs dstFile, 8 'wdFormatHTML=8

    oDoc.Close True

    oApp.Quit

           

    Set oDoc = Nothing

    Set oApp = Nothing

   

End Sub

 

'//

'// 将 EXCEL 文件转换成 HTML 文件

'//

Public Sub XlsToHtmlFile(surFileName,dstFileName)

    On Error Resume Next

    Dim oApp 'oApp As Excel.Application

    Dim oXls 'oXls As Excel.Workbook

   

    Set oApp = Server.CreateObject("Excel.Application")

    Set oXls = oApp.Workbooks.Open(surFileName)

    oXls.SaveAs dstFileName, 44 'xlHtml=44

    oXls.Close True

    oApp.Quit

   

    Set oXls = Nothing

    Set oApp = Nothing

       

End Sub

 

'//

'// 保存二进制数据到数据库（如图片、视频等）

'// 例如 SaveBinaryDataToDB "C:/TempFile.JPG",rs.Fields("ImgFieldName")

'//

Public Sub SaveBinaryDataToDB(surFile, fldField) 'fldField As ADODB.Field

        On Error Resume Next

    Dim Strm 'Strm As ADODB.Stream

  

    Set Strm = Server.CreateObject("ADODB.Stream")

    Strm.Type = 1 'adTypeBinary=1

    Strm.Open

    Strm.LoadFromFile surFile

    fldField = mStrm.Read

    Strm.Close

   

    Set Strm = Nothing

   

End sub

 

'//

'// 取出二进制数据从数据库（如图片、视频等）

'// 例如 GetBinaryDataFromDB "C:/TempFile.JPG",rs.Fields("ImgFieldName")

'//

Public Sub GetBinaryDataFromDB(dstFile, fldField) 'fldField As ADODB.Field

         On Error Resume Next

         Dim Strm 'Strm As ADODB.Stream

 

    Set Strm = Server.CreateObject("ADODB.Stream")

    Strm.Type = 1 'adTypeBinary=1

    Strm.Open

    Strm.Write fldField

    Strm.SaveToFile dstFile, 2 'adSaveCreateOverWrite=2

    Strm.Close

   

    Set Strm = Nothing

       

End Sub

 

'//

'// 从客户端上传文件到指定目录，使用相对路径。

'// 例如： "G:/Files/UploadFile/TempFile.jpg" 使用的是绝对路径，而

'//       "./UploadFile/TempFile.jpg" 则使用的是相对路径 .

'// 例如： UploadFile("./UploadFile/",0) 其中 0 表示不限制文件上传大小

'// 返回： "./UploadFile/5861322006162256.jpg"

'//

Public Function UploadFile(strUploadDir,lngAllowMaxSize)

         On Error Resume Next

         Dim oUpload, oFile

         Dim strExtName,strSaveFileName

        

         ' 建立上传对象

         Set oUpload = New CUploadFile

        

         ' 取得上传数据 , 限制最大上传 , 若 lngAllowMaxSize=0 表示不限制文件上传大小

         oUpload.GetData(lngAllowMaxSize*1024)

 

         If oUpload.Err > 0 Then

                   Select Case oUpload.Err

                   Case 1

                            Response.Write " 请选择有效的上传文件 "

                   Case 2

                            Response.Write " 你上传的文件总大小超出了最大限制（ " & lngAllowMaxSize & "KB ）！ "

                   End Select

                   UploadFile = "Error"

                   Set oUpload = Nothing

                   Response.End

         Else

                   ' 获得文件对象

                   Set oFile = oUpload.File("uploadfile")

                   strExtName = LCase(oFile.FileExt)

                   strSaveFileName = strUploadDir & GetRndFileName(strExtName)

                   oFile.SaveToFile Server.Mappath(strSaveFileName)

                   ' 释放对象并返回值

                   Set oFile = Nothing

                   Set oUpload = Nothing

                   UploadFile = strSaveFileName

         End If

        

End Function

 

'//

'// 保存上传的 Word 、 Excel 文件为 html 文件，使用相对路径。

'// 例如： "G:/Files/UploadFile/TempFile.doc" 使用的是绝对路径，而

'//       "./UploadFile/TempFile.doc" 则使用的是相对路径 .

'// 例如： UploadFile("./UploadFile/",0) 其中 0 表示不限制文件上传大小

'// 返回： "./UploadFile/9111322006165120.htm"

'//

Public Function UploadDocXlsFile(strUploadDir,lngAllowMaxSize)

         On Error Resume Next

         Dim oUpload, oFile

         Dim strExtName,strTmpFileName,strSaveFileName

        

         ' 建立上传对象

         Set oUpload = New CUploadFile

        

         ' 取得上传数据 , 限制最大上传 , 若 lngAllowMaxSize=0 表示不限制文件上传大小

         oUpload.GetData(lngAllowMaxSize*1024)

 

         If oUpload.Err > 0 Then

                   Select Case oUpload.Err

                   Case 1

                            Response.Write " 请选择有效的上传文件 "

                   Case 2

                            Response.Write " 你上传的文件总大小超出了最大限制（ " & lngAllowMaxSize & "KB ）！ "

                   End Select

                   Response.End

                   Set oUpload = Nothing

                   UploadFile = "Error"

         Else  

                   ' 获得文件对象

                   Set oFile = oUpload.File("uploadfile")

                   strExtName = UCase(oFile.FileExt)

                   If strExtName = "DOC" Or strExtName = "XLS" Then

                      ' 保存文件为临时文件

                      strTmpFileName = strUploadDir & GetRndFileName(strExtName)  

                      oFile.SaveToFile Server.Mappath(strTmpFileName)

                      ' 释放对象

                       Set oFile = Nothing

                       Set oUpload = Nothing

                       ' 转换文件为 Html 文件

                       strSaveFileName = strUploadDir & GetRndFileName("htm") 

                       If strExtName = "DOC" Then

                                     DocToHtmlFile Server.Mappath(strTmpFileName),Server.Mappath(strSaveFileName)

                       ElseIf strExtName = "XLS" Then

                           XlsToHtmlFile Server.Mappath(strTmpFileName),Server.Mappath(strSaveFileName)

                       End If

                       ' 删除临时文件

                       DeleteFile Server.Mappath(strTmpFileName),True

                       ' 返回值

                       UploadDocXlsFile = strSaveFileName

                   Else

                       Response.Write " 请选择 Word 文件或 Excel 文件 "

                       Response.End

                       Set oFile = Nothing

                       Set oUpload = Nothing

                       UploadDocXlsFile = "Error"

                   End If

         End If

        

End Function

 

End Class

 

 

'//

'// 文件上传类

'// 作者:梁无惧
'// 网站:http://www.25cn.com
'// 电子邮件:yjlrb@21cn.com

'//

Dim mUpFileStream

Class CUploadFile

 

Dim Form,File,Err

 

Private Sub Class_Initialize()

         Err = -1

End Sub

 

Private Sub Class_Terminate()

        

         ' 清除变量及对象

         On Error Resume Next

         Form.RemoveAll

         Set Form = Nothing

         File.RemoveAll

         Set File = Nothing

         mUpFileStream.Close

         Set mUpFileStream = Nothing

        

End Sub

  

Public Sub GetData(MaxSize)

         ' 定义变量

         Dim RequestBinData,sSpace,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 MaxSize > 0 Then

             ' 如果上传的数据超出限制

                   If Request.TotalBytes > MaxSize 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 mUpFileStream = Server.CreateObject ("ADODB.Stream")

         mUpFileStream.Type = 1

         mUpFileStream.Mode = 3

         mUpFileStream.Open

         mUpFileStream.Write Request.BinaryRead (Request.TotalBytes)

         mUpFileStream.Position = 0

         RequestBinData = mUpFileStream.Read

         iFormEnd = mUpFileStream.Size

         bCrLf = ChrB (13) & ChrB (10)

        

         ' 取得每个项目之间的分隔符

         sSpace = MidB (RequestBinData,1, InStrB (1,RequestBinData,bCrLf)-1)

         iStart = LenB (sSpace)

         iFormStart = iStart+2

         ' 分解项目

         Do

                   iInfoEnd = InStrB (iFormStart,RequestBinData,bCrLf & bCrLf)+3

                   tStream.Type = 1

                   tStream.Mode = 3

                   tStream.Open

                   mUpFileStream.Position = iFormStart

                   mUpFileStream.CopyTo tStream,iInfoEnd-iFormStart

                   tStream.Position = 0

                   tStream.Type = 2

                   tStream.CharSet = "gb2312"

                   sInfo = tStream.ReadText     

                   ' 取得表单项目名称

                   iFormStart = InStrB (iInfoEnd,RequestBinData,sSpace)-1

                   iFindStart = InStr (22,sInfo,"name=""",1)+6

                   iFindEnd = InStr (iFindStart,sInfo,"""",1)

                   sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

                   ' 如果是文件

                   If InStr(45,sInfo,"filename=""",1) > 0 Then

                            Set oFileInfo = New CFileInfor

                            ' 取得文件属性

                            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

                   ' 如果是表单项目

                            tStream.Close

                            tStream.Type = 1

                            tStream.Mode = 3

                            tStream.Open

                            mUpFileStream.Position = iInfoEnd

                            mUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2

                            tStream.Position = 0

                            tStream.Type = 2

                            tStream.CharSet = "gb2312"

                            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

                   ' 如果到文件尾了就退出

       Loop Until (iFormStart+2) >= iFormEnd

 

       RequestBinData = ""

       Set tStream = Nothing

 

End Sub

End Class

 

'//

'// 文件属性类（和 CUploadFile 类一起使用）

'//

Class CFileInfor

Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt

 

'//

'// 保存文件函数

'//

Public Function SaveToFile(Path)

         On Error Resume Next

         Dim oFileStream

 

         Set oFileStream = CreateObject("ADODB.Stream")

         oFileStream.Type = 1

         oFileStream.Mode = 3

         oFileStream.Open

         mUpFileStream.Position = FileStart

         mUpFileStream.CopyTo oFileStream,FileSize

         oFileStream.SaveToFile Path,2

         oFileStream.Close

 

End Function

 

'//

'// 取得文件数据

'//

Public Function FileData()

 

         mUpFileStream.Position = FileStart

         FileData = mUpFileStream.Read (FileSize)

        

End Function

 

End Class

%>