ChinaCMS.org

asp单点登陆(sso)问题

ch_56@sina.com(西楼冷月) — Tue,11 Nov 2008 15:23:18 +0800

公司要实行一个asp通行证平台，查了不少的资料，总结一下：
1,不论是注册，登陆，注销都要返回在通行证中心进行
2,不论用什么方法实现，都要在通行中心使用cookie记录用户登陆状态，因为成员网站发现用户没登陆时都要转到通行证中心进行验证用户是否已经登陆过
3,成员站点和通行证中心进行通信验证仍然要用url附带参数来传递，因为是明文传递的，所以要实现加密解密来验证数据的合法性。
4,不要以为使用asp的xmlhttp可以进行远程登陆就认为可以实现sso，其实用这种方法是会遇到其他问题的，这个方法行不通
5,要在成员站点使用到iframe或的形式包含通行证中心的页面，这样就维持通行证中心用来保存用户登陆的cookie状态不过期
6,在成员网站不能使用ajax来登陆了，只能使用iframe代替，这个真是个很大的遗憾，或许有方法的，只是我还没想到。

目前想到的实现思路有两个：
1,通行证中心和各成员站点都使用cookie保存用户登陆状态
2,第一种方法的扩展，除了使用cookie还要把用户登陆状态记录到数据库，这样b/s和c/s都能登陆，但是要维护状态的同步性，暂时没想到什么好的方法

有点乱，等把系统实现后有时间再整理个方案出来。

discuz编辑器背景修改问题

ch_56@sina.com(西楼冷月) — Sat,08 Nov 2008 17:10:51 +0800

discuz6.1编辑器默认是[所见即所得模式],当在样式里定义body{}有背景图片的时候,那在编辑器的编辑框里也会出现背景图片。
解决办法：
找到"include/javascript/editor.js",大概136行开始，是定义编辑框样式的，代码如下：

程序代码

editbox.style.width = textobj.style.width;
editbox.style.height = textobj.style.height;
editdoc.body.style.backgroundColor = TABLEBG;
editdoc.body.style.textAlign = 'left';
editdoc.body.id = 'wysiwyg';

在这些代码后面加：

程序代码

editdoc.body.style.backgroundImage = "none";

即可。

另外：怎样定义discuz编辑器框的外框样式？
在后台样式里加上：

程序代码

#posteditor_iframe{border:solid 1px #F7F7F7;}

可以定义边框样式，也可以定义滚动条样式，具体自己加。

也许会有疑问为什么这样加，因为discuz所见即所得模式的编辑器是由javascript动态创建的iframe,而这个iframe的id就是posteditor_iframe,还有，这个id的定义是在/post.php的第193行的$editorid = 'posteditor'加上"_iframe"后缀.^_^

OVER...by xilou

安装UCenter时提示:Unknown character set: \’gbk\’

ch_56@sina.com(西楼冷月) — Fri,07 Nov 2008 10:23:38 +0800

安装UCenter_1.0.0_SC_GBK程序时提示:Unknown character set: \’gbk\’,试了几次都不行，又是数据库编码问题，看来又要手动hack安装了。具体如下：

1，在安装的第二步时出现错误，打开install/index.php，在大概321行找到下面代码：

程序代码

if($curr_mysql_version > '4.1') {
mysql_query("Create DATABASE IF NOT EXISTS `$ucdbname` DEFAULT CHARACTER SET $ucdbcharset");
} else {
mysql_query("Create DATABASE IF NOT EXISTS `$ucdbname`");
}

将"DEFAULT CHARACTER SET $ucdbcharset"去掉或拿出来注释掉，变成如下：

程序代码

if($curr_mysql_version > '4.1') {
mysql_query("Create DATABASE IF NOT EXISTS `$ucdbname` ");//DEFAULT CHARACTER SET $ucdbcharset
} else {
mysql_query("Create DATABASE IF NOT EXISTS `$ucdbname`");
}

2，在安装的第四步再次出现这个错误，打开install/global.func.php,在大概321行找到下面代码：

程序代码

