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