Asp文件操作函数集

<% '===============ASP 文件操作函数集1.0版本=========================
'     所有函数使用的文件地址 全部使用绝对地址
'====================================================================
'LoadFile(ByVal File) 加载已经有的文件，并把文件的内容生成一个字符串返回
'SaveToFile(ByVal strBody,ByVal File) 把更改的文件保存，strBody为新的字符串
'DelFile(ByVal File)    删除已有的文件
'加载已经有的文件，File为文件路径
'-------------------------------------------------------------------
Function LoadFile(ByVal File)
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write " 非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile File
If Err.Number<>0 Then
Response.Write " 文件";File;"无法被打开，请检查是否存在!"
Err.Clear
Response.End
End If
.Charset = "GB2312"
.Position = 2
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
'-------------------------------------------------------------------
Function SaveToFile(ByVal strBody,ByVal File) '保存打开的文件，File为保存的文件路径，strBody为保存的内容
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Open
.Charset = "GB2312"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile File,2
.Close
End With
Set objStream = Nothing
End Function
'-------------------------------------------------------------------
Function DelFile(ByVal File)
Dim objFilesys
On Error Resume Next
Set objFilesys=server.createobject("scripting.filesystemobject")
If objFilesys.FILEExists(File) then '如果文件存在着删除它 FILE为文件路径
objFilesys.deleteFILE File
End if
If Err.Number<>0 Then
Response.Write " 文件";File;"无法被删除，可能文件正在被系统使用中!"
Err.Clear
Response.End
End If
Set objFilesys=nothing
End Function

'检查文件是否存在
Function CheckFile(sFileName)
CheckFile=false
Dim objFilesys
On Error Resume Next
Set objFilesys=server.createobject("scripting.filesystemobject")
If objFilesys.FILEExists(sFileName) then '如果文件存在着删除它 FILE为文件路径
CheckFile=true
End if
Set objFilesys=nothing
End function
'检查文件夹是否存在
Function CheckFolder(Chk_Path)
set fso = server.createobject("scripting.filesystemobject")
if fso.FolderExists(Chk_Path)=false then
CheckFolder=false
else
CheckFolder=true
end if
End function

'得到文件后缀名
function GetFileExt(sFileName)
GetFileExt = UCase(Mid(sFileName,InStrRev (sFileName, ".")+1))
End function

'*******************************************************
'作 用: ASP上传漏洞 "\0" 防范
'函数名: TrueStr(fileTrue)
'参 数: sFileName 文件名
'返回值: 合法文件返回 True ,否则返回False
'*******************************************************
function IsTrueFileName(sFileName)
dim str_len,pos
str_len=len(sFileName)
pos=Instr(sFileName,chr(0))
If pos=0 or pos=str_len then
IsTrueFileName = true
else
IsTrueFileName = false
End If
End function
'*******************************************************
'作 用: 检测上传的图片文件(jpeg,gif,bmp,png)是否真的为图片
'函数名: TrueStr(fileTrue)
'参 数: sFileName 文件名(此处文件名是文件夹的物理全路径)
'返回值: 确实为图片文件则返回 True ,否则返回False
'*******************************************************
Function IsImgFile(sFileName)
const adTypeBinary=1
dim return
dim jpg(1):jpg(0)=CByte(;HFF):jpg(1)=CByte(;HD8)
dim bmp(1):bmp(0)=CByte(;H42):bmp(1)=CByte(;H4D)
dim png(3):png(0)=CByte(;H89):png(1)=CByte(;H50):png(2)=CByte(;H4E):png(3)=CByte(;H47)
dim gif(5):gif(0)=CByte(;H47):gif(1)=CByte(;H49):gif(2)=CByte(;H46):gif(3)=CByte(;H39):gif(4)=CByte(;H38):gif(5)=CByte(;H61)

on error resume next