function createtable($sql, $dbcharset) {
    $type = strtoupper(preg_replace("/^\s*Create TABLE\s+.+\s+$.+?$.*(ENGINE|TYPE)\s*=\s*([a-z]+?).*$/isU", "\\2", $sql));
    $type = in_array($type, array('MYISAM', 'HEAP')) ? $type : 'MYISAM';
    return preg_replace("/^\s*(Create TABLE\s+.+\s+$.+?$).*$/isU", "\\1", $sql).
        (mysql_get_server_info() > '4.1' ? " ENGINE=$type DEFAULT CHARSET=$dbcharset" : " TYPE=$type");
}

将"DEFAULT CHARSET=$dbcharset"去掉或拿出来注释掉，变成如下：

程序代码

OK，大功告成!!

从cnbeta上看到的.

ch_56@sina.com(杜宝) — Thu,06 Nov 2008 15:06:27 +0800

Dear Tim,

shall by too dull doll by too jack won,
dolphin long can Jim shall by too low, shall by too when dull low, doll car low, dolphin long doll Ham Eason “more power!”

能看懂不?

关于周末的郊游...

ch_56@sina.com(杜宝) — Thu,06 Nov 2008 13:22:33 +0800

经理说:
周六研发组织爬香山,你去吗?问问他们?
杜宝说:
好.我问问
杜宝说:
没人
杜宝说:
又没漂亮MM.同志们纷纷表示对研发那帮大老爷们没兴趣
经理说:
你问问女的.
杜宝说:
女的也不去.
经理说:
理由?
杜宝说:
对香山没兴趣,对研发那帮大老爷们也没兴趣
经理说:
明白

自家用的asp函数库，不断增加中...

ch_56@sina.com(西楼冷月) — Thu,30 Oct 2008 14:37:10 +0800

HTML代码

<%
    '******************************
    '类名：
    '名称：通用库
    '日期：2008/10/28
    '作者：by xilou
    '网址：
    '描述：通用库
    '版权：转载请注名出处，作者
    '******************************
    '最后修改：
    '修改次数：
    '修改说明：
    '目前版本：
    '******************************/

'输出
    Sub Echo(str)
        Response.Write str
    End Sub

'断点
    Sub Halt()
        Response.End()
    End Sub

'输出并换行
    Sub Br(str)
        Echo str & "<br />" & vbcrlf
    End Sub

'简化Request.Form()
    'f : 表单名称
    Function P(f)
        P = Replace(Request.Form(f), Chr(0), "")
    End Function

'接收表单并替换单引号
    Function Pr(f)
        Pr = Replace(Request.Form(f), Chr(0), "")
        Pr = Replace(Pr, "'", "''")
    End Function

'简化Request.Querystring()
    'f : 表单名称
    Function G(f)
        G = Replace(Request.QueryString(f), Chr(0), "")
    End Function

'接收url参数并替换单引号
    Function Gr(f)
        Gr = Replace(Request.QueryString(f), Chr(0), "")
        Gr = Replace(Gr, "'", "''")
    End Function

'//构造()?:三目运算 by xilou www.chinacms.org
    'ifThen为true返回s1,为false返回s2
	Function IfThen(ifTrue, s1, s2)
		Dim t
		If ifTrue Then
			t = s1
		Else
			t = s2
		End If
		IfThen = t
	End Function

'显示不同颜色的是和否
	Function IfThenFont(ifTrue, s1, s2)
	    Dim str
	    If ifTrue Then
		    str = "<font color=""#006600"">" & s1 & "</font>"
		Else
		    str = "<font color=""#FF0000"">" & s2 & "</font>"
		End If
		IfThenFont = str
	End Function

'创建Dictionary对象
    Function HashTable()
        Set HashTable = Server.CreateObj("Scripting.Dictionary")
        HashTable.CompareMode = 1
    End Function

'创建XmlHttp
    Function XmlHttp()
        Set XmlHttp = Server.createobject("MSXML2.XMLHTTP")
    End Function

'创建XmlDom
    Function XmlDom()
    End Function

'创建AdoStream
    Function AdoStream()
        Set AdoStream = Server.CreateObject("Adodb.Stream")
    End Function

'创建一个1维数组
	'返回n个元素的空数组
	'n : 元素个数
	Function NewArray(n)
	    Dim ary : ary = array()
		ReDim ary(n-1)
		NewArray = ary
	End Function

'构造Try..Catch
    Sub Try()
        On Error Resume Next
    End Sub

