注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

K8拉登哥哥's Blog

K8搞基大队[K8team] 信息安全 网络安全 0day漏洞 渗透测试 黑客

 
 
 

日志

 
 

服务器端常用函数库 ASP VBS  

2011-06-26 15:23:53|  分类: ASP/PHP |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
转自:http://community.csdn.net

<%
'===================================================================================
' 功    能:StdCall 基本函数库
' 创建时间:2004年4月6日 14:35:58
' 修改时间:2005年3月18日 22:07:24
' 作    者:殷非非
'===================================================================================
 
'定义超全局变量
Dim URLSelf,URISelf
URISelf=Request.ServerVariables("SCRIPT_NAME")
If Request.QueryString="" Then
URLSelf=URISelf
Else
URLSelf=URISelf & "?" & Request.QueryString
End If
Response.CharSet="GB2312"
Response.Buffer=True
Response.Expires=-1


'===================================================================================
'   函数原型:  GotoURL (URL)
'功    能:转到指定的URL
'参    数:URL 要跳转的URL
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GotoURL(URL)
Response.Write "<script language=""JavaScript"">location.href='http://qqhack8.blog.163.com/blog/" & URL & "';</script>"
End Function

'===================================================================================
'   函数原型:  MessageBox (Msg)
'功    能:显示消息框
'参    数:要显示的消息
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function MessageBox(msg)
msg=Replace(msg,"\","\\")
msg=Replace(msg,"'","\'")
msg=Replace(msg,"""","\""")
msg=replace(msg,vbCrLf,"\n")
msg=replace(msg,vbCr,"")
msg=replace(msg,vbLf,"")
Response.Write "<script language=""JavaScript"">alert('" & msg & "');</script>"
End Function

'===================================================================================
'   函数原型:  ReturnValue (bolValue)
'功    能:设置Window对象的返回值:只能是布尔值
'参    数:返回值
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function ReturnValue(bolValue)
If bolValue Then
Response.Write "<script language=""JavaScript"">window.returnValue=true;</script>"
Else
Response.Write "<script language=""JavaScript"">window.returnValue=false;</script>"
End If
End Function

'===================================================================================
'   函数原型:  GoBack (URL)
'功    能:后退
'参    数:无
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GoBack()
Response.Write "<script language=""JavaScript"">history.go(-1);</script>"
End Function

'===================================================================================
'   函数原型:  CloseWindow ()
'功    能:关闭窗口
'参    数:无
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function CloseWindow()
Response.Write "<script language=""JavaScript"">window.opener=null;window.close();</script>"
End Function

'===================================================================================
'   函数原型:  RefreshParent ()
'功    能:刷新父框架
'参    数:无
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function RefreshParent()
Response.Write "<script language=""JavaScript"">if(parent!=self) parent.location.reload();</script>"
End Function

'===================================================================================
'   函数原型:  RefreshTop ()
'功    能:刷新顶级框架
'参    数:无
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function RefreshTop()
Response.Write "<script language=""JavaScript"">if(top!=self) top.location.reload();</script>"
End Function

'===================================================================================
'   函数原型:  GenPassword (intLen,PassMask)
'功    能:生成随机密码
'参    数:intLen新密码长度
'PassMask生成密码的掩码默认为空
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GenPassword(intLen,PassMask)
Dim iCnt,PosTemp
Randomize
If PassMask="" Then
PassMask="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
End If
For iCnt=1 To intLen
PosTemp = Fix(Rnd(1)*(Len(PassMask)))+1
GenPassword = GenPassword & Mid(PassMask,PosTemp,1)
Next
End Function

'===================================================================================
'   函数原型:  GenSerialString ()
'功    能:生成序列号
'参    数:无
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GenSerialString()
GenSerialString=Year(Now())
If Month(Now())<10 Then
GenSerialString=GenSerialString & "0"
End If
GenSerialString=GenSerialString & Month(Now())
If Day(Now())<10 Then
GenSerialString=GenSerialString & "0"
End If
GenSerialString=GenSerialString & Day(Now())
If Hour(Now())<10 Then
GenSerialString=GenSerialString & "0"
End If
GenSerialString=GenSerialString & Hour(Now())
If Minute(Now())<10 Then
GenSerialString=GenSerialString & "0"
End If
GenSerialString=GenSerialString & Minute(Now())
If Second(Now())<10 Then
GenSerialString=GenSerialString & "0"
End If
GenSerialString=GenSerialString & Second(Now())
GenSerialString=GenSerialString & GenPassword(6,"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
End Function



'===================================================================================
'   函数原型:  ChangePage(URLTemplete,PageIndex)
'功    能:根据URL模板生成新的页面URL
'参    数:URLTempleteURL模板
'               PageIndex新的页码
'返 回 值:生成的URL
'涉及的表:无
'===================================================================================
Public Function ChangePage(URLTemplete,PageIndex)
ChangePage=SetQueryString(URLTemplete,"PAGE",PageIndex)
End Function
'===================================================================================
'   函数原型:  BuildPath(sPath)
'功    能:根据指定的路径创建目录
'参    数:sPathURL模板
'返 回 值:如果成功,返回空字符串,否则返回错误信息和错误位置
'涉及的表:无
'===================================================================================
Public Function BuildPath (sPath)
Dim iCnt
Dim path
Dim BasePath
path=Split(sPath,"/")
If Left(sPath,1)="/" Or Left(sPath,1)="\" Then
BasePath=Server.MapPath("/")
Else
BasePath=Server.MapPath(".")
End If
Dim cPath,oFso
cPath=BasePath
BuildPath=""
Set oFso=Server.Createobject("Scripting.FileSystemObject")
For iCnt=LBound(path) To UBound(path)
If Trim(path(iCnt))<>"" Then
cPath=cPath & "\" & Trim(path(iCnt))
If Not oFso.FolderExists(cPath) Then
On Error Resume Next
oFso.CreateFolder cPath
If Err.Number<>0 Then
BuildPath=Err.Description & "[" & cPath & "]"
Exit For
End If
On Error Goto 0
End If
End If
Next
Set oFso=Nothing
End Function

'===================================================================================
'   函数原型:  GetUserAgentInfo(ByRef vSoft,ByRef vOs)
'功    能:获取客户端操作系统和浏览器信息
'参    数:vSoft浏览器信息
'vOs操作系统信息
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GetUserAgentInfo(ByRef vSoft,ByRef vOs)
Dim theSoft
theSoft=Request.ServerVariables("HTTP_USER_AGENT")
' 浏览器
if InStr(theSoft,"NetCaptor") Then
vSoft="NetCaptor"
ElseIf InStr(theSoft,"MSIE 6") Then
vSoft="MSIE 6.0"
ElseIf InStr(theSoft,"MSIE 5.5+") Then
vSoft="MSIE 5.5"
ElseIf InStr(theSoft,"MSIE 5") Then
vSoft="MSIE 5.0"
ElseIf InStr(theSoft,"MSIE 4") Then
vSoft="MSIE 4.0"
ElseIf InStr(theSoft,"Netscape") Then
vSoft="Netscape"
ElseIf InStr(theSoft,"Opera") Then
vSoft="Opera"
Else
vSoft="Other"
End If
' 操作系统
if InStr(theSoft,"Windows NT 5.0") Then
vOs="Windows 2000"
ElseIf InStr(theSoft,"Windows NT 5.1") Then
vOs="Windows XP"
ElseIf InStr(theSoft,"Windows NT 5.2") Then
vOs="Windows 2003"
ElseIf InStr(theSoft,"Windows NT") Then
vOs="Windows NT"
ElseIf InStr(theSoft,"Windows 9") Then
vOs="Windows 9x"
ElseIf InStr(theSoft,"unix") Then
vOs="Unix"
ElseIf InStr(theSoft,"linux") Then
vOs="Linux"
ElseIf InStr(theSoft,"SunOS") Then
vOs="SunOS"
ElseIf InStr(theSoft,"BSD") Then
vOs="BSD"
ElseIf InStr(theSoft,"Mac") Then
vOs="Mac"
Else
vOs="Other"
End If
End Function
'===================================================================================
'   函数原型:  GetRegexpObject()
'功    能:获得一个正则表达式对象
'参    数:无
'返 回 值:正则表达式对象
'涉及的表:无
'===================================================================================
Public Function GetRegExpObject(sPattern)
Dim r : Set r=New RegExp
r.Global=True
r.IgnoreCase = True
r.MultiLine=True
r.Pattern=sPattern
Set GetRegexpObject=r
Set r=Nothing
End Function
'===================================================================================
'   函数原型:  RegExpTest(pattern,string)
'功    能:正则表达式检测
'参    数:pattern模式字符串
'string待检查的字符串
'返 回 值:是否匹配
'涉及的表:无
'===================================================================================
Public Function RegExpTest(p,s)
Dim r
Set r=GetRegExpObject(p)
RegExpTest=r.Test(s)
Set r=Nothing
End Function
'===================================================================================

'   函数原型:  RegExpReplace(sSource,sPattern,sRep)
'功    能:正则表达式替换
'参    数:sSource要替换的源字符串
'sPattern模式字符串
'sRep要替换的目标字符串
'返 回 值:替换后的字符串
'涉及的表:无
'===================================================================================
Public Function RegExpReplace(sSource,sPattern,sRep)
Dim r : Set r=GetRegExpTest(sPattern)
RegExpReplace=r.Replace(sSource,sRep)
Set r=Nothing
End Function
'===================================================================================
'   函数原型:  CreateXMLParser()
'功    能:创建一个尽可能高版本的XMLDOM
'参    数:无
'返 回 值:IDOMDocument对象
'涉及的表:无
'===================================================================================
Public Function CreateXMLParser()
On Error Resume Next
Set CreateXMLParser=Server.CreateObject("MSXML2.DOMDocument.4.0")
If Err.Number<>0 Then
Err.Clear
Set CreateXMLParser=Server.CreateObject("MSXML2.DOMDocument.3.0")
If Err.Number<>0 Then
Err.Clear
Set CreateXMLParser=Server.CreateObject("MSXML2.DOMDocument.2.6")
If Err.Number<>0 Then
Err.Clear
Set CreateXMLParser=Server.CreateObject("MSXML2.DOMDocument")
If Err.Number<>0 Then
Err.Clear
Set CreateXMLParser=Server.CreateObject("Microsoft.XMLDOM")
If Err.Number<>0 Then
Err.Clear
Set CreateXMLParser=Nothing
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
On Error Goto 0
End Function




'===================================================================================
'   函数原型:  CreateHTTPPoster()
'功    能:创建一个尽可能高版本的XMLHTTP
'参    数:ServerOrClient创建ServerXMLHTTP还是XMLHTTP
'返 回 值:IXMLHTTP对象
'涉及的表:无
'===================================================================================
Public Function CreateHTTPPoster(soc)
Dim s
If soc Then
s="ServerXMLHTTP"
Else
s="XMLHTTP"
End If
On Error Resume Next
Set CreateHTTPPoster=Server.CreateObject("MSXML2." & s & ".4.0")
If Err.Number<>0 Then
Err.Clear
Set CreateHTTPPoster=Server.CreateObject("MSXML2." & s & ".3.0")
If Err.Number<>0 Then
Err.Clear
Set CreateHTTPPoster=Server.CreateObject("MSXML2." & s)
If Err.Number<>0 Then
Set CreateHTTPPoster=Nothing
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
On Error Goto 0
End Function
'===================================================================================
'   函数原型:  XMLThrowError (errCode,errReason)
'功    能:抛出一个XML错误消息
'参    数:errCode错误编码
'errReason错误原因
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Sub XMLThrowError (errCode,errReason)
Response.Clear
Response.ContentType="text/xml"
Response.Write"<?xml version=""1.0"" encoding=""gb2312"" standalone=""yes"" ?>" & vbCrLf & _
"<ERROR CODE=""" & errCode & """ REASON=""" & errReason & """ />" & vbCrLf
Response.Flush
Response.End
End Sub
'===================================================================================
'   函数原型:  GetXMLNodeValue(ByRef xmlDom,sFilter,sDefValue)
'功    能:从一个XML文档中查找指定节点的值
'参    数:xmlDomXML文档
'sFilterXPATH定位字符串
'sDefValue默认值
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GetXMLNodeValue(ByRef xmlDom,sFilter,sDefValue)
Dim oNode : Set oNode=xmlDom.selectSingleNode(sFilter)
If TypeName(oNode)="Nothing" Or TypeName(oNode)="Null" Or TypeName(oNode)="Empty" Then
GetXMLNodeValue=sDefValue
Set oNode=Nothing
Else
GetXMLNodeValue=Trim(oNode.Text)
Set oNode=Nothing
End If
End Function
'===================================================================================
'   函数原型:  GetXMLNodeAttribute(ByRef xmlDom,sFilter,sName,sDefValue)
'功    能:从一个XML文档中查找指定节点的指定属性
'参    数:xmlDomXML文档
'sFilterXPATH定位字符串
'sName要查询的属性名称
'sDefValue默认值
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GetXMLNodeAttribute(ByRef xmlDom,sFilter,sName,sDefValue)
Dim oNode : Set oNode=xmlDom.selectSingleNode(sFilter)
If TypeName(oNode)="Nothing" Or TypeName(oNode)="Null" Or TypeName(oNode)="Empty" Then
GetXMLNodeAttribute=sDefValue
Set oNode=Nothing
Else
Dim pTemp : Set pTemp=oNode.getAttribute(sName)
If TypeName(pTemp)="Nothing" Or TypeName(pTemp)="Null" Or TypeName(pTemp)="Empty" Then
GetXMLNodeAttribute=sDefValue
Set oNode=Nothing
Set pTemp=Nothing
Else
GetXMLNodeAttribute=Trim(pTemp.Value)
Set oNode=Nothing
Set pTemp=Nothing
End If
End If
End Function
'===================================================================================
'   函数原型:  GetQueryStringNumber (FieldName,defValue)
'功    能:从QueryString获取一个整数
'参    数:FieldName参数名
'defValue默认值
'返 回 值:无
'涉及的表:无
'===================================================================================
Public Function GetQueryStringNumber (FieldName,defValue)
Dim r : r=Request.QueryString(FieldName)
If r="" Then
GetQueryStringNumber = defValue
Exit Function
Else
If Not IsNumeric(r) Then
GetQueryStringNumber = defValue
Exit Function
Else
On Error Resume Next
r=CDbl(r)
If Err.Number<>0 Then
Err.Clear
GetQueryStringNumber = defValue
Exit Function
Else
GetQueryStringNumber=r
End If
On Error Goto 0
End If
End If
End Function
'===================================================================================
'   函数原型:  IIf (testExpr,value1,value2)
'功    能:相当于C/C++里面的 ?: 运算符
'参    数:testExprBoolean表达式
'value1testExpr=True 时的取值
'value2testExpr=False 时的取值
'返 回 值:如果testExpr为True返回value1否则返回value2
'涉及的表:无
'说    明:VBScript里没有Iif函数
'===================================================================================
Public Function IIf(testExpr,value1,value2)
If testExpr=True Then
IIf=value1
Else
IIf=value2
End If
End Function


'===================================================================================
'   函数原型:  URLEncoding (v,f)
'功    能:URL编码函数
'参    数:v中英文混合字符串
'f是否对ASCII字符编码
'返 回 值:编码后的ASC字符串
'涉及的表:无
'===================================================================================
Public Function URLEncoding(v,f)
Dim s,t,i,j,h,l,x : s = "" : x=Len(v)
For i = 1 To x
t = Mid(v,i,1) : j = Asc(t)
If j> 0 Then
If f Then
s = s & "%" & Right("00" & Hex(Asc(t)),2)
Else
s = s & t
End If
Else
If j < 0 Then j = j + &H10000
h = (j And &HFF00) \ &HFF
l = j And &HFF
s = s & "%" & Hex(h) & "%" & Hex(l)
End If
Next
URLEncoding = s
End Function
'===================================================================================
'   函数原型:  URLDecoding (sIn)
'功    能:URL解码码函数
'参    数:vURL编码的字符串
'返 回 值:解码后的字符串
'涉及的表:无
'===================================================================================
Public Function URLDecoding(sIn)
Dim s,i,l,c,t,n : s="" : l=Len(sIn)
For i=1 To l
c=Mid(sIn,i,1)
If c<>"%" Then
s = s & c
Else
c=Mid(sIn,i+1,2) : i=i+2 : t=CInt("&H" & c)
If t<&H80 Then
s=s & Chr(t)
Else
c=Mid(sIn,i+1,3)
If Left(c,1)<>"%" Then
URLDecoding=s
Exit Function
Else
c=Right(c,2) : n=CInt("&H" & c)
t=t*256+n-65536
s = s & Chr(t) : i=i+3
End If
End If
End If
Next
URLDecoding=s
End Function
'===================================================================================
'   函数原型:  Bytes2BSTR (v)
'功    能:UTF-8编码转换到正常的GB2312
'参    数:vUTF-8编码字节流
'返 回 值:解码后的字符串
'涉及的表:无
'===================================================================================
Public Function Bytes2BSTR(v)
Dim r,i,t,n : r = ""
For i = 1 To LenB(v)
t = AscB(MidB(v,i,1))
If t < &H80 Then
r = r & Chr(t)
Else
n = AscB(MidB(v,i+1,1))
r = r & Chr(CLng(t) * &H100 + CInt(n))
i = i + 1
End If
Next
Bytes2BSTR = r
End Function
%>
  评论这张
 
阅读(806)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2016