return=false
dim fstream,fileExt,stamp,i
'得到文件后缀并转化为小写
FileExt = LCase(GetFileExt(sFileName))
'如果文件后缀为 jpg,jpeg,bmp,gif,png 中的任一种
'则执行真实图片判断
If strInString(FileExt,"jpg|jpeg|bmp|gif|png")=true then
Set fstream=Server.createobject("ADODB.Stream")
fstream.Open
fstream.Type=adTypeBinary
fstream.LoadFromFile sFileName
fstream.position=0
select case LCase(FileExt)
case "jpg","jpeg"
stamp=fstream.read(2)
for i=0 to 1
If ascB(MidB(stamp,i+1,1))=jpg(i) then return=true else return=false
next
'http://www.knowsky.com
case "gif"
stamp=fstream.read(6)
for i=0 to 5
If ascB(MidB(stamp,i+1,1))=gif(i) then return=true else return=false
next
case "png"
stamp=fstream.read(4)
for i=0 to 3
If ascB(MidB(stamp,i+1,1))=png(i) then return=true else return=false
next
case "bmp"
stamp=fstream.read(2)
for i=0 to 1
If ascB(MidB(stamp,i+1,1))=bmp(i) then return=true else return=false
next
End select

fstream.Close
Set fseteam=nothing
If err.number<>0 then return = false
else
return = true
End If
IsImgFile = return
End function
'*******************************************************
'作 用: 上传文件扩展名检测
'函数名: CheckFileExt
'参 数: sFileExt 上传文件夹的后缀
'        strExt   允许或禁止上传文件夹的后缀,多个以"|"分隔
'        blnAllow 是允许还是禁止上传 strExt 中指定的后缀
'返回值: 合法文件返回 True ,否则返回False
'*******************************************************
Function CheckFileExt(sFileExt,strExt,blnAllow)
dim arrExt,return
'= 禁止上传的文件列表
'strExt = "EXE|JS|BAT|HTML|HTM|COM|ASP|ASA|DLL|PHP|JSP|CGI"
sFileExt = UCase(sFileExt)
strExt   = UCase(strExt)    
arrExt = split(strExt,"|")
If blnAllow=true then         '只允许上传指定的文件
return = false
for i=0 to UBound(arrExt)
If sFileExt=arrExt(i) then return=true
next
'response.write "Ext: ";sFileExt ; " return: " ; return ; "   "
else                        '禁止上传指定的文件
return = true
for i=0 to UBound(arrExt)
If sFileExt=arrExt(i) then return=false
next
End If
CheckFileExt = return
End Function
'*******************************************************
'作 用: 格式化显示文件大小
'FileSize: 文件大小
'*******************************************************
Function FormatSize(FileSize)
If FileSize<1024 then FormatSize = FileSize ; " Byte"
If FileSize/1024 <1024 And FileSize/1024 > 1 then
FileSize = FileSize/1024
FormatSize=round(FileSize*100)/100 ; " KB"
Elseif FileSize/(1024*1024) > 1 Then
FileSize = FileSize/(1024*1024)
FormatSize = round(FileSize*100)/100 ; " MB"
End If
End function
'*******************************************************
'作用：下载文件。
'函数名： DownFile(FileName)
' FileName
'*******************************************************
Sub DownFile(FileName)
fname = server.MapPath(fname)
filename=split(fname,"\")

Set objAdoStream=Server.createObject("ADODB.Stream")
objAdoStream.Type=1
objAdoStream.open()
objAdoStream.LoadFromFile(fname)
strchar=objAdoStream.Read()
fsize=objAdoStream.size
objAdoStream.Close()
Set objAdoStream=nothing

Response.AddHeader "content-type","application/x-msdownload"
response.AddHeader "Content-Disposition","attachment;filename=" ; filename(ubound(filename))
Response.AddHeader "content-length", fsize

Response.BinaryWrite(strchar)
Response.Flush()
End Sub
'====================================================================================================
'读取INI文件
Function ReadIni(FilePath_Name,MySession,MyItem)
Dim MyString, MyArray,str_temp,sesstion_temp
MyString=LoadFile(FilePath_Name)
Arr=split(MyString,chr(10))
For I = 0 to UBound(Arr)
Str_temp= Arr(I)
Str_temp=Replace(Trim(Str_temp),chr(13),"")
If Trim(Str_temp)<>"" and InStr(Trim(Str_temp),";")<>1 Then
If InStr(Trim(Str_temp),"[")<InStr(Trim(Str_temp),"]") Then
sesstion_temp=Trim(Str_temp)
sesstion_temp=Replace(Trim(sesstion_temp),"[","")
sesstion_temp=Replace(Trim(sesstion_temp),"]","")
Else
MyArray = Split(Trim(Str_temp), "=")
If Trim(MyArray(0))=MyItem and sesstion_temp=MySession then
ReadIni= Trim(MyArray(1))
Exit Function
End if
End If
End if
Next  
ReadIni=""
End Function
'写入INI文件
Function WriteIni(FilePath_Name,MySession,MyItem,MyValue)
Dim MyString, MyArray,str_temp,sesstion_temp,sesstion_temp2,Rstr
IsDo=false
IsHave=false
MyString=LoadFile(FilePath_Name)
Arr=split(MyString,chr(10))
For I = 0 to UBound(Arr)
Str_temp= Arr(I)
Str_temp=Replace(Trim(Str_temp),chr(13),"")
if not IsDo then
If Trim(Str_temp)<>"" and InStr(Trim(Str_temp),";")<>1 Then
If InStr(Trim(Str_temp),"[")<InStr(Trim(Str_temp),"]") Then
sesstion_temp=Trim(Str_temp)
sesstion_temp=Replace(Trim(sesstion_temp),"[","")
sesstion_temp=Replace(Trim(sesstion_temp),"]","")
if sesstion_temp<>sesstion_temp2 and IsHave then
Str_temp=MyItem;"=";MyValue;VbCrLf;Str_temp
IsDo=true
end if
sesstion_temp2=sesstion_temp
if sesstion_temp=MySession then IsHave=true
Else
MyArray = Split(Trim(Str_temp), "=")
If Trim(MyArray(0))=MyItem and sesstion_temp=MySession then
Str_temp= MyItem;"=";MyValue
IsDo=true
End if
End If
End if
End if
if(I<>UBound(Arr)) then
if Str_temp<>"" then Rstr=Rstr;Str_temp;VbCrLf
else
if Str_temp<>"" then Rstr=Rstr;Str_temp
end if
Next
if IsHave and IsDo=false then Rstr=Rstr;VbCrLf;MyItem;"=";MyValue
if IsHave=false and IsDo=false then Rstr=Rstr;VbCrLf;"[";MySession;"]";VbCrLf;MyItem;"=";MyValue
call SaveToFile(Rstr,FilePath_Name)
End Function
'======================================================================================================
Function GetRanNum()
'****************************************
'函数名：GetRanNum
'作 用：输出带日期格式的随机数
'参 数：无   ----
'返回值：如GetRanNum()，即输出200409071553464617，为2004年09月07日15时53分46秒4617随机数
'关联函数：FormatIntNumber
'****************************************
GetRanNum = ""
GetRanNum = GetRanNum;FormatIntNumber(year(now),4)
GetRanNum = GetRanNum;FormatIntNumber(month(now),2)
GetRanNum = GetRanNum;FormatIntNumber(day(now),2)
GetRanNum = GetRanNum;FormatIntNumber(hour(now),2)
GetRanNum = GetRanNum;FormatIntNumber(minute(now),2)
GetRanNum = GetRanNum;FormatIntNumber(second(now),2)
randomize
ranNum=int((9000*rnd)+1000)
GetRanNum = GetRanNum;ranNum
End Function

Function FormatIntNumber(Expression,Digit)
'****************************************
'函数名：FormatIntNumber
'作 用：输出Digit位左边带0整数
'参 数：Expression   ----要格式化整数
'参 数：Digit        ----要格式化位数
'返回值：如0005，如FormatIntNumber(5,4)，整数5被格式化为0005
'关联函数：无
'****************************************
While Len(Expression) < Digit
Expression = "0";Expression
wend
FormatIntNumber = Expression
End Function
%>