'构造Try..Catch
    Sub Catch(msg)
        Dim html
        html = "<ul><li>$1</li></ul>"
        If Err Then
            If msg <> "" Then
                echo Replace(html, "$1", msg)
                Halt
            Else
                echo Replace(html, "$1", Err.Description)
                Halt
            End If
            Err.Clear
            Response.End()
        End If
    End Sub

'--------------------------------数组操作开始
    '判断数组中是否存在某个值
	Function InArray(arr, s)
	    If VarType(arr) <> 8192 Then InArray = False : Exit Function
	    Dim i
	    For i = LBound(arr) To UBound(arr)
		    If s = arr(i) Then InArray = True : Exit Function
		Next
		InArray = False
	End Function

'用ary数组中的值分别替换str中的占位符
    '返回替换后的字符串
    'str:要替换的字符串,占位符分别为$0,$1,$2...
    'ary:用来替换的数组,每个值分别对应占位符中的$0,$1,$2...
    '如:ReplaceByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
    Function ReplaceByAry(str,ary)
        Dim i, j, L1, L2 : j = 0
        If IsArray(ary) Then
		    L1 = LBound(ary) : L2 = UBound(ary)
			For i = L1 To L2
				str = Replace(str, "$"&j, ary(i))
			    j   = j+1
			Next
	    End If
	    ReplaceByAry = str
    End Function
    '--------------------------------数组操作结束

'--------------------------------随机数操作开始
    '获取随机数
    'm-n的随机数字
    Function RndNumber(m,n)
        Randomize
        RndNumber = Int((n - m + 1) * Rnd + m)
    End Function

'获取随机字符串
    'n : 产生的长度
    Function RndText(n)
        Dim str1, str2, i, x, L
        str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
        L    = Len(str1)
        Randomize
        For i = 1 To n
            x    = Int((L - 1 + 1) * Rnd + 1)
            str2 = str2 & Mid(str1,x,1)
        Next
        RndText = str2
    End Function

'从字符串str中产生m至n个的随机字符串
    '如果str为空则默认从数字和字母中产生随机字符串
    'str : 要从该字符串中产生随机字符串
    'm,n : 产生n到m位
    Function RndByText(str, m, n)
        Dim i, k, str2, L, x
        If str = "" Then str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
        L = Len(str)
        If n = m Then
            k = n
        Else
            Randomize
            k = Int((n - m + 1) * Rnd + m)
        End If
        Randomize
        For i = 1 To k
            x    = Int((L - 1 + 1) * Rnd + 1)
            str2 = str2 & Mid(str, x, 1)
        Next
        RndByText = str2
    End Function

'日期时间组成随机数
    '返回当前时间的数字组合
    Function RndByDateTime()
        Dim dt : dt  = Now()
        RndByDateTime = Year(dt) & Month(dt) & Day(dt) & Hour(dt) & Minute(dt) & Second(dt)
    End Function
    '--------------------------------随机数操作结束

'--------------------------------字符串操作开始
    '判断一字符串str2在另一个字符串str1中出现的次数
	'返回次数，没有则返回0
	'str1 :接受搜索的字符串表达式
	'str2 :要搜索的字符串表达式
	'start:要搜索的开始位置,为空表示默认从1开始搜索
	Function InStrTimes(str1, str2, start)
	    Dim a,c
		If start = "" Then start = 1
		c = 0
		a = InStr(start, str1, str2)
		Do While a > 0
		    c = c + 1
			a = InStr(a+1, str1, str2)
		Loop
		InStrTimes = c
	End Function

'字符串连接
	'无返回
	'strResult : 连接后保存的字符
	'str       : 要连接的字符
	'partition : 连接字符间的分割符号
	Sub JoinStr(byref strResult,str,partition)
	    If strResult <> "" Then
		    strResult = strResult & partition & str
		Else
		    strResult = str
		End If
	End Sub

'计算字符串的字节长度，一个汉字=2字节
    Function StrLen(str)
        If isNull(str) or Str = "" Then
            StrLen = 0
            Exit Function
        End If
        Dim WINNT_CHINESE
        WINNT_CHINESE = (len("例子")=2)
        If WINNT_CHINESE Then
            Dim l,t,c
            Dim i
            l = len(str)
            t = l
            For i = 1 To l
                c = asc(mid(str,i,1))
                If c<0 Then c = c + 65536
                If c>255 Then t = t + 1
            Next
            StrLen = t
        Else
            StrLen = len(str)
        End If
    End Function

