📄 wapclass.asp
字号:
<%
'尊重作者版权，倡导开源盛世！
'转载请勿必保留如下信息，该信息内容不影响程序运行效率！
'----------------- WAP论坛(Wapforum.CN)出品 -----------------------
'官方网站:http://www.wapforum.cn 技术支持论坛：http://bbs.wapforum.cn
'版权声明:版权所有WAP站长论坛(WapForum.cn),本程序开源仅供学习交流使用，严禁用于商业用途
'----------------- WAP论坛(Wapforum.CN)出品 -----------------------
Option Explicit
Class wapclass
Public Property Get ver
ver = "WapClass Ver1.1 (20070922)"
End Property
Private i_cache '是否开启页面缓存
public property let cache(ByVal iv) '设置是否应用页面缓存
i_cache=iv
end property
public Function unicode(ByVal strIn) '处理中文，转换成unicode字符集，防止中文页面出现乱码
Dim p1, p2, p3, t1, t2, strOutBuf, myasw
p1 = 1
p2 = InStr(p1, strIn, "&")
While p2 > 0
p3 = InStr(p2, strIn, ";")
If p3 > 0 Then
t1 = Mid(strIn, p2, p3 - p2)
If LCase(Left(t1, 3)) = "&#x" And IsNumeric("&H" + Mid(t1, 4)) Then
ElseIf Left(t1, 2) = "&#" And IsNumeric(Mid(t1, 3)) Then
ElseIf t1 <> "<" And t1 <> ">" And t1 <> "&apos" And t1 <> """ And t1 <> "&" And t1 <> " " Then
strIn = Left(strIn, p2 - 1) + Replace(strIn, "&", "&", p2, 1)
End If
Else
strIn = Left(strIn, p2 - 1) + Replace(strIn, "&", "&", p2, 1)
End If
p2 = InStr(p2 + 1, strIn, "&")
Wend
For t1 = 1 To Len(strIn)
myasw = AscW(Mid(strIn, t1, 1))
If myasw > 255 Or myasw < 32 Then
If Len(myasw) < 4 Then myasw = String(4 - Len(myasw), "0")
If myasw <> 0 Then strOutBuf = strOutBuf + "&#x" + Hex(myasw) + ";"
Else
strOutBuf = strOutBuf + Mid(strIn, t1, 1)
End If
Next
unicode = strOutBuf
End Function
public Sub wmlhead() '输出WML页面头部信息
Response.ContentType = "text/vnd.wap.wml;Charset=utf-8"
Response.Write "<?xml version=""1.0"" encoding=""utf-8""?><!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapforum.org/DTD/wml_1.1.xml""><wml>" & vbcrlf
if not i_cache Then '缓存控制
Response.Expires = -1
Response.Write "<head><meta http-equiv=""Cache-Control"" content=""max-age=0"" forua=""true""/></head>" & vbcrlf
End if
End Sub
public Sub wmlcard(ByVal cardid, ByVal title, ByVal jumptime, ByVal jumpurl, ByVal align, ByVal wrap)' 输出WML卡片
if cardid = "" then cardid = "main" 'WML卡片ID
if jumptime = "" then jumptime = 0 '页面跳转时间
if wrap = "wrap" then '页面内容是否自动换行，wrap为是，nowrap为不换行
else wrap = "nowrap"
end if
Response.Write "<card id=""" & cardid & """ title=""" & unicode(title) & """>" & vbcrlf
'如果设置跳转时间大于0，则跳转到指定的地址jumpurl
If jumptime > 0 Then Response.Write "<onevent type=""ontimer""><go href=""" & jumpurl & """ method=""get""><postfield name=""ref"" value=""" & timer() & """/></go></onevent><timer value=""" & jumptime & """/>"
Response.Write "<p align=""" & align & """ mode=""" & wrap & """>" & vbcrlf
End Sub
public Sub wmlline(ByVal style) '自定义换行栏
dim linestr
linestr = "=^=^=^=^=^="
select case style
case 0
linestr = "<br/>" & linestr ' 左边换行
case 1
linestr = linestr & "<br/>" ' 右边换行
case 2
linestr = "<br/>" & linestr & "<br/>" ' 两边均换行
end select
Response.Write linestr
end Sub
public function wmllink(ByVal url, ByVal text) ' 输出链接
wmllink = "<a href=""" & url & """>" & unicode(Text) & "</a>"
end function
public function wmlimg(ByVal url, ByVal imgurl, ByVal text) ' 输出图片
wmlimg = "<img src=""" & imgurl & """ alt=""" & unicode(text) & """ />"
if url<>"" then wmlimg = wmllink(url,wmlimg) ' 如果链接地址不为空，则给图片添加链接
end function
public Sub wmlend(style) ' 卡片结束或WML页面结束
dim estr
estr="</p></card>" & vbcrlf
select case style
case 0
estr = estr & "</wml>"
end select
Response.Write estr
end Sub
public function wmlback(ByVal text) ' 返回上一页按钮
wmlback = "<anchor title=""" & unicode(text) & """><prev/>" & unicode(text) & "</anchor>"
end function
public function postvalue(ByVal vname,ByVal value) ' 生成POST值项
postvalue = "<postfield name="""& vname &""" value="""& unicode(value) &"""/>"
end function
public function postform(ByVal text,ByVal purl,ByVal postvalue) ' POST表单
postform = "<anchor title="""& unicode(text) &"""><go href="""& purl &""" method=""post"" accept-charset=""utf-8"">"&_
postvalue&_
"</go>"& unicode(text) &"</anchor>"
end function
end class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -