ASP函數庫(全部可以直接調用，非常方便) 2

'**************************************************
'函數ID：0009[刪除目錄]
'函數名：DelDir
'作 用：刪除目錄
'參 數：DlDirname ---- 目錄名（包括路徑）
'傳回值：目錄刪除成功返回True,否則False
'**************************************************
Public Function DelDir(ByVal DlDirname)
Dim M_fso
DelDir=False
Set M_fso = CreateObject("Scripting.FileSystemObject")
If (M_fso.FolderExists(DlDirname)) Then
M_fso.DeleteFolder(DlDirname)
DelDir=True
End If
Set M_fso = Nothing
End Function
'**************************************************
'函數ID：0010[指定目錄的檔案清單]
'函數名：ListFiles
'作 用：指定目錄的檔案清單
'參 數：Dirname ---- 目錄名（包括路徑）
'傳回值：檔案清單字串，之間用“|”相隔
'**************************************************
Public Function ListFiles(ByVal Dirname)
Dim M_fso,fNS,fLS,Fnames,FnamesN
Set M_fso = CreateObject("Scripting.FileSystemObject")
If (M_fso.FolderExists(Dirname)) Then
Set fNS = M_fso.GetFolder(Dirname)
Set fLS=fNS.Files
For Each FnamesN in fLS
Fnames=Fnames & FnamesN.name
Fnames=Fnames & "|"
Next
ListFiles=Fnames
End If
Set M_fso = Nothing
End Function
'**************************************************
'函數ID：0011[指定目錄的目錄列表]
'函數名：ListDirs
'作 用：指定目錄的目錄列表
'參 數：Dirname ---- 目錄名（包括路徑）
'傳回值：目錄列表字串，之間用“|”相隔
'**************************************************
Public Function ListDirs(ByVal Dirname)
Dim M_fso,fNS,fLS,Fnames,FnamesN
Set M_fso = CreateObject("Scripting.FileSystemObject")
If (M_fso.FolderExists(Dirname)) Then
Set fNS = M_fso.GetFolder(Dirname)
Set fLS=fNS.SubFolders
For Each FnamesN in fLS
Fnames=Fnames & FnamesN.name
Fnames=Fnames & "|"
Next
ListDirs=Fnames
End If
Set M_fso = Nothing
End Function
'**************************************************
'函數ID：0012[建立文字檔]
'函數名：WritTextFile
'作 用：建立文字檔
'參 數：Fname ---- 文字檔名稱（包括路徑）
'參 數：WritString ---- 寫入的內容
'傳回值：建立成功返回True，否則False
'**************************************************
Public Function WritTextFile(ByVal Fname,ByVal WritString)
Dim M_fso,FnameN
WritTextFile=False
Set M_fso = CreateObject("Scripting.FileSystemObject")
Set FnameN= M_fso.OpenTextFile(Fname,2,True)
FnameN.Write WritString
FnameN.Close
Set M_fso = Nothing
WritTextFile=True
End Function
'**************************************************
'函數ID：0013[讀取文字檔]
'函數名：ReadTextFile
'作 用：讀取文字檔
'參 數：Fname ---- 文字檔名稱（包括路徑）
'傳回值：返回讀取的常值內容
'**************************************************
Public Function ReadTextFile(ByVal Fname)
Dim M_fso,FnameN,Fnr
ReadTextFile=""
Set M_fso = CreateObject("Scripting.FileSystemObject")
Set FnameN= M_fso.OpenTextFile(Fname,1,True)
Fnr=FnameN.ReadAll
FnameN.Close
Set M_fso = Nothing
ReadTextFile=Fnr
End Function
'**************************************************
'函數ID：0014[檢測ID是否為數字類型]
'函數名：JCID
'作 用：檢測ID是否為數字類型
'參 數：ParaValue ---- 被檢測的ID值
'傳回值：返回ID值，如果不為數字類型返回0
'**************************************************
Public Function JCID(ByVal ParaValue)
If ((Not isNumeric(ParaValue)) OR (Trim(ParaValue)="")) Then
JCID=0
Else
JCID=ParaValue
End If
End function
'**************************************************
'函數ID：0015[Regex測試]
'函數名：CheckExp
'作 用：Regex測試
'參 數：patrn ---- Regex
'參 數：strng ---- 要測試的字串
'傳回值：測試如果成立返回 True 否則 False
'例 CheckExp("(\<.[^\<]*\>)","<br>")
'**************************************************
Public Function CheckExp(ByVal patrn, ByVal strng)
Dim regEx, retVal
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = False
retVal = regEx.Test(strng)
CheckExp = retVal
End Function
'**************************************************
'函數ID：0016[獲得執行程式的名稱]
'函數名：GT_the_proname
'作 用：獲得執行程式的名稱
'參 數：
'傳回值：返回執行程式的名稱
'**************************************************
Public Function GT_the_proname()
Dim fu_name,temp,tempsiz
temp=Request.ServerVariables("PATH_INFO")
fu_name=Split(temp, "/", -1, 1)
tempsiz=UBound(fu_name)
GT_the_proname=fu_name(tempsiz)
End function
'**************************************************
'函數ID：0017[讀取使用者IP地址資訊]
'函數名：Readusip
'作 用：讀取使用者IP地址資訊
'參 數：
'傳回值：返回使用者IP地址
'**************************************************
Public Function Readusip()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
Readusip = Trim(Mid(strIPAddr, 1, 30))
End Function
'**************************************************
'函數ID：0018[無組件上傳檔案到指定目錄並改檔案名稱]
'函數名：UpFsRn
'作 用：無組件上傳檔案到指定目錄並變更檔名稱
'參 數：RetSize--- 上傳限止大小（單位是M）
'參 數：Fdir ---- 目標路徑
'參 數：Objwj ---- 目標檔案名稱
'傳回值：如果成功 True 否則 False
'例 UpFsRn(10,Readsyspath(1)&"zfkhauto","test.txt")
'使用表單提取檔案 <form method='POST' action='function.asp' enctype='multipart/form-data'><input type='file' name='T1'><input type='submit' value='提交' name='B1'></form>
'**************************************************
Public Function UpFsRn(ByVal RetSize,ByVal Fdir,ByVal Objwj)
UpFsRn=False
Dim oUpStream,oStream,formsize,Formdata,strFileName,strFileDir,ObjAllPath,datastart,dataend
strFileDir = Fdir
strFileName = Swj
ObjAllPath = ""
If Right(strFileDir,1)<>"\" Then strFileDir=strFileDir&"\"
ObjAllPath =strFileDir&Objwj
If CheckFile(ObjAllPath) Then DelFile(ObjAllPath)
formsize=Request.TotalBytes
if (formsize<=(RetSize*1024*1024)) then
Formdata=Request.BinaryRead(formsize)
Pos_ts=LenB(getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))
Pos_b=InstrB(Formdata,getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))+Pos_ts
nFormdata=MidB(Formdata,Pos_b)
Pos_ts=InstrB(nFormdata,getByteString(Chr(13) & Chr(10) & "--"))
nnFormdata=MidB(nFormdata,Pos_ts)
Pos_e=LenB(Formdata)-LenB(nnFormdata)-Pos_b+1
datastart =Pos_b
dataend=Pos_e
set oUpStream = Server.CreateObject("adodb.stream")
oUpStream.Type = 1
oUpStream.Mode = 3
oUpStream.Open
set oStream = Server.CreateObject("adodb.stream")
oStream.Type = 1
oStream.Mode = 3
oStream.Open
oUpStream.Write Formdata
oUpStream.position=datastart-1
oUpStream.copyto oStream,dataend
oStream.SaveToFile ObjAllPath,2
oStream.Close
set oStream=nothing
UpFsRn=True
End If
End function
'**************************************************
'函數ID：0019[過濾HTML指令碼]
'函數名：FilterJS
'作 用：過濾HTML指令碼
'參 數：strHTML ---- 被檢測的HTML字串
'傳回值：返回過濾後的HTML
'**************************************************
Function FilterJS(ByVal strHTML)
Dim objReg,strContent
If IsNull(strHTML) OR strHTML="" Then Exit Function
Set objReg=New RegExp
objReg.IgnoreCase =True
objReg.Global=True
objReg.Pattern="(&#)"
strContent=objReg.Replace(strHTML,"")
objReg.Pattern="(function|meta|value|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie)"
strContent=objReg.Replace(strContent,"")
objReg.Pattern="(on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
strContent=objReg.Replace(strContent,"")
FilterJS=strContent
strContent=""
Set objReg=Nothing
End Function
'**************************************************