'截取字符串
    ' str    : 要截取的字符串
    ' strlen : 要截取的长度
    ' addStr : 超过长度的用这个代替，如:...
	Function CutStr(str, strlen, addStr)
		Dim l, t, c
		'str=str&""
		If Is_Empty(str) Then CutStr = "" : Exit Function
		If str="" or IsEmpty(str) Then CutStr="" : Exit Function
		'On Error Resume Next
		l = len(str) : t = 0
		For i=1 To l
			c = Abs(Asc(Mid(str,i,1)))
			If c > 255 Then
				t = t+2
			Else
				t = t+1
			End If
			If t > strlen Then
				CutStr = left(str, i) & addStr
				Exit For
			Else
				CutStr = str
			End If
		Next
		'If Err Then Err.Clear:CutStr=Left(str,strlen)
	End Function

'全角转换成半角
	Function SBCcaseConvert(str)
		Dim b, c, i
		b = "１,２,３,４,５,６,７,８,９,０," _
		&"Ａ,Ｂ,Ｃ,Ｄ,Ｅ,Ｆ,Ｇ,Ｈ,Ｉ,Ｊ,Ｋ,Ｌ,Ｍ,Ｎ,Ｏ,Ｐ,Ｑ,Ｒ,Ｓ,Ｔ,Ｕ,Ｖ,Ｗ,Ｘ,Ｙ,Ｚ"
		c = "1,2,3,4,5,6,7,8,9,0," _
		&"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
		b = split(b,",")
		c = split(c,",")
		For i = 0 To Ubound(b)
			If instr(str,b(i)) > 0 Then
				str = Replace(str, b(i), c(i))
			End If
		Next
		SBCcaseConvert = str
	End Function

'与javascript中的escape()等效
	Function VbsEscape(str)
		dim i,s,c,a
		s=""
		For i=1 to Len(str)
			c = Mid(str,i,1)
			a = ASCW(c)
			If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then
				s = s & c
			ElseIf InStr("@*_+-./",c) > 0 Then
				s = s & c
			ElseIf a>0 and a<16 Then
				s = s & "%0" & Hex(a)
			ElseIf a>=16 and a<256 Then
				s = s & "%" & Hex(a)
			Else
				s = s & "%u" & Hex(a)
			End If
		Next
		VbsEscape = s
	End Function

'对javascript中使用escape()编码过的数据进行解码,ajax调用时用
	Function VbsUnEscape(str)
	    Dim x
		x=InStr(str,"%")
		Do While x > 0
			VbsUnEscape = VbsUnEscape & Mid(str,1,x-1)
			If LCase(Mid(str,x+1,1)) = "u" Then
				VbsUnEscape = VbsUnEscape&ChrW(CLng("&H"&Mid(str,x+2,4)))
				str = Mid(str,x+6)
			Else
				VbsUnEscape = VbsUnEscape&Chr(CLng("&H"&Mid(str,x+1,2)))
				str = Mid(str,x+3)
			End If
			x = InStr(str,"%")
		Loop
		VbsUnEscape = VbsUnEscape&str
	End Function
    '--------------------------------字符串操作结束

'--------------------------------时间日期操作开始
    '根据年份和月份获得相应的月份天数
	'返回天数
	'y : 年份,如：2008
	'm : 月份,如：3
	Function GetDayCount(y,m)
	    Dim c
	    Select Case m
	    Case 1, 3, 5, 7, 8, 10, 12
		    c=31
		Case 2
		    If IsDate(y&"-"&m&"-"&"29") Then
			    c = 29
			Else
			    c = 28
			End If
		Case Else
		    c = 30
	    End Select
		GetDayCount = c
	End Function

'判断一个日期时间是否在某段时间之间,包括比较的两头时间
	Function IsBetweenTime(fromTime,toTime,strTime)
	    If DateDiff("s",fromTime,strTime) >= 0 And DateDiff("s",toTime,strTime) <= 0 Then
		    IsBetweenTime = True
		Else
		    IsBetweenTime = False
		End If
	End Function
    '--------------------------------时间日期操作结束

