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