Asp文件操作函数集

2015-08-12 16:02:00来源:作者:人点击

 <% '===============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上传漏洞 "" 防范 
'函数名: 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.cncms.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 
%> 

最新文章

123

最新摄影

微信扫一扫

第七城市微信公众平台