'--------------------------------安全加密相关操作开始
    '加密串,要使用MD5()函数
    Function iEncrypt()
        Dim ary(3),i,str,str1,str2,n,s,s1,s2
        For i = 0 To 3
            ary(i) = RndText(5)
            str    = str&Asc(mid(ary(i),2,1))
        Next

str1 = ary(0)&ary(2)
        str2 = ary(1)&ary(3)
        For i = 1 To Len(str1) - 1
            s1 = Asc(mid(str1,i,1))
            s2 = Asc(mid(str2,i,1))
            n  = s1 Xor s2
            s  = s & chr(n)
        Next
        iEncrypt = Join(ary,",")&","&MD5(s&EncryptKey&str)
    End Function

'验证加密串的正确性
    '返回 True | False
    'str : 要验证的字符串,8qp2b,ruZwh,kICkU,xzM1B,174d5e97ebb8e163
    Function iValidate(strText)
        Dim ary,i,L,str,str1,str2,n,s,s1,s2,oldText
        If strText = "" Then iValidate = False : Exit Function
        ary = Split(strText,",")
        L = UBound(ary)
        If L <> 4 Then iValidate = False : Exit Function
        For i = 0 To 3
            str    = str&Asc(mid(ary(i),2,1))
        Next
        str1 = ary(0)&ary(2)
        str2 = ary(1)&ary(3)
        For i = 1 To Len(str1) - 1
            s1 = Asc(mid(str1,i,1))
            s2 = Asc(mid(str2,i,1))
            n  = s1 Xor s2
            s  = s & chr(n)
        Next
        oldText = MD5(s&EncryptKey&str)
        If oldText = ary(4) Then
            iValidate = True
        Else
            iValidate = False
        End If
    End Function
    '--------------------------------安全加密相关操作结束

'--------------------------------数据合法性验证操作开始
    '--------------------------------数据合法性验证操作结束

'--------------------------------文件操作开始
    '获取文件后缀，如jpg
    Function GetFileExt(f)
        GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
    End Function
    '--------------------------------文件操作结束

'--------------------------------其他操作开始
    '显示信息
    'message : 要显示的信息
    'url     : 要跳转的URL
    'typeNum : 显示方式，1弹出信息，回退到上一页；2弹出信息，转到url处
    Sub ShowMsg(message,url,typeNum)
        message = replace(message,"'","\'")
        Select Case TypeNum
        Case 1
           echo ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
        Case 2
           echo ("<script language=javascript>alert('" & message & "');location='" & Url &"'</script>")
        End Select
    End Sub

'显示option列表并定位,by xilou www.chinacms.org
	'textArr  : 文本数组
    'valueArr : 值数组
    'curValue : 当前选定值
	Function ShowOpList(textArr, valueArr, curValue)
	    Dim str, style, i
		style = "style=""background-color:#FFCCCC"""
		str   = ""
		If IsNull(curValue) Then curValue = ""
		For I = LBound(textArr) To UBound(valueArr)
			If Cstr(valueArr(I)) = Cstr(curValue) Then
				str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
			Else
				str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
			End If
		Next
		ShowOpList = str
	End Function

'多选列表
    '注意:要使用到InArray()函数
    'textArr  : 文本数组
    'valueArr : 值数组
    'curValue : 当前选定值数组
	Function ShowMultiOpList(textArr,valueArr,curValueArr)
		Dim style, str, isCurr, I
		style = "style=""background-color:#FFCCCC"""
		str   = "" : isCurr = False
		If IsNull(curValue) Then curValue = ""
		For I = LBound(textArr) To UBound(valueArr)
			If InArray(curValueArr, valueArr(I)) Then
				str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
			Else
				str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
			End If
		Next
		ShowMultiOpList = str
	End Function
    '--------------------------------其他操作结束
%>

[Ctrl+A 全部选择提示：你可先修改部分代码，再按运行]

最简单的(div)浮动层,兼容IE6,IE7,FF2.0;

ch_56@sina.com(西楼冷月) — Thu,30 Oct 2008 10:17:36 +0800

最简单的浮动层,兼容IE6,IE7,FF2.0;没有加js来控制层的展现和隐藏

