Asp文件操作函数集

<% '===============ASP 文件操作函数集1.0版本=========================

' 整理作者：张辉

' 程序员代号：WJ008

' 整理时间：2008年 6 月 1 日

' 关注地址：www.wj008.net

' 所有函数使用的文件地址全部使用绝对地址

'====================================================================

'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

'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

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

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

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

'response.write "Ext: "&sFileExt & " return: " & return & " "

else '禁止上传指定的文件

return = true

for i=0 to UBound(arrExt)

If sFileExt=arrExt(i) then return=false

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

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

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

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