发布日期:2007-09-13 10:54 来源: 标签: ASP 函数 函数 0011 指定 目录 列表
'************************************************** '函数ID:0011[指定目录的目录列表] '函数名:ListDirs '作 用:指定目录的目录列表 '参 数:Dirname ---- 目录名(包括路径) '返回值:目录列表字符串,之间用|相隔 '******************************

'**************************************************
  '函数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[正则表达式测试]
  '函数名: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[获得执行程序的名称]
  '函数名: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

本文作者:

相关评论

专题信息
    ASP是Active Server Page的缩写,意为“动态服务器页面”。ASP是微软公司开发的代替CGI脚本程序的一种应用,它可以与数据库和其它程序进行交互,是一种简单、方便的编程工具。ASP的网页文件的格式是 .asp。现在常用于各种动态网站中。本教程讲从asp基础知识,asp网络编程,asp优化,实例,技巧等知识了解ASP这门课。