HTML代码

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "<a href="http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" target="_blank">http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd</a>">
<html xmlns="<a href="http://www.w3.org/1999/xhtml" target="_blank">http://www.w3.org/1999/xhtml</a>">
<head>
 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 <meta http-equiv="Content-Language" content="zh-CN" />
 <meta name="Keywords" content="div浮动,div浮动层,兼容div浮动" />
 <meta name="Description" content="by 西楼冷月,www.chinacms.org" />
 <title>div浮动,div浮动层,兼容div浮动-www.chinacms.org</title>
 <style type="text/css">
 body{font-family:arial;font-size:12px;}
 .nav{width:500px;height:25px;line-height:25px;background-color:#D0E8FF;border:solid 1px #000099;}
 .nav a{display:block;}/*这个display:block;一定要加，因为a不是块元素*/

/*浮动块要用position:absolute;定义,使用left:auto;或margin-left:-1px;定位*/
 .nav .f{position:absolute;left:auto;border:solid 1px #000099;}

/*使用margin-left:-1px;是因为.nav定义了border为1px,所以要向前移1px才能对齐,chinacms.org*/
 /*
 .nav .f{position:absolute;margin-left:-1px;border:solid 1px #000099;}
 */
 </style>
</head>

<body>
	<p>最简单的浮动层,兼容IE6,IE7,FF2.0;没有加js来控制层的展现和隐藏</p>

<div class="nav">
		<a href="#">西楼的导航</a>
		<span class="f">这个是浮动块,www.chinacms.org</span>
	</div>

<p> </p>
	<p>另一个浮动</p>

<div class="nav">
		<a href="#">西楼的导航</a>
		
		<span class="f" style="margin-left:502px;margin-top:-26px;">这个是浮动块,www.chinacms.org</span>
	</div>
</body>

</html>

[Ctrl+A 全部选择提示：你可先修改部分代码，再按运行]

在asp中使用eval()实现更加灵活的模板标签

ch_56@sina.com(西楼冷月) — Sun,19 Oct 2008 23:31:31 +0800

eval在很多语言中都会存在，实现功能也是差不多。eval会将一段符合语法的文本当作代码执行。
我们来看在vbscript中eval()的用法：

程序代码

<%
        Dim scriptText,ary,val,n,i
        n   = 100
        val = "变量测试"

        '//测试1
        scriptText = "array(n + 100, val, ""www.chinacms.org"")" '符合vbscript语法的文本
        ary = Eval(scriptText) '执行
        '输出
        Response.Write ary(0) & "-" & ary(1) & "-" & ary(2)
        '输出的结果是:200-变量测试-www.chinacms.org
%>

从上面的代码可得eval的用法：

1,eval()有返回值，例如当执行一个数组时会返回一个数组
2,eval()里面的变量(如上面的val变量)是受外部变量的影响的，并不是单独放在一个容器里封闭执行的

再来看看模板
一般我们要在html模板里面定义自己的模板标签，如下面的标签，表示读取文章的id,title字段，然后循环显示10条:

程序代码

{$title}

上面的标签看起来很美好，但是要写正则把相关数据提取出来的时候就会有点烦琐，我们可以用以下来代替：

程序代码

{$title}

把Array("id,title",10,25)提取出来，直接eval()一下，就可以判断了，这样会不会简单多了？^_^

再来看一个：
有时候标签中还要加上逻辑判断的，那就要加上If...Then这些东西了，可以这样实现：

程序代码

"")>
已经登陆

还没登陆

将(Request.cookie("Uid")<>"")提取出来，eval()一下，将会返回true或false值，然后判断显示哪一部分。

还有很多其他的灵活运用就不一一举例了。
概括起来就是：
在标签中直接嵌入asp代码，然后提取这部分代码，eval()一下返回一个值，再根据这个值去处理相关数据。

PS:vbscript里还有一个execute()函数，可以和eval()结合起来灵活使用。

阿斯玛还是走了...

ch_56@sina.com(西楼冷月) — Fri,17 Oct 2008 02:10:34 +0800

阿斯玛在火影里是自己喜欢的一个人物,虽然早知道在这一集(300集)里会挂掉,但是现在看了,心里还是很失落,可是这个是剧情需要,没办法,很无奈,正如人生一样,有些事,有心但无力去做!!!

夕日红

猿飞阿斯玛

奈良鹿丸

vbscript 函数中实现可变参数

ch_56@sina.com(西楼冷月) — Wed,15 Oct 2008 23:41:38 +0800

asp,vbscript 函数中实现可变参数,省略参数

vbscript 函数的参数是固定的，不能实现php中的参数省略，更不用说可以实现高级语言中的重载了。
有时候写好了一个函数,当然是可以满足当前的需求的，可是到了后期，随着需求的变化，可能要
在函数中增加一两个参数，但是因为在前期已经把这个函数应用到很多地方了，再想改已经是不可能的了，无奈，只好又重新写一个功能差不多的函数。

有没有一种方法，函数的参数可以动态增加或减少，这样就可以直接在函数内部通过不同参数值返回不同的结果?
答案是肯定的，可以通过Dictionary对象来实现无限个参数的设置。

基本思路：参数是通过数组传递，在函数内部将参数数组转为dictionary对象使用，数组是一维或二维数组，形式如下：

程序代码

<%
    Dim ary
    ary = array( array("Uid",1024) , array("UserName","xilou") ,array("QQ","39949376") )
    '或者
    ary = array( "Uid:1024" , "UserName:xilou" , "QQ:39949376" )

    '将会把该数组转化为dictionary,则可以使用如下形式使用：
    Response.Write ht("Uid") & ht("UserName") & ht("QQ")
%>

具体代码如下：

程序代码

<%
    '将数组转化为dictionary对象存储
    'hashObj : dictionary对象
    'ary     : 数组，格式必须为以下两种之一,第一种只能存储字符串值
    '        : array("Id:12","UserName:xilou","Sex:1")，即array("key:value",...)格式
    '        : array(array("Id","12"),array("UserName","xilou"),array("Sex","1"))
    '返回dictionary对象
    'www.chinacms.org
    Sub AryAddToHashTable(ByRef hashObj,ary)
        Dim str,ht,i,k,v,pos
        For i = 0 To UBound(ary)
            If IsArray(ary(i)) Then
                If IsObject(ary(i)(0)) Then
                    Response.Write "Error:AryToHashTable(ary),键值不可以是一个对象类型,"
                    Response.Write "当前ary("& i &")(0)值类型为:" & TypeName(ary(i)(0))
                    Response.End()
                End If
                If IsObject(ary(i)(1)) Then '如果值是一个对象
                    Set hashObj(ary(i)(0)) = ary(i)(1)
                Else
                    hashObj(ary(i)(0)) = ary(i)(1)
                End If
            Else
                str = ary(i) & ""
                pos = InStr(str,":")
                'www.chinacms.org
                If pos < 1 Then
                    Response.Write "Error:AryToHashTable(ary),"":""不存在"
                    Response.Write ",发生在:" & ary(i)
                    Response.End()
                End If
                If pos = 1 Then
                    Response.Write "Error:AryToHashTable(ary),键值不存在"
                    Response.Write ",发生在:" & ary(i)
                    Response.End()
                End If
                k = Left(str,pos-1)
                v = Mid(str,pos+1)
                hashObj(k) = v
            End If
        Next
    End Sub

    '将数组转化为dictionary对象存储
    'ary : 数组，格式必须为以下两种之一,第一种只能存储字符串值
    '    : array("Id:12","UserName:xilou","Sex:1")，即array("key:value",...)格式
    '    : array(array("Id","12"),array("UserName","xilou"),array("Sex","1"))
    '返回dictionary对象
    Function AryToHashTable(ary)
        Dim str,ht,i,k,v,pos
        Set ht = Server.CreateObject("Scripting.Dictionary")
        ht.CompareMode = 1
        AryAddToHashTable ht , ary
        Set AryToHashTable = ht
    End Function
%>

使用例子：

程序代码

<%

    Dim ary,rs

    '定义函数,获取新闻
    '返回recordset对象
    Function GetNews(param)
        Dim ht
        Set ht = AryToHashTable(param) '将参数数组转为dictionary对象
        '开始使用
        If ht("n") = -1 Then '如果参数n为-1表示不限制哪一条新闻

        End If
        If ht("isCheck") Then '如果参数isCheck为true则选取通过审核的新闻

        End If
    End Function

    '调用函数
    '参数是通过数组传递，在函数内部将参数数组转为dictionary对象使用
    Set rs = GetNews(array(array("n",-1),array("isCheck",false)))
%>