Asp文件操作函数集

悟静 2010-05-11

展开全文

'====================================================================
'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.
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
%>

本文来自: 站长之家(http://www.) 详细出处参考：http://www./View/30/30010102/1518.html