<%
'//
'// 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
'// 网站: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
%>