'************************************************** 
  '函數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[創(chuàng)建文本文件] 
  '函數名：WritTextFile 
  '作 用：創(chuàng)建文本文件 
  '參 數：Fname ---- 文本文件名稱（包括路徑） 
  '參 數：WritString ---- 寫入的內容 
  '返回值：創(chuàng)建成功返回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[正則表達式測試] 
  '函數名：CheckExp 
  '作 用：正則表達式測試 
  '參 數：patrn ---- 正則表達式 
  '參 數：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[獲得執(zhí)行程序的名稱] 
  '函數名：GT_the_proname 
  '作 用：獲得執(zhí)行程序的名稱 
  '參 數： 
  '返回值：返回執(zhí)行程序的名稱 
  '************************************************** 
  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 

最新評論